Only in ./VADemo/r1/: A1CKC10.m
Only in ./VADemo/r1/: A1CKC11.m
Only in ./VADemo/r1/: A1CKC12.m
Only in ./VADemo/r1/: A1CKC13.m
Only in ./VADemo/r1/: A1CKC14.m
Only in ./VADemo/r1/: A1CKC15.m
diff -y --suppress-common-lines ./VADemo/r1/A1CKC1.m ./VADemo/r2/r/A1CKC1.m
A1CKC1	; ;07/02/04					      |	A1CKC1	; ;06/28/99
							      >		D DE G BEGIN
							      >	DE	S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,
							      >		I $D(^(.3)) S %Z=^(.3) S %=$P(%Z,U,1) S:%]"" DE(2)=%
							      >		I $D(^(.362)) S %Z=^(.362) S %=$P(%Z,U,12) S:%]"" DE(
							      >		I $D(^("VET")) S %Z=^("VET") S %=$P(%Z,U,1) S:%]"" DE
							      >		K %Z Q
							      >		;
							      >	W	W !?DL+DL-2,DLB_": "
							      >		Q
							      >	O	D W W Y W:$X>45 !?9
							      >		I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
							      >		W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (N
							      >	TR	R X:DTIME E  S (DTOUT,X)=U W $C(7)
							      >		Q
							      >	A	K DQ(DQ) S DQ=DQ+1
							      >	B	G @DQ
							      >	RE	G PR:$D(DE(DQ)) D W,TR
							      >	N	I X="" G A:DV'["R",X:'DV,X:D'>0,A
							      >	RD	G QS:X?."?" I X["^" D D G ^DIE17
							      >		I X="@" D D G Z^DIE2
							      >		I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^
							      >	T	G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD
							      >		K DDER G X
							      >	P	I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_
							      >		G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
							      >		I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,
							      >	V	D @("X"_DQ) K YS
							      >	Z	K DIC("S"),DLAYGO I $D(X),X'=U S DG(DW)=X S:DV["d" ^D
							      >	X	W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
							      >		S X="?BAD"
							      >	QS	S DZ=X D D,QQ^DIEQ G B
							      >	D	S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ)
							      >	Y	I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="
							      >	PR	S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
							      >	R	I DG["P",@("$D(^"_X_"0))") S X=+$P(^(0),U,2) G RP:'$D
							      >		I DG["V",+Y,$P(Y,";",2)["(",$D(@(U_$P(Y,";",2)_"0)"))
							      >		X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":"
							      >	RP	D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
							      >	I	I DV'["I",DV'["#" G RD
							      >		D E^DIE0 G RD:$D(X),PR
							      >		Q
							      >	SET	N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=
							      >		I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
							      >		D ^DIR I 'DDER S %=Y(0),X=Y
							      >		Q
							      >	BEGIN	S DNM="A1CKC1",DQ=1
							      >	1	D:$D(DG)>9 F^DIE17,DE S DQ=1,DW="VET;1",DV="RSXa",DU=
							      >		S DE(DW)="C1^A1CKC1"
							      >		S DU="Y:YES;N:NO;"
							      >		S Y="Y"
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	C1	G C1S:$D(DE(1))[0 K DB S X=DE(1),DIC=DIE
							      >		S DFN=DA D EN^DGMTCOR K DGMTCOR
							      >		S X=DE(1),DIC=DIE
							      >		;
							      >		S X=DE(1),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >		S X=DE(1),DIC=DIE
							      >		I ($T(AVAFC^VAFCDD01)'="") S VAFCF="1901;" D AVAFC^VA
							      >		S X=DE(1),DIIX=2_U_DIFLD D AUDIT^DIET
							      >	C1S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
							      >		S DFN=DA D EN^DGMTCOR K DGMTCOR
							      >		S X=DG(DQ),DIC=DIE
							      >		X ^DD(2,1901,1,3,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D
							      >		S X=DG(DQ),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >		S X=DG(DQ),DIC=DIE
							      >		I ($T(AVAFC^VAFCDD01)'="") S VAFCF="1901;" D AVAFC^VA
							      >		Q:$D(DE(1))[0&(^DD(DP,DIFLD,"AUDIT")="e")  S X=DG(DQ)
							      >		Q
							      >	X1	I $D(X) S:'$D(DPTX) DFN=DA D:'$D(^XUSEC("DG ELIGIBILI
							      >		Q
							      >		;
							      >	2	D:$D(DG)>9 F^DIE17,DE S DQ=2,DW=".3;1",DV="RSXa",DU="
							      >		S DE(DW)="C2^A1CKC1"
							      >		S DU="Y:YES;N:NO;"
							      >		S Y="N"
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	C2	G C2S:$D(DE(2))[0 K DB S X=DE(2),DIC=DIE
							      >		;
							      >		S X=DE(2),DIC=DIE
							      >		;
							      >		S X=DE(2),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >		S X=DE(2),DIC=DIE
							      >		I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".301;" D AVAFC^VA
							      >		S X=DE(2),DIIX=2_U_DIFLD D AUDIT^DIET
							      >	C2S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
							      >		X ^DD(2,.301,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D
	X "S DFN=DA D EN^DGMTR K DGREQF"		      |		X ^DD(2,.301,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D
	K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(2,.361,1,2,89.4)  |		D AUTOUPD^DGENA2(DA)
							      >		I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".301;" D AVAFC^VA
							      >		Q:$D(DE(2))[0&(^DD(DP,DIFLD,"AUDIT")="e")  S X=DG(DQ)
							      >		Q
							      >	X2	S DFN=DA D EV^DGLOCK I $D(X),X="Y" D VET^DGLOCK
							      >		Q
							      >	3	D:$D(DG)>9 F^DIE17,DE S DQ=3,DW=".362;14",DV="SX",DU=
							      >		S DE(DW)="C3^A1CKC1"
							      >		S DU="Y:YES;N:NO;U:UNKNOWN;"
							      >		S X=$S(PE="Y":"Y",1:"N")
							      >		S Y=X
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	C3	G C3S:$D(DE(3))[0 K DB S X=DE(3),DIC=DIE
							      >		X ^DD(2,.36235,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT
							      >		S X=DE(3),DIC=DIE
							      >		S DFN=DA D EN^DGMTCOR K DGMTCOR
							      >		S X=DE(3),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >		S X=DE(3),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >	C3S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
							      >		X ^DD(2,.36235,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT
							      >		S X=DG(DQ),DIC=DIE
							      >		S DFN=DA D EN^DGMTCOR K DGMTCOR
	S ^DPT("AEL",DA,+X)=""				      |		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
	I $D(DE(6))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ |		Q
							      >	X3	S DFN=DA D MV^DGLOCK
							      >		Q
							      >		;
							      >	4	D:$D(DG)>9 F^DIE17,DE S DQ=4,DW=".362;12",DV="SX",DU=
							      >		S DE(DW)="C4^A1CKC1"
							      >		S DU="Y:YES;N:NO;U:UNKNOWN;"
							      >		S X=$S(AA="Y":"Y",1:"N")
							      >		S Y=X
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	C4	G C4S:$D(DE(4))[0 K DB S X=DE(4),DIC=DIE
							      >		X ^DD(2,.36205,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT
							      >		S X=DE(4),DIC=DIE
							      >		S DFN=DA D EN^DGMTCOR K DGMTCOR
							      >		S X=DE(4),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >		S X=DE(4),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >	C4S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
							      >		X ^DD(2,.36205,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT
							      >		S X=DG(DQ),DIC=DIE
							      >		S DFN=DA D EN^DGMTCOR K DGMTCOR
							      >		S X=DG(DQ),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >		S X=DG(DQ),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >		Q
							      >	X4	S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK
							      >		Q
							      >		;
							      >	5	D:$D(DG)>9 F^DIE17,DE S DQ=5,DW=".362;13",DV="SX",DU=
							      >		S DE(DW)="C5^A1CKC1"
							      >		S DU="Y:YES;N:NO;U:UNKNOWN;"
							      >		S X=$S(HB="Y":"Y",1:"N")
							      >		S Y=X
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	C5	G C5S:$D(DE(5))[0 K DB S X=DE(5),DIC=DIE
							      >		X ^DD(2,.36215,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT
							      >		S X=DE(5),DIC=DIE
							      >		S DFN=DA D EN^DGMTCOR K DGMTCOR
							      >		S X=DE(5),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >		S X=DE(5),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >	C5S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
							      >		X ^DD(2,.36215,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT
							      >		S X=DG(DQ),DIC=DIE
							      >		S DFN=DA D EN^DGMTCOR K DGMTCOR
							      >		S X=DG(DQ),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >		S X=DG(DQ),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >		Q
							      >	X5	S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK
							      >		Q
							      >		;
							      >	6	D:$D(DG)>9 F^DIE17 G ^A1CKC2
diff -y --suppress-common-lines ./VADemo/r1/A1CKC2.m ./VADemo/r2/r/A1CKC2.m
A1CKC2	; ;07/02/04					      |	A1CKC2	; ;06/28/99
							      >		D DE G BEGIN
							      >	DE	S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,
							      >		I $D(^(.3)) S %Z=^(.3) S %=$P(%Z,U,11) S:%]"" DE(15)=
							      >		I $D(^(.36)) S %Z=^(.36) S %=$P(%Z,U,1) S:%]"" DE(1)=
							      >		I $D(^(.362)) S %Z=^(.362) S %=$P(%Z,U,14) S:%]"" DE(
							      >		I $D(^("TYPE")) S %Z=^("TYPE") S %=$P(%Z,U,1) S:%]"" 
							      >		K %Z Q
							      >		;
							      >	W	W !?DL+DL-2,DLB_": "
							      >		Q
							      >	O	D W W Y W:$X>45 !?9
							      >		I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
							      >		W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (N
							      >	TR	R X:DTIME E  S (DTOUT,X)=U W $C(7)
							      >		Q
							      >	A	K DQ(DQ) S DQ=DQ+1
							      >	B	G @DQ
							      >	RE	G PR:$D(DE(DQ)) D W,TR
							      >	N	I X="" G A:DV'["R",X:'DV,X:D'>0,A
							      >	RD	G QS:X?."?" I X["^" D D G ^DIE17
							      >		I X="@" D D G Z^DIE2
							      >		I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^
							      >	T	G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD
							      >		K DDER G X
							      >	P	I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_
							      >		G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
							      >		I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,
							      >	V	D @("X"_DQ) K YS
							      >	Z	K DIC("S"),DLAYGO I $D(X),X'=U S DG(DW)=X S:DV["d" ^D
							      >	X	W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
							      >		S X="?BAD"
							      >	QS	S DZ=X D D,QQ^DIEQ G B
							      >	D	S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ)
							      >	Y	I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="
							      >	PR	S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
							      >	R	I DG["P",@("$D(^"_X_"0))") S X=+$P(^(0),U,2) G RP:'$D
							      >		I DG["V",+Y,$P(Y,";",2)["(",$D(@(U_$P(Y,";",2)_"0)"))
							      >		X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":"
							      >	RP	D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
							      >	I	I DV'["I",DV'["#" G RD
							      >		D E^DIE0 G RD:$D(X),PR
							      >		Q
							      >	SET	N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=
							      >		I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
							      >		D ^DIR I 'DDER S %=Y(0),X=Y
							      >		Q
							      >	BEGIN	S DNM="A1CKC2",DQ=1
							      >	1	D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".36;1",DV="*P8'Xa",D
							      >		S DE(DW)="C1^A1CKC2"
							      >		S DU="DIC(8,"
							      >		S X=ELIG
							      >		S Y=X
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	C1	G C1S:$D(DE(1))[0 K DB S X=DE(1),DIC=DIE
							      >		;
							      >		S X=DE(1),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(2,.361,1,2,2.2) I
							      >		S X=DE(1),DIC=DIE
							      >		X "I $S('$D(^DIC(8,+X,0)):0,$P(^(0),""^"",1)[""DOM"":
							      >		S X=DE(1),DIC=DIE
							      >		K ^DPT("AEL",DA,+X)
							      >		S X=DE(1),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >		S X=DE(1),DIIX=2_U_DIFLD D AUDIT^DIET
							      >	C1S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
							      >		X "S DFN=DA D EN^DGMTR K DGREQF"
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(2,.361,1,2,89.4) 
							      >		S X=DG(DQ),DIC=DIE
							      >		;
							      >		S X=DG(DQ),DIC=DIE
							      >		S ^DPT("AEL",DA,+X)=""
							      >		S X=DG(DQ),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >		Q:$D(DE(1))[0&(^DD(DP,DIFLD,"AUDIT")="e")  S X=DG(DQ)
							      >		Q
							      >	X1	S DFN=DA D EV^DGLOCK I $D(X) D ECD^DGLOCK1
							      >		Q
							      >		;
							      >	2	D:$D(DG)>9 F^DIE17,DE S DQ=2,DW="TYPE;1",DV="RP391'a"
							      >		S DE(DW)="C2^A1CKC2"
							      >		S DU="DG(391,"
							      >		S X=DZT2
							      >		S Y=X
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	C2	G C2S:$D(DE(2))[0 K DB S X=DE(2),DIC=DIE
							      >		I ($T(AVAFC^VAFCDD01)'="") S VAFCF="391;" D AVAFC^VAF
							      >		S X=DE(2),DIIX=2_U_DIFLD D AUDIT^DIET
							      >	C2S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
	I $D(DE(7))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ |		Q:$D(DE(2))[0&(^DD(DP,DIFLD,"AUDIT")="e")  S X=DG(DQ)
							      >		Q
							      >	X2	Q
							      >	3	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=3 D X3 G A:$D(Y)[0,A:Y
							      >	X3	S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
							      >		Q
							      >	4	S DQ=5 ;@30
							      >	5	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=5 D X5 G A:$D(Y)[0,A:Y
							      >	X5	I 'SCI S Y="@39"
							      >		Q
							      >	6	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=6 D X6 G A:$D(Y)[0,A:Y
							      >	X6	S ISC=0
							      >		Q
							      >	7	S DQ=8 ;@31
							      >	8	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=8 D X8 G A:$D(Y)[0,A:Y
							      >	X8	S ISC=$O(SCI(ISC))
							      >		Q
							      >	9	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=9 D X9 G A:$D(Y)[0,A:Y
							      >	X9	I 'ISC S Y="@39"
							      >		Q
							      >	10	D:$D(DG)>9 F^DIE17,DE S DQ=10,D=0 K DE(1) ;.3721
							      >		S DIFLD=.3721,DGO="^A1CKC3",DC="3^2.04P^.372^",DV="2.
							      >		S DU="DIC(31,"
							      >		G RE:D I $D(DSC(2.04))#2,$P(DSC(2.04),"I $D(^UTILITY(
							      >		S D=$S($D(^DPT(DA,.372,0)):$P(^(0),U,3,4),$O(^(0))'="
							      >	M10	I D>0 S DC=DC_D I $D(^DPT(DA,.372,+D,0)) S DE(10)=$P(
							      >		S X="`"_ISC
							      >		S Y=X
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	R10	D DE
							      >		G A
							      >		;
							      >	11	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=11 D X11 G A:$D(Y)[0,A
							      >	X11	S Y="@31"
							      >		Q
							      >	12	S DQ=13 ;@39
							      >	13	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=13 D X13 G A:$D(Y)[0,A
							      >	X13	S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
							      >		Q
							      >	14	S DQ=15 ;@100
							      >	15	S DW=".3;11",DV="SX",DU="",DLB="RECEIVING VA DISABILI
							      >		S DE(DW)="C15^A1CKC2"
							      >		S DU="Y:YES;N:NO;U:UNKNOWN;"
							      >		S X=CP
							      >		S Y=X
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	C15	G C15S:$D(DE(15))[0 K DB S X=DE(15),DIC=DIE
							      >		X ^DD(2,.3025,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(
							      >		S X=DE(15),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >	C15S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
							      >		X ^DD(2,.3025,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(
							      >		S X=DG(DQ),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >		Q
							      >	X15	S DFN=DA D MV^DGLOCK I $D(X),X="Y" D EC^DGLOCK1
							      >		Q
							      >		;
							      >	16	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=16 D X16 G A:$D(Y)[0,A
							      >	X16	S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
							      >		Q
							      >	17	S DQ=18 ;@200
							      >	18	D:$D(DG)>9 F^DIE17,DE S DQ=18,DW=".362;14",DV="SX",DU
							      >		S DE(DW)="C18^A1CKC2"
							      >		S DU="Y:YES;N:NO;U:UNKNOWN;"
							      >		S X=PE
							      >		S Y=X
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	C18	G C18S:$D(DE(18))[0 K DB S X=DE(18),DIC=DIE
							      >		X ^DD(2,.36235,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT
							      >		S X=DE(18),DIC=DIE
							      >		S DFN=DA D EN^DGMTCOR K DGMTCOR
							      >		S X=DE(18),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >		S X=DE(18),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >	C18S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
							      >		X ^DD(2,.36235,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT
							      >		S X=DG(DQ),DIC=DIE
							      >		S DFN=DA D EN^DGMTCOR K DGMTCOR
							      >		S X=DG(DQ),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >		S X=DG(DQ),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >		Q
							      >	X18	S DFN=DA D MV^DGLOCK
							      >		Q
							      >		;
							      >	19	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=19 D X19 G A:$D(Y)[0,A
							      >	X19	S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
							      >		Q
							      >	20	S DQ=21 ;@300
							      >	21	D:$D(DG)>9 F^DIE17 G ^A1CKC4
diff -y --suppress-common-lines ./VADemo/r1/A1CKC3.m ./VADemo/r2/r/A1CKC3.m
A1CKC3	; ;07/02/04					      |	A1CKC3	; ;06/28/99
	S X=DE(10),DIC=DIE				      |		D DE G BEGIN
	S DFN=DA D EN^DGMTCOR K DGMTCOR			      |	DE	S DIE="^DPT(D0,.372,",DIC=DIE,DP=2.04,DL=2,DIEL=1,DU=
	S X=DE(10),DIC=DIE				      |		I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,1) S:%]"" DE(1)=% S 
							      >		K %Z Q
	S X=DE(10),DIC=DIE				      |	W	W !?DL+DL-2,DLB_": "
	D AUTOUPD^DGENA2(DA)				      |		Q
	S X=DE(10),DIC=DIE				      |	O	D W W Y W:$X>45 !?9
	I ($T(AVAFC^VAFCDD01)'="") S VAFCF="1901;" D AVAFC^VA |		I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
	S X=DE(10),DIC=DIE				      |		W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (N
	D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)	      |	TR	R X:DTIME E  S (DTOUT,X)=U W $C(7)
	S X=DE(10),DIIX=2_U_DIFLD D AUDIT^DIET		      |		Q
							      >	A	K DQ(DQ) S DQ=DQ+1
							      >	B	G @DQ
							      >	RE	G PR:$D(DE(DQ)) D W,TR
							      >	N	I X="" G A:DV'["R",X:'DV,X:D'>0,A
							      >	RD	G QS:X?."?" I X["^" D D G ^DIE17
							      >		I X="@" D D G Z^DIE2
							      >		I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^
							      >	T	G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD
							      >		K DDER G X
							      >	P	I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_
							      >		G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
							      >		I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,
							      >	V	D @("X"_DQ) K YS
							      >	Z	K DIC("S"),DLAYGO I $D(X),X'=U S DG(DW)=X S:DV["d" ^D
							      >	X	W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
							      >		S X="?BAD"
							      >	QS	S DZ=X D D,QQ^DIEQ G B
							      >	D	S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ)
							      >	Y	I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="
							      >	PR	S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
							      >	R	I DG["P",@("$D(^"_X_"0))") S X=+$P(^(0),U,2) G RP:'$D
							      >		I DG["V",+Y,$P(Y,";",2)["(",$D(@(U_$P(Y,";",2)_"0)"))
							      >		X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":"
							      >	RP	D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
							      >	I	I DV'["I",DV'["#" G RD
							      >		D E^DIE0 G RD:$D(X),PR
							      >		Q
							      >	SET	N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=
							      >		I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
							      >		D ^DIR I 'DDER S %=Y(0),X=Y
							      >		Q
							      >	BEGIN	S DNM="A1CKC3",DQ=1+D G B
							      >	1	S DW="0;1",DV="MP31'X",DU="",DLB="RATED DISABILITIES 
							      >		S DU="DIC(31,"
							      >		S X="`"_ISC
							      >		S Y=X
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	X1	I $D(X) D EK^DGLOCK Q
							      >		Q
							      >		;
							      >	2	S DW="0;2",DV="RNJ3,0X",DU="",DLB="DISABILITY %",DIFL
							      >		S X=+SCI(ISC)
							      >		S Y=X
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	X2	K:+X'=X!(X>100)!(X<0)!(X?.E1"."1N.N) X I $D(X) D EK^D
							      >		Q
							      >		;
							      >	3	S DW="0;3",DV="SX",DU="",DLB="SERVICE CONNECTED",DIFL
							      >		S DU="0:NO;1:YES;"
							      >		S Y="1"
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	X3	S DFN=DA(1) D:X SC^DGLOCK1 I $D(X) D EK^DGLOCK 
							      >		Q
							      >		;
							      >	4	G 1^DIE17
diff -y --suppress-common-lines ./VADemo/r1/A1CKC4.m ./VADemo/r2/r/A1CKC4.m
A1CKC4	; ;07/02/04					      |	A1CKC4	; ;06/28/99
							      >		D DE G BEGIN
							      >	DE	S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,
							      >		I $D(^(.362)) S %Z=^(.362) S %=$P(%Z,U,12) S:%]"" DE(
							      >		K %Z Q
							      >		;
							      >	W	W !?DL+DL-2,DLB_": "
							      >		Q
							      >	O	D W W Y W:$X>45 !?9
							      >		I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
							      >		W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (N
							      >	TR	R X:DTIME E  S (DTOUT,X)=U W $C(7)
							      >		Q
							      >	A	K DQ(DQ) S DQ=DQ+1
							      >	B	G @DQ
							      >	RE	G PR:$D(DE(DQ)) D W,TR
							      >	N	I X="" G A:DV'["R",X:'DV,X:D'>0,A
							      >	RD	G QS:X?."?" I X["^" D D G ^DIE17
							      >		I X="@" D D G Z^DIE2
							      >		I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^
							      >	T	G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD
							      >		K DDER G X
							      >	P	I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_
							      >		G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
							      >		I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,
							      >	V	D @("X"_DQ) K YS
							      >	Z	K DIC("S"),DLAYGO I $D(X),X'=U S DG(DW)=X S:DV["d" ^D
							      >	X	W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
							      >		S X="?BAD"
							      >	QS	S DZ=X D D,QQ^DIEQ G B
							      >	D	S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ)
							      >	Y	I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="
							      >	PR	S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
							      >	R	I DG["P",@("$D(^"_X_"0))") S X=+$P(^(0),U,2) G RP:'$D
							      >		I DG["V",+Y,$P(Y,";",2)["(",$D(@(U_$P(Y,";",2)_"0)"))
							      >		X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":"
							      >	RP	D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
							      >	I	I DV'["I",DV'["#" G RD
							      >		D E^DIE0 G RD:$D(X),PR
							      >		Q
							      >	SET	N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=
							      >		I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
							      >		D ^DIR I 'DDER S %=Y(0),X=Y
							      >		Q
							      >	BEGIN	S DNM="A1CKC4",DQ=1
							      >	1	D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".362;12",DV="SX",DU=
							      >		S DE(DW)="C1^A1CKC4"
							      >		S DU="Y:YES;N:NO;U:UNKNOWN;"
							      >		S X=AA
							      >		S Y=X
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	C1	G C1S:$D(DE(1))[0 K DB S X=DE(1),DIC=DIE
							      >		X ^DD(2,.36205,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT
							      >		S X=DE(1),DIC=DIE
							      >		S DFN=DA D EN^DGMTCOR K DGMTCOR
							      >		S X=DE(1),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >		S X=DE(1),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >	C1S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
							      >		X ^DD(2,.36205,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT
	X ^DD(2,1901,1,3,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D |		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >		Q
							      >	X1	S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK
							      >		Q
							      >		;
							      >	2	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=2 D X2 G A:$D(Y)[0,A:Y
							      >	X2	S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
							      >		Q
							      >	3	S DQ=4 ;@400
							      >	4	D:$D(DG)>9 F^DIE17,DE S DQ=4,DW=".362;13",DV="SX",DU=
							      >		S DE(DW)="C4^A1CKC4"
							      >		S DU="Y:YES;N:NO;U:UNKNOWN;"
							      >		S X=HB
							      >		S Y=X
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	C4	G C4S:$D(DE(4))[0 K DB S X=DE(4),DIC=DIE
							      >		X ^DD(2,.36215,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT
							      >		S X=DE(4),DIC=DIE
							      >		S DFN=DA D EN^DGMTCOR K DGMTCOR
							      >		S X=DE(4),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >		S X=DE(4),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >	C4S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
							      >		X ^DD(2,.36215,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT
	I ($T(AVAFC^VAFCDD01)'="") S VAFCF="1901;" D AVAFC^VA |		S DFN=DA D EN^DGMTCOR K DGMTCOR
							      >		S X=DG(DQ),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
	D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)	      |		D AUTOUPD^DGENA2(DA)
	I $D(DE(10))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(D |		Q
							      >	X4	S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK
							      >		Q
							      >		;
							      >	5	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=5 D X5 G A:$D(Y)[0,A:Y
							      >	X5	S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
							      >		Q
							      >	6	S DQ=7 ;@999
							      >	7	G 0^DIE17
diff -y --suppress-common-lines ./VADemo/r1/A1CKC5.m ./VADemo/r2/r/A1CKC5.m
A1CKC5	; ;07/02/04					      |	A1CKC5	; ;01/20/98
DE	S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE, |	DE	S DIE="^DPT(D0,.372,",DIC=DIE,DP=2.04,DL=2,DIEL=1,DU=
	I $D(^(.3)) S %Z=^(.3) S %=$P(%Z,U,1) S:%]"" DE(1)=%  |		I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,1) S:%]"" DE(1)=% S 
	I $D(^(.36)) S %Z=^(.36) S %=$P(%Z,U,1) S:%]"" DE(5)= <
	I $D(^(.362)) S %Z=^(.362) S %=$P(%Z,U,12) S:%]"" DE( <
	I $D(^("TYPE")) S %Z=^("TYPE") S %=$P(%Z,U,1) S:%]""  <
N	I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X |	N	I X="" G A:DV'["R",X:'DV,X:D'>0,A
P	I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_ |	P	I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_
Z	K DIC("S"),DLAYGO I $D(X),X'=U D:$G(DE(DW,"INDEX")) S |	Z	K DIC("S"),DLAYGO I $D(X),X'=U S DG(DW)=X S:DV["d" ^D
SAVEVALS	S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ |	BEGIN	S DNM="A1CKC5",DQ=1+D G B
	I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/ |	1	S DW="0;1",DV="MP31'X",DU="",DLB="RATED DISABILITIES 
	E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")	      |		S DU="DIC(31,"
	Q						      |		S X="`"_ISC
NKEY	W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G <
KEYCHK()	Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")	      <
BEGIN	S DNM="A1CKC5",DQ=1				      <
1	D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".3;1",DV="RSXa",DU=" <
	S DE(DW)="C1^A1CKC5"				      <
	S DU="Y:YES;N:NO;"				      <
	S Y="N"						      <
	S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I <
	G RD						      <
C1	G C1S:$D(DE(1))[0 K DB				      <
	S X=DE(1),DIC=DIE				      <
	;						      <
	S X=DE(1),DIC=DIE				      <
	;						      <
	S X=DE(1),DIC=DIE				      <
	D AUTOUPD^DGENA2(DA)				      <
	S X=DE(1),DIC=DIE				      <
	I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".301;" D AVAFC^VA <
	S X=DE(1),DIC=DIE				      <
	D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)	      <
	S X=DE(1),DIIX=2_U_DIFLD D AUDIT^DIET		      <
C1S	S X="" G:DG(DQ)=X C1F1 K DB			      <
	S X=DG(DQ),DIC=DIE				      <
	X ^DD(2,.301,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D <
	S X=DG(DQ),DIC=DIE				      <
	X ^DD(2,.301,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D <
	S X=DG(DQ),DIC=DIE				      <
	D AUTOUPD^DGENA2(DA)				      <
	S X=DG(DQ),DIC=DIE				      <
	I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".301;" D AVAFC^VA <
	S X=DG(DQ),DIC=DIE				      <
	D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)	      <
	I $D(DE(1))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ <
C1F1	Q						      <
X1	S DFN=DA D EV^DGLOCK I $D(X),X="Y" D VET^DGLOCK	      <
	Q						      <
	;						      <
2	D:$D(DG)>9 F^DIE17,DE S DQ=2,DW=".362;14",DV="SX",DU= <
	S DE(DW)="C2^A1CKC5"				      <
	S DU="Y:YES;N:NO;U:UNKNOWN;"			      <
	S X=$S(PE="Y":"Y",1:"N")			      <
C2	G C2S:$D(DE(2))[0 K DB				      |	X1	I $D(X) D EK^DGLOCK Q
	S X=DE(2),DIC=DIE				      <
	X ^DD(2,.36235,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT <
	S X=DE(2),DIC=DIE				      <
	S DFN=DA D EN^DGMTCOR K DGMTCOR			      <
	S X=DE(2),DIC=DIE				      <
	K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^ <
	S X=DE(2),DIC=DIE				      <
	D AUTOUPD^DGENA2(DA)				      <
C2S	S X="" G:DG(DQ)=X C2F1 K DB			      <
	S X=DG(DQ),DIC=DIE				      <
	X ^DD(2,.36235,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT <
	S X=DG(DQ),DIC=DIE				      <
	S DFN=DA D EN^DGMTCOR K DGMTCOR			      <
	S X=DG(DQ),DIC=DIE				      <
	K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^ <
	S X=DG(DQ),DIC=DIE				      <
	D AUTOUPD^DGENA2(DA)				      <
C2F1	Q						      <
X2	S DFN=DA D MV^DGLOCK				      <
3	D:$D(DG)>9 F^DIE17,DE S DQ=3,DW=".362;12",DV="SX",DU= |	2	S DW="0;2",DV="RNJ3,0X",DU="",DLB="DISABILITY %",DIFL
	S DE(DW)="C3^A1CKC5"				      |		S X=+SCI(ISC)
	S DU="Y:YES;N:NO;U:UNKNOWN;"			      <
	S X=$S(AA="Y":"Y",1:"N")			      <
C3	G C3S:$D(DE(3))[0 K DB				      |	X2	K:+X'=X!(X>100)!(X<0)!(X?.E1"."1N.N) X I $D(X) D EK^D
	S X=DE(3),DIC=DIE				      <
	X ^DD(2,.36205,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT <
	S X=DE(3),DIC=DIE				      <
	S DFN=DA D EN^DGMTCOR K DGMTCOR			      <
	S X=DE(3),DIC=DIE				      <
	K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^ <
	S X=DE(3),DIC=DIE				      <
	D AUTOUPD^DGENA2(DA)				      <
C3S	S X="" G:DG(DQ)=X C3F1 K DB			      <
	S X=DG(DQ),DIC=DIE				      <
	X ^DD(2,.36205,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT <
	S X=DG(DQ),DIC=DIE				      <
	S DFN=DA D EN^DGMTCOR K DGMTCOR			      <
	S X=DG(DQ),DIC=DIE				      <
	K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^ <
	S X=DG(DQ),DIC=DIE				      <
	D AUTOUPD^DGENA2(DA)				      <
C3F1	Q						      <
X3	S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK     <
4	D:$D(DG)>9 F^DIE17,DE S DQ=4,DW=".362;13",DV="SX",DU= |	3	S DW="0;3",DV="SX",DU="",DLB="SERVICE CONNECTED",DIFL
	S DE(DW)="C4^A1CKC5"				      |		S DU="0:NO;1:YES;"
	S DU="Y:YES;N:NO;U:UNKNOWN;"			      |		S Y="1"
	S X=$S(HB="Y":"Y",1:"N")			      <
	S Y=X						      <
C4	G C4S:$D(DE(4))[0 K DB				      |	X3	S DFN=DA(1) D:X SC^DGLOCK1 I $D(X) D EK^DGLOCK 
	S X=DE(4),DIC=DIE				      <
	X ^DD(2,.36215,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT <
	S X=DE(4),DIC=DIE				      <
	S DFN=DA D EN^DGMTCOR K DGMTCOR			      <
	S X=DE(4),DIC=DIE				      <
	K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^ <
	S X=DE(4),DIC=DIE				      <
	D AUTOUPD^DGENA2(DA)				      <
C4S	S X="" G:DG(DQ)=X C4F1 K DB			      <
	D ^A1CKC6					      <
C4F1	Q						      <
X4	S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK     <
5	D:$D(DG)>9 F^DIE17,DE S DQ=5,DW=".36;1",DV="*P8'Xa",D |	4	G 1^DIE17
	S DE(DW)="C5^A1CKC5"				      <
	S DU="DIC(8,"					      <
	S X=ELIG					      <
	S Y=X						      <
	S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I <
	G RD						      <
C5	G C5S:$D(DE(5))[0 K DB				      <
	D ^A1CKC7					      <
C5S	S X="" G:DG(DQ)=X C5F1 K DB			      <
	D ^A1CKC8					      <
C5F1	Q						      <
X5	S DFN=DA D EV^DGLOCK I $D(X) D ECD^DGLOCK1	      <
	Q						      <
	;						      <
6	D:$D(DG)>9 F^DIE17,DE S DQ=6,DW="TYPE;1",DV="RP391'a" <
	S DE(DW)="C6^A1CKC5"				      <
	S DU="DG(391,"					      <
	S X=DZT2					      <
	S Y=X						      <
	S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I <
	G RD						      <
C6	G C6S:$D(DE(6))[0 K DB				      <
	D ^A1CKC9					      <
C6S	S X="" G:DG(DQ)=X C6F1 K DB			      <
	D ^A1CKC10					      <
C6F1	Q						      <
X6	Q						      <
7	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=7 D X7 D:$D(DIEFIRE)#2 <
X7	S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)		      <
	Q						      <
8	S DQ=9 ;@30					      <
9	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=9 D X9 D:$D(DIEFIRE)#2 <
X9	I 'SCI S Y="@39"				      <
	Q						      <
10	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=10 D X10 D:$D(DIEFIRE) <
X10	S ISC=0						      <
	Q						      <
11	S DQ=12 ;@31					      <
12	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=12 D X12 D:$D(DIEFIRE) <
X12	S ISC=$O(SCI(ISC))				      <
	Q						      <
13	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=13 D X13 D:$D(DIEFIRE) <
X13	I 'ISC S Y="@39"				      <
	Q						      <
14	D:$D(DG)>9 F^DIE17 G ^A1CKC11			      <
diff -y --suppress-common-lines ./VADemo/r1/A1CKC6.m ./VADemo/r2/r/A1CKC6.m
A1CKC6	; ;07/02/04					      |	A1CKC6	; ;01/20/98
							      >		D DE G BEGIN
							      >	DE	S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,
							      >		I $D(^(.362)) S %Z=^(.362) S %=$P(%Z,U,12) S:%]"" DE(
							      >		K %Z Q
							      >		;
							      >	W	W !?DL+DL-2,DLB_": "
							      >		Q
							      >	O	D W W Y W:$X>45 !?9
							      >		I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
							      >		W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (N
							      >	TR	R X:DTIME E  S (DTOUT,X)=U W $C(7)
							      >		Q
							      >	A	K DQ(DQ) S DQ=DQ+1
							      >	B	G @DQ
							      >	RE	G PR:$D(DE(DQ)) D W,TR
							      >	N	I X="" G A:DV'["R",X:'DV,X:D'>0,A
							      >	RD	G QS:X?."?" I X["^" D D G ^DIE17
							      >		I X="@" D D G Z^DIE2
							      >		I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^
							      >	T	G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD
							      >		K DDER G X
							      >	P	I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_
							      >		G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
							      >		I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,
							      >	V	D @("X"_DQ) K YS
							      >	Z	K DIC("S"),DLAYGO I $D(X),X'=U S DG(DW)=X S:DV["d" ^D
							      >	X	W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
							      >		S X="?BAD"
							      >	QS	S DZ=X D D,QQ^DIEQ G B
							      >	D	S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ)
							      >	Y	I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="
							      >	PR	S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
							      >	R	I DG["P",@("$D(^"_X_"0))") S X=+$P(^(0),U,2) G RP:'$D
							      >		I DG["V",+Y,$P(Y,";",2)["(",$D(@(U_$P(Y,";",2)_"0)"))
							      >		X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":"
							      >	RP	D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
							      >	I	I DV'["I",DV'["#" G RD
							      >		D E^DIE0 G RD:$D(X),PR
							      >		Q
							      >	SET	N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=
							      >		I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
							      >		D ^DIR I 'DDER S %=Y(0),X=Y
							      >		Q
							      >	BEGIN	S DNM="A1CKC6",DQ=1
							      >	1	D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".362;14",DV="SX",DU=
							      >		S DE(DW)="C1^A1CKC6"
							      >		S DU="Y:YES;N:NO;U:UNKNOWN;"
							      >		S X=PE
							      >		S Y=X
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	C1	G C1S:$D(DE(1))[0 K DB S X=DE(1),DIC=DIE
							      >		X ^DD(2,.36235,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT
							      >		S X=DE(1),DIC=DIE
							      >		S DFN=DA D EN^DGMTCOR K DGMTCOR
							      >		S X=DE(1),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >		S X=DE(1),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >	C1S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
							      >		X ^DD(2,.36235,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT
							      >		S X=DG(DQ),DIC=DIE
							      >		S DFN=DA D EN^DGMTCOR K DGMTCOR
	X ^DD(2,.36215,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT |		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >		S X=DG(DQ),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >		Q
							      >	X1	S DFN=DA D MV^DGLOCK
							      >		Q
							      >		;
							      >	2	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=2 D X2 G A:$D(Y)[0,A:Y
							      >	X2	S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
							      >		Q
							      >	3	S DQ=4 ;@300
							      >	4	D:$D(DG)>9 F^DIE17,DE S DQ=4,DW=".362;12",DV="SX",DU=
							      >		S DE(DW)="C4^A1CKC6"
							      >		S DU="Y:YES;N:NO;U:UNKNOWN;"
							      >		S X=AA
							      >		S Y=X
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	C4	G C4S:$D(DE(4))[0 K DB S X=DE(4),DIC=DIE
							      >		X ^DD(2,.36205,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT
							      >		S X=DE(4),DIC=DIE
							      >		S DFN=DA D EN^DGMTCOR K DGMTCOR
							      >		S X=DE(4),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >		S X=DE(4),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >	C4S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
							      >		X ^DD(2,.36205,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT
	K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^ |		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >		Q
							      >	X4	S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK
							      >		Q
							      >		;
							      >	5	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=5 D X5 G A:$D(Y)[0,A:Y
							      >	X5	S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
							      >		Q
							      >	6	S DQ=7 ;@400
							      >	7	D:$D(DG)>9 F^DIE17 G ^A1CKC7
diff -y --suppress-common-lines ./VADemo/r1/A1CKC7.m ./VADemo/r2/r/A1CKC7.m
A1CKC7	; ;07/02/04					      |	A1CKC7	; ;01/20/98
	S X=DE(5),DIC=DIE				      |		D DE G BEGIN
							      >	DE	S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,
							      >		I $D(^(.362)) S %Z=^(.362) S %=$P(%Z,U,13) S:%]"" DE(
							      >		K %Z Q
	S X=DE(5),DIC=DIE				      |	W	W !?DL+DL-2,DLB_": "
	K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(2,.361,1,2,2.2) I |		Q
	S X=DE(5),DIC=DIE				      |	O	D W W Y W:$X>45 !?9
	X "I $S('$D(^DIC(8,+X,0)):0,$P(^(0),""^"",1)[""DOM"": |		I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
	S X=DE(5),DIC=DIE				      |		W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (N
	K ^DPT("AEL",DA,+X)				      |	TR	R X:DTIME E  S (DTOUT,X)=U W $C(7)
	S X=DE(5),DIC=DIE				      |		Q
							      >	A	K DQ(DQ) S DQ=DQ+1
							      >	B	G @DQ
							      >	RE	G PR:$D(DE(DQ)) D W,TR
							      >	N	I X="" G A:DV'["R",X:'DV,X:D'>0,A
							      >	RD	G QS:X?."?" I X["^" D D G ^DIE17
							      >		I X="@" D D G Z^DIE2
							      >		I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^
							      >	T	G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD
							      >		K DDER G X
							      >	P	I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_
							      >		G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
							      >		I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,
							      >	V	D @("X"_DQ) K YS
							      >	Z	K DIC("S"),DLAYGO I $D(X),X'=U S DG(DW)=X S:DV["d" ^D
							      >	X	W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
							      >		S X="?BAD"
							      >	QS	S DZ=X D D,QQ^DIEQ G B
							      >	D	S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ)
							      >	Y	I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="
							      >	PR	S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
							      >	R	I DG["P",@("$D(^"_X_"0))") S X=+$P(^(0),U,2) G RP:'$D
							      >		I DG["V",+Y,$P(Y,";",2)["(",$D(@(U_$P(Y,";",2)_"0)"))
							      >		X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":"
							      >	RP	D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
							      >	I	I DV'["I",DV'["#" G RD
							      >		D E^DIE0 G RD:$D(X),PR
							      >		Q
							      >	SET	N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=
							      >		I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
							      >		D ^DIR I 'DDER S %=Y(0),X=Y
							      >		Q
							      >	BEGIN	S DNM="A1CKC7",DQ=1
							      >	1	D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".362;13",DV="SX",DU=
							      >		S DE(DW)="C1^A1CKC7"
							      >		S DU="Y:YES;N:NO;U:UNKNOWN;"
							      >		S X=HB
							      >		S Y=X
							      >		S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I
							      >		G RD
							      >	C1	G C1S:$D(DE(1))[0 K DB S X=DE(1),DIC=DIE
							      >		X ^DD(2,.36215,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT
							      >		S X=DE(1),DIC=DIE
							      >		S DFN=DA D EN^DGMTCOR K DGMTCOR
							      >		S X=DE(1),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >		S X=DE(1),DIC=DIE
	S X=DE(5),DIIX=2_U_DIFLD D AUDIT^DIET		      |	C1S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
							      >		X ^DD(2,.36215,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT
							      >		S X=DG(DQ),DIC=DIE
							      >		S DFN=DA D EN^DGMTCOR K DGMTCOR
							      >		S X=DG(DQ),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^
							      >		S X=DG(DQ),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >		Q
							      >	X1	S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK
							      >		Q
							      >		;
							      >	2	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=2 D X2 G A:$D(Y)[0,A:Y
							      >	X2	S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
							      >		Q
							      >	3	S DQ=4 ;@999
							      >	4	G 0^DIE17
Only in ./VADemo/r1/: A1CKC8.m
Only in ./VADemo/r1/: A1CKC9.m
diff -y --suppress-common-lines ./VADemo/r1/A1CKC.m ./VADemo/r2/r/A1CKC.m
A1CKC	; GENERATED FROM 'A1CK VARO/DHCP' INPUT TEMPLATE(#150 |	A1CKC	; GENERATED FROM 'A1CK VARO/DHCP' INPUT TEMPLATE(#150
	I $D(^("VET")) S %Z=^("VET") S %=$P(%Z,U,1) S:%]"" DE |		I $D(^("VET")) S %Z=^("VET") S %=$P(%Z,U,1) S:%]"" DE
N	I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X |	N	I X="" G A:DV'["R",X:'DV,X:D'>0,A
P	I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_ |	P	I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_
Z	K DIC("S"),DLAYGO I $D(X),X'=U D:$G(DE(DW,"INDEX")) S |	Z	K DIC("S"),DLAYGO I $D(X),X'=U S DG(DW)=X S:DV["d" ^D
SAVEVALS	S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ <
	I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/ <
	E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")	      <
	Q						      <
NKEY	W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G <
KEYCHK()	Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")	      <
	N DIEZTMP,DIEZAR,DIEZRXR,DIIENS,DIXR K DIEFIRE,DIEBAD |		S:$D(DTIME)[0 DTIME=300 S D0=DA,DIEZ=1505,U="^"
	M DIEZAR=^DIE(1505,"AR") S DICRREC="TRIG^DIE17"	      |	1	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=1 D X1 G A:$D(Y)[0,A:Y
	S:$D(DTIME)[0 DTIME=300 S D0=DA,DIIENS=DA_",",DIEZ=15 <
1	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=1 D X1 D:$D(DIEFIRE)#2 <
C3	G C3S:$D(DE(3))[0 K DB				      |	C3	G C3S:$D(DE(3))[0 K DB S X=DE(3),DIC=DIE
	S X=DE(3),DIC=DIE				      <
	S X=DE(3),DIC=DIE				      <
	D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)	      <
C3S	S X="" G:DG(DQ)=X C3F1 K DB			      |	C3S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
	S X=DG(DQ),DIC=DIE				      <
	S X=DG(DQ),DIC=DIE				      |		Q:$D(DE(3))[0&(^DD(DP,DIFLD,"AUDIT")="e")  S X=DG(DQ)
	D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)	      |		Q
	I $D(DE(3))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ <
C3F1	Q						      <
C4	G C4S:$D(DE(4))[0 K DB				      |	C4	G C4S:$D(DE(4))[0 K DB S X=DE(4),DIC=DIE
	S X=DE(4),DIC=DIE				      <
	S X=DE(4),DIC=DIE				      <
	D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)	      <
C4S	S X="" G:DG(DQ)=X C4F1 K DB			      |	C4S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
	S X=DG(DQ),DIC=DIE				      <
	S X=DG(DQ),DIC=DIE				      |		Q:$D(DE(4))[0&(^DD(DP,DIFLD,"AUDIT")="e")  S X=DG(DQ)
	D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)	      |		Q
	I $D(DE(4))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ <
C4F1	Q						      <
C5	G C5S:$D(DE(5))[0 K DB				      |	C5	G C5S:$D(DE(5))[0 K DB S X=DE(5),DIC=DIE
	S X=DE(5),DIC=DIE				      <
	;						      |		X "S DFN=DA D EN^DGMTR K DGREQF"
	S X=DE(5),DIC=DIE				      <
	D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)	      <
C5S	S X="" G:DG(DQ)=X C5F1 K DB			      |	C5S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
	S X=DG(DQ),DIC=DIE				      <
	S X=DG(DQ),DIC=DIE				      |		Q:$D(DE(5))[0&(^DD(DP,DIFLD,"AUDIT")="e")  S X=DG(DQ)
	D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)	      |		Q
	I $D(DE(5))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ <
C5F1	Q						      <
C6	G C6S:$D(DE(6))[0 K DB				      |	C6	G C6S:$D(DE(6))[0 K DB S X=DE(6),DIC=DIE
	S X=DE(6),DIC=DIE				      <
C6S	S X="" G:DG(DQ)=X C6F1 K DB			      |	C6S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
	D ^A1CKC1					      |		X "S DFN=DA D EN^DGMTR K DGREQF"
C6F1	Q						      |		S X=DG(DQ),DIC=DIE
							      >		K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(2,.361,1,2,89.4) 
							      >		S X=DG(DQ),DIC=DIE
							      >		;
							      >		S X=DG(DQ),DIC=DIE
							      >		S ^DPT("AEL",DA,+X)=""
							      >		S X=DG(DQ),DIC=DIE
							      >		D AUTOUPD^DGENA2(DA)
							      >		Q:$D(DE(6))[0&(^DD(DP,DIFLD,"AUDIT")="e")  S X=DG(DQ)
							      >		Q
C7	G C7S:$D(DE(7))[0 K DB				      |	C7	G C7S:$D(DE(7))[0 K DB S X=DE(7),DIC=DIE
	S X=DE(7),DIC=DIE				      <
C7S	S X="" G:DG(DQ)=X C7F1 K DB			      |	C7S	S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
	D ^A1CKC2					      |		I ($T(AVAFC^VAFCDD01)'="") S VAFCF="391;" D AVAFC^VAF
C7F1	Q						      |		Q:$D(DE(7))[0&(^DD(DP,DIFLD,"AUDIT")="e")  S X=DG(DQ)
							      >		Q
8	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=8 D X8 D:$D(DIEFIRE)#2 |	8	D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=8 D X8 G A:$D(Y)[0,A:Y
10	D:$D(DG)>9 F^DIE17,DE S DQ=10,DW="VET;1",DV="RSXa",DU |	10	D:$D(DG)>9 F^DIE17 G ^A1CKC1
	S DE(DW)="C10^A1CKC"				      <
	S DU="Y:YES;N:NO;"				      <
	S Y="Y"						      <
	S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I <
	G RD						      <
C10	G C10S:$D(DE(10))[0 K DB			      <
	D ^A1CKC3					      <
C10S	S X="" G:DG(DQ)=X C10F1 K DB			      <
	D ^A1CKC4					      <
C10F1	Q						      <
X10	I $D(X) S:'$D(DPTX) DFN=DA D:'$D(^XUSEC("DG ELIGIBILI <
	Q						      <
	;						      <
11	D:$D(DG)>9 F^DIE17 G ^A1CKC5			      <
Only in ./VADemo/r1/: ABSVM1.m
Only in ./VADemo/r1/: ABSVMHV1.m
Only in ./VADemo/r1/: ABSVMLC1.m
Only in ./VADemo/r1/: ABSVMLC2.m
Only in ./VADemo/r1/: ABSVMLC3.m
Only in ./VADemo/r1/: ABSVM.m
Only in ./VADemo/r1/: ABSVMRV1.m
Only in ./VADemo/r1/: ABSVMS1.m
Only in ./VADemo/r1/: ABSVMUT1.m
Only in ./VADemo/r1/: ABSVMVV1.m
Only in ./VADemo/r1/: ABSVMVV2.m
Only in ./VADemo/r1/: ABSVMVV3.m
Only in ./VADemo/r1/: ACKQAG01.m
Only in ./VADemo/r1/: ACKQAG02.m
Only in ./VADemo/r1/: ACKQAG03.m
Only in ./VADemo/r1/: ACKQAG04.m
Only in ./VADemo/r1/: ACKQAG05.m
Only in ./VADemo/r1/: ACKQAG06.m
diff -y --suppress-common-lines ./VADemo/r1/ACKQAS3.m ./VADemo/r2/r/ACKQAS3.m
	;;3.0;QUASAR;**8**;Feb 11, 2000			      |		;;3.0;QUASAR;;Feb 11, 2000
	W !!,$P(^ICPT(ACK,0),U),"  ",$$PROCTXT^ACKQUTL8(ACK," |		W !!,$P(^ICPT(ACK,0),U),"  ",$P(^(0),U,2)
diff -y --suppress-common-lines ./VADemo/r1/ACKQASU.m ./VADemo/r2/r/ACKQASU.m
	;;3.0;QUASAR;**8**;Feb 11, 2000			      |		;;3.0;QUASAR;;Feb 11, 2000
	K ACKQSER,ACKQORG,ACKQIR,ACKQECON,ACKAPMNT,ICPTVDT,IC |		K ACKQSER,ACKQORG,ACKQIR,ACKQECON,ACKAPMNT
	. W !!,X,"   ",$$PROCTXT^ACKQUTL8(ACKDC,ACKVD)	      |		. W !!,X,"   ",$$GET1^DIQ(80,ACKDC,3)
diff -y --suppress-common-lines ./VADemo/r1/ACKQNQ.m ./VADemo/r2/r/ACKQNQ.m
	;;3.0;QUASAR;**8**;Feb 11, 2000			      |		;;3.0;QUASAR;;Feb 11, 2000
	. D GETS^DIQ(80,+ACKDC_",",".01","E","ACKTGT","ACKMSG |		. D GETS^DIQ(80,+ACKDC_",",".01;2;3","E","ACKTGT","AC
	. S ACKICD(ACKDN)=ACKDN_U_""_U_$$DIAGTXT^ACKQUTL8(+AC |		. S ACKICD(ACKDN)=ACKDN_U_ACKTGT(80,+ACKDC_",",2,"E")
diff -y --suppress-common-lines ./VADemo/r1/ACKQPCE1.m ./VADemo/r2/r/ACKQPCE1.m
ACKQPCE1	;HCIOFO/AG - Quasar/PCE Interface; August 199 |	ACKQPCE1	;HCIOFO/AG - Quasar/PCE Interface; August 199
	;;3.0;QUASAR;**1,2,5,7,8**;Feb 11, 2000		      |		;;3.0;QUASAR;**1,2**;Feb 11, 2000
	; initialize					      |		; initialise
	; initialize temp file				      |		; initialise temp file
	;  ^TMP("ACKQPCE1",$J,"FDA",509850.6,visit_",",fldnum |		;  ^TMP("ACKQPCE1",$j,"FDA",509850.6,visit_",",fldnum
							      >		; ----------------student---------------------
							      >		S ACKSTUD=@ACKFDA2@(7,"I")
							      >		I ACKSTUD'="" D
							      >		. S ACKSTUD=$$CONVERT1^ACKQUTL4(ACKSTUD)
							      >		. S ACKCT=ACKCT+1,@ACKAPI@("PROVIDER",ACKCT,"NAME")=A
	. S ACKNARR=$$LDIAGTXT^ACKQUTL8(ACKICD9,ACKVD)	      |		. S ACKNARR=$$GET1^DIQ(80,ACKICD9,10,"I")
	. ; check for updating PCE problem list flag	      <
	. . ; don't send if diagnosis provider blank	      <
	. . S ACKPLQT=$$PLIST^ACKQUTL6(ACKPAT,ACKICD9)	      |		. . I ACKPBLMP'="" S ACKPBLMP=$$CONVERT1^ACKQUTL4(ACK
	. . ; send new problem if not on list		      |		. . S @ACKAPI@("DX/PL",ACKCT,"ENC PROVIDER")=ACKPBLMP
	. . I 'ACKPLQT S @ACKAPI@("DX/PL",ACKCT,"PL ADD")=1   |		. . S ACKIFN=0,ACKPLQT=0
	. . ; make existing problem active if currently inact |		. . I $D(^AUPNPROB("AC",ACKPAT)) D
	. . I +ACKPLQT=1 D				      |		. . . F  S ACKIFN=$O(^AUPNPROB("AC",ACKPAT,ACKIFN)) Q
	. . . S @ACKAPI@("DX/PL",ACKCT,"PL IEN")=$P(ACKPLQT,U |		. . . . I $D(^AUPNPROB("B",ACKICD9,ACKIFN)) S ACKPLQT
	. . . S @ACKAPI@("DX/PL",ACKCT,"PL ACTIVE")="A"	      |		. . S:ACKPLQT @ACKAPI@("DX/PL",ACKCT,"PL IEN")=ACKPLQ
	. . ; send event date and encounter provider if updat |		. . S:'ACKPLQT @ACKAPI@("DX/PL",ACKCT,"PL ADD")="1"
	. . I +ACKPLQT'=2 D				      |		. . S @ACKAPI@("DX/PL",ACKCT,"EVENT D/T")=ACKVD
	. . . S @ACKAPI@("DX/PL",ACKCT,"EVENT D/T")=ACKVD     <
	. . . S ACKPBLMP=$$CONVERT1^ACKQUTL4(ACKPBLMP)	      <
	. . . S @ACKAPI@("DX/PL",ACKCT,"ENC PROVIDER")=ACKPBL <
	. ; Check for primary diagnosis			      <
	; First Diagnosis sent as Primary if No Primary defin |		;  First Diagnosis sent as Primary is No Primary defi
	. I ACKPROCP'="" S ACKPROCP=$$CONVERT1^ACKQUTL4(ACKPR |		. I ACKPROCP'="" S ACKPROCP=$$CONVERT1^ACKQUTL4(ACKPR
diff -y --suppress-common-lines ./VADemo/r1/ACKQR2.m ./VADemo/r2/r/ACKQR2.m
	;;3.0;QUASAR;**1,8**;Feb 11, 2000		      |		;;3.0;QUASAR;**1**;Feb 11, 2000
	D GETS^DIQ(81,ACKCPTN_",",".01","",ACKTMP,"ACKMSG")   |		D GETS^DIQ(81,ACKCPTN_",",".01;2","",ACKTMP,"ACKMSG")
	S ^TMP("ACKQR2",$J,"CPT",1,81,ACKCPTN_",",2)=$$PROCTX <
diff -y --suppress-common-lines ./VADemo/r1/ACKQR3.m ./VADemo/r2/r/ACKQR3.m
	;;3.0;QUASAR;**8**;Feb 11, 2000			      |		;;3.0;QUASAR;;Feb 11, 2000
	N ACKTMP,ACKMSG,ACKICD9,ACKQDTXT		      |		N ACKTMP,ACKMSG,ACKICD9
	D GETS^DIQ(80,ACKICDN_",",".01","",ACKTMP,"ACKMSG")   |		D GETS^DIQ(80,ACKICDN_",",".01;3","",ACKTMP,"ACKMSG")
	S ACKQDTXT=$$DIAGTXT^ACKQUTL8(ACKICDN,"")	      <
	S ^TMP("ACKQR3",$J,"ICD9",1,80,ACKICDN_",",3)=ACKQDTX <
diff -y --suppress-common-lines ./VADemo/r1/ACKQR4.m ./VADemo/r2/r/ACKQR4.m
	;;3.0;QUASAR;**8**;Feb 11, 2000			      |		;;3.0;QUASAR;;Feb 11, 2000
	N ACKTME					      |		K ^TMP("ACKQR4",$J) S ACKPG=0 D NOW^%DTC S ACKXDT=$$N
	K ^TMP("ACKQR4",$J) S ACKPG=0			      <
	D NOW^%DTC					      <
	S ACKXDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%) <
	..S ACKPN=$P($G(^ICPT(ACKPP,0)),U) Q:ACKPN=""  S ACKP |		..S ACKPN=$P($G(^ICPT(ACKPP,0)),U) Q:ACKPN=""  S ACKP
	..S ACKM=0					      |		..; Has the procedure ben allocated a Modifier
							      >		..S ACKM=$P(ACKPD,U,2) S:ACKM="" ACKM=0
							      >		..I ACKM]0 S ACKMP=$O(^ACK(509850.4,ACKPP,1,"B",ACKM,
							      >		...I 'ACKMP S ACKPDSC="" Q
							      >		...S ACKPDSC=$P(^ACK(509850.4,ACKPP,1,ACKMP,0),U,2),A
diff -y --suppress-common-lines ./VADemo/r1/ACKQTE10.m ./VADemo/r2/r/ACKQTE10.m
ACKQTE10	; ;07/15/03				      |	ACKQTE10	; ;04/12/01
C1S	S X="" G:DG(DQ)=X C1F1 K DB			      |	C1S	S X="" Q:DG(DQ)=X  K DB
C1F1	Q						      |		Q
C6S	S X="" G:DG(DQ)=X C6F1 K DB			      |	C6S	S X="" Q:DG(DQ)=X  K DB
C6F1	Q						      |		Q
C8S	S X="" G:DG(DQ)=X C8F1 K DB			      |	C8S	S X="" Q:DG(DQ)=X  K DB
C8F1	Q						      |		Q
diff -y --suppress-common-lines ./VADemo/r1/ACKQTE11.m ./VADemo/r2/r/ACKQTE11.m
ACKQTE11	; ;07/15/03				      |	ACKQTE11	; ;04/12/01
C1S	S X="" G:DG(DQ)=X C1F1 K DB			      |	C1S	S X="" Q:DG(DQ)=X  K DB
C1F1	Q						      |		Q
C2S	S X="" G:DG(DQ)=X C2F1 K DB			      |	C2S	S X="" Q:DG(DQ)=X  K DB
C2F1	Q						      |		Q
C4S	S X="" G:DG(DQ)=X C4F1 K DB			      |	C4S	S X="" Q:DG(DQ)=X  K DB
C4F1	Q						      |		Q
diff -y --suppress-common-lines ./VADemo/r1/ACKQTE12.m ./VADemo/r2/r/ACKQTE12.m
ACKQTE12	; ;07/15/03				      |	ACKQTE12	; ;04/12/01
C2S	S X="" G:DG(DQ)=X C2F1 K DB			      |	C2S	S X="" Q:DG(DQ)=X  K DB
C2F1	Q						      |		Q
diff -y --suppress-common-lines ./VADemo/r1/ACKQTE1.m ./VADemo/r2/r/ACKQTE1.m
ACKQTE1	; ;07/15/03					      |	ACKQTE1	; ;04/12/01
diff -y --suppress-common-lines ./VADemo/r1/ACKQTE2.m ./VADemo/r2/r/ACKQTE2.m
ACKQTE2	; ;07/15/03					      |	ACKQTE2	; ;04/12/01
diff -y --suppress-common-lines ./VADemo/r1/ACKQTE3.m ./VADemo/r2/r/ACKQTE3.m
ACKQTE3	; ;07/15/03					      |	ACKQTE3	; ;04/12/01
C1S	S X="" G:DG(DQ)=X C1F1 K DB			      |	C1S	S X="" Q:DG(DQ)=X  K DB
C1F1	Q						      |		Q
C14S	S X="" G:DG(DQ)=X C14F1 K DB			      |	C14S	S X="" Q:DG(DQ)=X  K DB
C14F1	Q						      |		Q
C19S	S X="" G:DG(DQ)=X C19F1 K DB			      |	C19S	S X="" Q:DG(DQ)=X  K DB
C19F1	Q						      |		Q
C23S	S X="" G:DG(DQ)=X C23F1 K DB			      |	C23S	S X="" Q:DG(DQ)=X  K DB
C23F1	Q						      |		Q
diff -y --suppress-common-lines ./VADemo/r1/ACKQTE4.m ./VADemo/r2/r/ACKQTE4.m
ACKQTE4	; ;07/15/03					      |	ACKQTE4	; ;04/12/01
C1S	S X="" G:DG(DQ)=X C1F1 K DB			      |	C1S	S X="" Q:DG(DQ)=X  K DB
C1F1	Q						      |		Q
C5S	S X="" G:DG(DQ)=X C5F1 K DB			      |	C5S	S X="" Q:DG(DQ)=X  K DB
C5F1	Q						      |		Q
X7	I '$$PROB^ACKQUTL4(ACKPCE,ACKDIV)!(+$$PLIST^ACKQUTL6( |	X7	I '$$PROB^ACKQUTL4(ACKPCE,ACKDIV) S Y="@49"
X10	I '$$PROB^ACKQUTL4(ACKPCE,ACKDIV)!(+$$PLIST^ACKQUTL6( |	X10	I '$$PROB^ACKQUTL4(ACKPCE,ACKDIV) S Y="@49"
C11S	S X="" G:DG(DQ)=X C11F1 K DB			      |	C11S	S X="" Q:DG(DQ)=X  K DB
C11F1	Q						      |		Q
diff -y --suppress-common-lines ./VADemo/r1/ACKQTE5.m ./VADemo/r2/r/ACKQTE5.m
ACKQTE5	; ;07/15/03					      |	ACKQTE5	; ;04/12/01
C1S	S X="" G:DG(DQ)=X C1F1 K DB			      |	C1S	S X="" Q:DG(DQ)=X  K DB
C1F1	Q						      |		Q
C6S	S X="" G:DG(DQ)=X C6F1 K DB			      |	C6S	S X="" Q:DG(DQ)=X  K DB
C6F1	Q						      |		Q
C11S	S X="" G:DG(DQ)=X C11F1 K DB			      |	C11S	S X="" Q:DG(DQ)=X  K DB
C11F1	Q						      |		Q
C15S	S X="" G:DG(DQ)=X C15F1 K DB			      |	C15S	S X="" Q:DG(DQ)=X  K DB
C15F1	Q						      |		Q
C18S	S X="" G:DG(DQ)=X C18F1 K DB			      |	C18S	S X="" Q:DG(DQ)=X  K DB
C18F1	Q						      |		Q
diff -y --suppress-common-lines ./VADemo/r1/ACKQTE6.m ./VADemo/r2/r/ACKQTE6.m
ACKQTE6	; ;07/15/03					      |	ACKQTE6	; ;04/12/01
C1S	S X="" G:DG(DQ)=X C1F1 K DB			      |	C1S	S X="" Q:DG(DQ)=X  K DB
C1F1	Q						      |		Q
diff -y --suppress-common-lines ./VADemo/r1/ACKQTE7.m ./VADemo/r2/r/ACKQTE7.m
ACKQTE7	; ;07/15/03					      |	ACKQTE7	; ;04/12/01
C32S	S X="" G:DG(DQ)=X C32F1 K DB			      |	C32S	S X="" Q:DG(DQ)=X  K DB
C32F1	Q						      |		Q
diff -y --suppress-common-lines ./VADemo/r1/ACKQTE8.m ./VADemo/r2/r/ACKQTE8.m
ACKQTE8	; ;07/15/03					      |	ACKQTE8	; ;04/12/01
C1S	S X="" G:DG(DQ)=X C1F1 K DB			      |	C1S	S X="" Q:DG(DQ)=X  K DB
C1F1	Q						      |		Q
diff -y --suppress-common-lines ./VADemo/r1/ACKQTE9.m ./VADemo/r2/r/ACKQTE9.m
ACKQTE9	; ;07/15/03					      |	ACKQTE9	; ;04/12/01
C1S	S X="" G:DG(DQ)=X C1F1 K DB			      |	C1S	S X="" Q:DG(DQ)=X  K DB
C1F1	Q						      |		Q
C22S	S X="" G:DG(DQ)=X C22F1 K DB			      |	C22S	S X="" Q:DG(DQ)=X  K DB
C22F1	Q						      |		Q
diff -y --suppress-common-lines ./VADemo/r1/ACKQTE.m ./VADemo/r2/r/ACKQTE.m
ACKQTE	; GENERATED FROM 'ACKQAS VISIT ENTRY' INPUT TEMPLATE( |	ACKQTE	; GENERATED FROM 'ACKQAS VISIT ENTRY' INPUT TEMPLATE(
C10S	S X="" G:DG(DQ)=X C10F1 K DB			      |	C10S	S X="" Q:DG(DQ)=X  K DB
C10F1	Q						      |		Q
C13S	S X="" G:DG(DQ)=X C13F1 K DB			      |	C13S	S X="" Q:DG(DQ)=X  K DB
C13F1	Q						      |		Q
C18S	S X="" G:DG(DQ)=X C18F1 K DB			      |	C18S	S X="" Q:DG(DQ)=X  K DB
C18F1	Q						      |		Q
Only in ./VADemo/r1/: ACKQUT1.m
diff -y --suppress-common-lines ./VADemo/r1/ACKQUTL3.m ./VADemo/r2/r/ACKQUTL3.m
ACKQUTL3	;HCIOFO/AG - QUASAR Utility Routine ; 12/13/0 |	ACKQUTL3	;HCIOFO/AG -QUASAR Utility Routine ; [ 04/25/
	;;3.0;QUASAR;**5**;Feb 11, 2000			      |		;;3.0;QUASAR;;Feb 11, 2000
	;           ACKTM - time of visit (reqd)  (qsr time . |		;           ACKTM - time of vsit (reqd)  (qsr time .n
	; get the visit data from PCE (places it in ^TMP("PXK |		; get the visit data from PCE (places it in ^TMP("PXK
	N ACKTMP,ACKVIEN,ACKDT,ACKDT1,ACKIVDT,ACKDIEN,ACKICD, |		N ACKTMP,ACKVIEN,ACKDT,ACKIVDT,ACKDIEN,ACKICD,ACKARR
	. . S ACKDT1=$G(@ACKTMP@(2,ACKICD))		      |		. . S @ACKTMP@(2,ACKICD,ACKDT)=""  ; ICD list includi
	. . I ('ACKDT1)!(ACKDT1>ACKDT) S @ACKTMP@(2,ACKICD)=A <
	; sort new diagnosis list by date		      |		; update diagnosis history
	S ACKICD="" F  S ACKICD=$O(@ACKTMP@(2,ACKICD)) Q:ACKI <
	. S ACKDT=@ACKTMP@(2,ACKICD) S @ACKTMP@(3,ACKDT,ACKIC <
	;						      <
	; update diagnosis history 			      <
	S (ACKDT,ACKICD)="" F  S ACKDT=$O(@ACKTMP@(3,ACKDT))  |		S ACKICD="" F  S ACKICD=$O(@ACKTMP@(2,ACKICD)) Q:ACKI
	. K ACKARR					      |		. S ACKDT="" F  S ACKDT=$O(@ACKTMP@(2,ACKICD,ACKDT)) 
	. S ACKARR(509850.22,"?+1,"_ACKPAT_",",.01)=ACKICD    |		. . K ACKARR
	. S ACKARR(509850.22,"?+1,"_ACKPAT_",",1)=ACKDT	      |		. . S ACKARR(509850.22,"+1,"_ACKPAT_",",.01)=ACKICD
	. D UPDATE^DIE("","ACKARR","","")		      |		. . S ACKARR(509850.22,"+1,"_ACKPAT_",",1)=ACKDT
							      >		. . D UPDATE^DIE("","ACKARR","","")
diff -y --suppress-common-lines ./VADemo/r1/ACKQUTL4.m ./VADemo/r2/r/ACKQUTL4.m
	;;3.0;QUASAR;**1,8**;Feb 11, 2000		      |		;;3.0;QUASAR;**1**;Feb 11, 2000
	S (ICPTVDT,ICDVDT)=ACKVD			      <
	;						      <
	S ACKEVENT=1					      <
	. . . W ?19,$$MODTXT^ACKQUTL8(ACKTMOD("DILIST",1,ACKK |		. . . W ?19,$$GET1^DIQ(81.3,ACKTMOD("DILIST",1,ACKKEY
	. S ACKD($S(ACKI?.NP:+ACKI,1:ACKI))=ACKI_$E("   ",1,7 |		. S ACKD($S(ACKI?.NP:+ACKI,1:ACKI))=ACKI_$E("   ",1,7
	. W !,"  "_$$GET1^DIQ(81.3,ACK1,.01),?5,$$MODTXT^ACKQ |		. W !,"  "_$$GET1^DIQ(81.3,ACK1,.01),?5,$$GET1^DIQ(81
diff -y --suppress-common-lines ./VADemo/r1/ACKQUTL5.m ./VADemo/r2/r/ACKQUTL5.m
	;;3.0;QUASAR;**1,4,6,8**;Feb 11, 2000		      |		;;3.0;QUASAR;**1,4**;Feb 11, 2000
	N ACKQDDD					      |		S DIC("W")="W ""  "",$$GET1^DIQ(81.3,Y,.02),?48,$$GET
	S ACKQDDD=$G(ACKVD)				      <
	S DIC("W")="W ""  "",$$MODTXT^ACKQUTL8(Y,"_ACKQDDD_") <
	;						      <
	;						      <
	N ACKQDDD					      <
	S ACKQDDD=$G(ACKVD)				      <
	S DIC("W")="W ""  "",$$MODTXT^ACKQUTL8(Y,"_ACKQDDD_") |		S DIC("W")="W ""  "",$$GET1^DIQ(81.3,Y,.02)"
	;						      <
	;						      <
	N ACKQCD,ACKQQD,ACKQQCPT,ACKPARAM		      |		N ACKQCD,ACKQQD,ACKQQCPT
	S ACKPARAM=$P($$CPT^ICPTCOD(ACKQCD,ACKVD),"^",7) I 'A <
diff -y --suppress-common-lines ./VADemo/r1/ACKQUTL6.m ./VADemo/r2/r/ACKQUTL6.m
ACKQUTL6	;HCIOFO/BH-A&SP Utilities routine ; 5/6/03 11 |	ACKQUTL6	;HCIOFO/BH-A&SP Utilities routine ; 04/01/99
	;;3.0;QUASAR;**1,7**;Feb 11, 2000		      |		;;3.0;QUASAR;**1**;Feb 11, 2000
	;           the Appointment time field (#55) of the v |		;           the Appopintment time field (#55) of the 
	;  defined.  This will only be defined if DUPECHK ret |		;  defined.  This will onl be defined if DUPECHK retu
IDATE(D0,Y)	;  Checks that the entered Inactive date fall |	IDATE(D0,Y)	;  Checks the the entered Inactive date falls
ADATE(D0,Y)	;  Checks that the entered Active date falls  |	ADATE(D0,Y)	;  Checks the the entered Active date falls b
PLIST(ACKPAT,ACKDC)	; Determines if an entry exists in th <
	; returns Status as first piece, Problem List IEN as  <
	; (Status^IEN)					      <
	; Status values -  1=Inactive, 2=Active		      <
	N ACKIFN,ACKPLQT				      <
	S (ACKIFN,ACKPLQT)=0				      <
	I $D(^AUPNPROB("AC",ACKPAT)) D			      <
	. F  S ACKIFN=$O(^AUPNPROB("AC",ACKPAT,ACKIFN)) Q:(AC <
	. .I $D(^AUPNPROB("B",ACKDC,ACKIFN)) S ACKPLQT=ACKIFN <
	I ACKPLQT Q $S($P($G(^AUPNPROB(ACKPLQT,0)),U,12)="A": <
	Q 0						      <
diff -y --suppress-common-lines ./VADemo/r1/ACKQUTL7.m ./VADemo/r2/r/ACKQUTL7.m
	;;3.0;QUASAR;**8**;Feb 11, 2000			      |		;;3.0;QUASAR;;Feb 11, 2000
	. D GETS^DIQ(80,+ACKDC_",",".01;2","E","ACKTGT","ACKM |		. D GETS^DIQ(80,+ACKDC_",",".01;2;3","E","ACKTGT","AC
	. S ACKICD(ACKDN)=ACKDN_U_ACKTGT(80,+ACKDC_",",2,"E") |		. S ACKICD(ACKDN)=ACKDN_U_ACKTGT(80,+ACKDC_",",2,"E")
ERROR	; Display error message if registration returns error <
	; that the Appointment Management database is not ava <
	;						      <
	N ACKERR					      <
	W !!!!,"   ** The Appointment Management Data Base is <
	W !!,"   ** Please report this problem to IRM as soon <
	W "   Press any key to continue."		      <
	R ACKERR:DTIME					      <
	; 						      <
	Q						      <
	;						      <
diff -y --suppress-common-lines ./VADemo/r1/ACKQUTL8.m ./VADemo/r2/r/ACKQUTL8.m
	;;3.0;QUASAR;**1,2,8**;Feb 11, 2000		      |		;;3.0;QUASAR;**1,2**;Feb 11, 2000
	;						      <
	;						      <
DIAGTXT(ACKQDCDS,ACKCVD)	;  Get Short ICD9 Description <
	N DIAGTXT					      <
	I $G(ACKCVD)="" S ACKCVD=$$DATE			      <
	; S DIAGTXT=$$GET1^DIQ(80,ACKQDCDS,3)		      <
	S DIAGTXT=$$ICDDX^ICDCODE(ACKQDCDS,ACKCVD)	      <
	S DIAGTXT=$P(DIAGTXT,"^",4)			      <
	Q DIAGTXT					      <
	;						      <
LDIAGTXT(ACKQDCDS,ACKCVD)	;  Get Long ICD9 Description  <
	N LDIAGTXT,LST,RET				      <
	S ACKQDCDS=$$CONV(ACKQDCDS)			      <
	S LST="LST"					      <
	I $G(ACKCVD)="" S ACKCVD=$$DATE			      <
	; S LDIAGTXT=$$GET1^DIQ(80,ACKQDCDS,10)		      <
	S RET=$$ICDD^ICDCODE(ACKQDCDS,LST,ACKCVD)	      <
	I $P(RET,"^",1)="-1" S LDIAGTXT=$P(RET,"^",2)	      <
	I $P(RET,"^",1)'="-1" S LDIAGTXT=LST(1)		      <
	Q LDIAGTXT					      <
	;						      <
PROCTXT(ACKQDCDS,ACKCVD)	;  Get Short CPT Description  <
	N PROCTXT					      <
	I $G(ACKCVD)="" S ACKCVD=$$DATE			      <
	; S PROCTXT=$$GET1^DIQ(81,ACKQDCDS,2)		      <
	S PROCTXT=$$CPT^ICPTCOD(ACKQDCDS,ACKCVD)	      <
	S PROCTXT=$P(PROCTXT,"^",3)			      <
	Q PROCTXT					      <
	;						      <
MODTXT(ACKQMCDS,ACKCVD)	;  Get Short CPT Modifier Description <
	N MODTXT					      <
	I $G(ACKCVD)="" S ACKCVD=$$DATE			      <
	; S MODTXT=$$GET1^DIQ(81.3,ACKQMCDS,.02)	      <
	S MODTXT=$$MOD^ICPTMOD(ACKQMCDS,"I",ACKCVD)	      <
	S MODTXT=$P(MODTXT,"^",3)			      <
	Q MODTXT					      <
	;						      <
CONV(ACKQDCDS)	;					      <
	N CODE						      <
	S CODE=$P($G(^ICD9(ACKQDCDS,0)),"^",1)		      <
	Q CODE						      <
	;						      <
DATE()	;						      <
	D NOW^%DTC					      <
	Q $P(%,".",1)					      <
	;						      <
	;						      <
Only in ./VADemo/r2/r/: AFJXADD1.m
diff -y --suppress-common-lines ./VADemo/r1/AFJXMABX.m ./VADemo/r2/r/AFJXMABX.m
AFJXMABX	;FO-OAKLAND/GMB-PRINT BY SECTION NETWORK HEAL |	AFJXMABX	;FJ/CWS;PRINT BY SECTION NETWORK HEALTH EX's;
	;;5.1;Network Health Exchange;**1,2,10,11,15,34,35**; |		;;5.1;Network Health Exchange;**1,2,10,11,15**;Jan 23
	; Totally rewritten 3/2003.  (Previously FJ/CWS.)     |	FIRST	U IO(0) W @IOF R !!,"Which requests would you like   
	; Called from ^AFJXWCPM				      |		S:ANS="" ANS="Y"
ENTER	;						      |		D:ANS["Y" YOUR^AFJXMABX D:ANS["A" HERE^AFJXMABX D:ANS
	N AXNHEDUZ,AXABORT				      |		G FIRST
	S AXABORT=0					      |		Q
	S AXNHEDUZ=$$FIND1^DIC(200,"","X","NETWORK,HEALTH EXC |	HERE	S CT=0 D START,HEAD,PART2,TEXT,EXIT
	F  D  Q:AXABORT					      |		Q
	. N DIR,X,Y,AXLIST,AXCNT			      |	START	; BEGINNING
	. W @IOF					      |		; 612/fyb - remove hard sets, use HOME^%ZIS
	. S DIR(0)="SO^Y:Your Own;A:All"		      |		D HOME^%ZIS S:'$D(DTIME) DTIME=300 S U="^",(BEND,EMS)
	. S DIR("A")="Select the requests to list"	      |		S NPX="" F  S NPX=$O(^VA(200,"B","NETWORK,HEALTH EXCH
	. S DIR("B")="Your Own"				      |		Q
	. D ^DIR I $D(DIRUT) S AXABORT=1 Q		      |	HEAD1	Q:BEND>0  I IOST["C-" R !!,"Press return to continue 
	. D LIST(AXNHEDUZ,Y,.AXLIST,.AXCNT) Q:'AXCNT	      |		;
	. D CHOOSE(.AXLIST,AXCNT)			      |	HEAD	W @IOF,?10,"THIS REPORT CAN BE SENT TO A PRINTER OR R
	Q						      |		W !,"Message #",?20,"Subject",?60,"Date Sent",! S J=0
LIST(AXNHEDUZ,AXWHICH,AXLIST,AXCNT)	;		      |		Q
	N AXMZ,AXREC,AXSUBJ,AXABORT,AXLEN,AXDATE	      |	PART2	S MES="" F I=MES:0 S MES=$O(^XMB(3.7,NHXU,2,1,1,MES))
	S (AXCNT,AXMZ,AXABORT)=0			      |		Q
	S AXLEN("#")=$L($$BMSGCT^XMXUTIL(AXNHEDUZ,1))	      |	DAT	S MESSA=$P($G(^XMB(3.9,MES,0)),U,1),SNDR=$P($G(^XMB(3
	S AXLEN("S")=79-14-AXLEN("#")-2-2+10		      |		Q
	D LHDR(AXWHICH,.AXLEN)				      |	WRITE	I $E(DAT,4,4)?1A S X=$P(DAT," ",1,3) D ^%DT S DAT=Y,D
	F  S AXMZ=$O(^XMB(3.7,AXNHEDUZ,2,1,1,AXMZ)) Q:'AXMZ   |		S:DAT'["@" DAT=$E(DAT,4,5)_"/"_$E(DAT,6,7)_"/"_$E(DAT
	. S AXREC=$G(^XMB(3.9,AXMZ,0))			      |	WDT	Q:(MESSA'["<")!($G(BEND)'="")  S CT=CT+1,CT(CT)=MES W
	. S AXSUBJ=$P(AXREC,U,1) Q:$E(AXSUBJ,19,19)'?1A!(AXSU |		Q
	. I AXWHICH="Y",$P($G(^XMB(3.9,AXMZ,2,1,0)),U,2)'=DUZ |	TEXT	R !!,"Type the number of the report you would like to
	. I $Y+5>IOSL D  Q:AXABORT			      |		I EMS'?.N W !,"PLEASE TYPE THE NUMBER DISPLAYED" G TE
	. . I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.AXABORT) Q:AX |		S MESSA=$P($G(^XMB(3.9,CT(EMS),0)),U,1) ;CFB 12/15/95
	. . D LHDR(AXWHICH,.AXLEN)			      |		I MESSA'["<" W !,"This does not appear to be a Networ
	. S AXDATE=$$DATE^XMXUTIL2(AXREC)		      |	TY	S END=$P($G(^XMB(3.9,CT(EMS),2,0)),U,3) K TYPE,WD
	. S AXCNT=AXCNT+1,AXLIST(AXCNT)=AXMZ		      |	ONE	W !! S DIC("A")="Choose type: ",DIC="^AFJ(537015,",DI
	. W !,$J(AXCNT,AXLEN("#")),"  ",AXDATE,"  ",$E(AXSUBJ |		Q
	Q						      |	BEGIN	N %A,%E,%X D DT^DICRW S %ZIS="MFQ" D ^%ZIS Q:POP
LHDR(AXWHICH,AXLEN)	;				      |		; 612/fyb - thru BEGIN+8 - Queueing/Browser support
	W @IOF,$S(AXWHICH="Y":"Your",1:"All")," NHE Results"  |		I $D(IO("Q")) K IO("Q"),ZTI,ZTSK D  Q
	W !," #",?AXLEN("#")+2,"Date Sent       Subject"      |		. S ZTIO=ION_";"_IOST,ZTSAVE("*")="",ZTRTN="PRINT^AFJ
	W !,$$REPEAT^XLFSTR("=",79)			      |		. D ^%ZTLOAD I $D(ZTSK) W !,"Queued as Task #",ZTSK
	Q						      |		. K ZTDESC,ZTIO,ZTSAVE,ZTSK
CHOOSE(AXLIST,AXCNT)	;				      |		U IO D PRINT,^%ZISC ; G ONE Q; 612/fyb
	N DIR,X,Y,AXMZ,DIC,D,AXCOMP,AXABORT		      |		Q
	S AXABORT=0					      |	SECO	S MES="" F I=MES:0 S MES=$O(^XMB(3.7,NHXU,2,1,1,MES))
	W !						      |		Q
	S DIR(0)="NO^1:"_AXCNT				      |	FDAT	S MESSA=$P($G(^XMB(3.9,MES,0)),U,1),SNDR=$P($G(^XMB(3
	S DIR("A")="Select the report you'd like to print"    |		Q
	D ^DIR I $D(DIRUT) S AXABORT=1 Q		      |	FRIT	Q:YOU'=DUZ
	S AXMZ=AXLIST(Y)				      |		I $E(DAT,4,4)?1A S X=$P(DAT," ",1,3) D ^%DT S DAT=Y,D
	F  D  Q:AXABORT					      |		S:DAT'["@" DAT=$E(DAT,4,5)_"/"_$E(DAT,6,7)_"/"_$E(DAT
	. K DIC,X,Y,D					      |	FWDT	Q:(MESSA'["<")!($G(BEND)'="")  S CT=CT+1,CT(CT)=MES W
	. W !						      |		Q
	. S DIC("A")="Select Component: "		      |	PRINT	S (FLAGYES,PAGE)=0 F I=4:1:END S REC=$G(^XMB(3.9,CT(E
	. S DIC(0)="AEQZ",D="C" ; Lookup using only the C xre |		I FLAGYES=0  W !!,"   Sorry!  That component not cont
	. S DIC="^AFJ(537015,"				      |		Q
	. D IX^DIC I Y<0 S AXABORT=1 Q			      |	PRT2	Q:(REC'[PTY)!(I=END)
	. S AXCOMP=Y(0,0)				      |		D HD3
	. N AXSAVE,I,ZTSK				      |		F I=I:1:END S REC=$G(^XMB(3.9,CT(EMS),2,I,0)) Q:$E(RE
	. W !						      |		S FLAGYES=1
	. F I="AXCOMP","AXMZ" S AXSAVE(I)=""		      |		Q
	. D EN^XUTMDEVQ("PRINT^AFJXMABX","AFJX Print Complete |	HEAD2	I IOST["C-" R !!!,"Press return to continue or ""^"" 
	. I $D(ZTSK) W !,"Print queued.  Task number: ",ZTSK  |	HD3	S PAGE=PAGE+1 W @IOF,?70,"PAGE ",PAGE,! I $G(CT(EMS))
	Q						      |		Q
PRINT	; We assume that there may be more than 1 of the same |	EXIT	K YOU,BEND,CT,DAT,EMS,END,FLAGYES,MES,MESSA,NUM,PAGE,
	; and that they are not necessarily consecutive.      |	YOUR	S CT=0 D START,HEAD,SECO,TEXT,EXIT
	N AXI,AXTXT,AXPAGE,AXABORT,AXFOUND,AXDASH	      |		Q
	S (AXI,AXPAGE,AXABORT)=0,AXI=3,AXFOUND=0,AXDASH=$$REP |	TRIM(X,Y)	;CFB/TUSC/SF ENSURE NO LINE LONGER THAN Y
	D PHDR(AXMZ,.AXPAGE) W !			      |		Q $E(X,$L(X)-Y+1,$L(X))
	F  S AXI=$O(^XMB(3.9,AXMZ,2,AXI)) Q:'AXI  S AXTXT=$G( |		;
	. Q:AXTXT'[AXCOMP  Q:$E(AXTXT,71,78)'["------"	      <
	. S AXFOUND=1					      <
	. F  D  Q:'AXI!AXABORT  I $E(AXTXT,71,78)["------",AX <
	. . I $Y+3+($E(IOST,1,2)="C-")>IOSL D  Q:AXABORT      <
	. . . I $E(IOST,1,2)="C-" W ! D PAGE^XMXUTIL(.AXABORT <
	. . . D PHDR(AXMZ,.AXPAGE) W !			      <
	. . W !,AXTXT					      <
	. . S AXI=$O(^XMB(3.9,AXMZ,2,AXI)),AXTXT=$G(^(+AXI,0) <
	I 'AXFOUND W !,"Component '",AXCOMP,"' is not in this <
	Q						      <
	; We assume that there may be more than 1 of the same <
	; and if so, that they are consecutive.		      <
	;N AXI,AXTXT,AXPAGE,AXABORT			      <
	;S (AXI,AXPAGE,AXABORT)=0,AXI=3			      <
	;D PHDR(AXMZ,.AXPAGE) W !			      <
	;F  S AXI=$O(^XMB(3.9,AXMZ,2,AXI)) Q:'AXI  S AXTXT=$G <
	;I 'AXI W !,"Component '",AXCOMP,"' is not in this re <
	;W !,AXTXT					      <
	;F  S AXI=$O(^XMB(3.9,AXMZ,2,AXI)) Q:'AXI  S AXTXT=$G <
	;. I $Y+3+($E(IOST,1,2)="C-")>IOSL D  Q:AXABORT	      <
	;. . I $E(IOST,1,2)="C-" W ! D PAGE^XMXUTIL(.AXABORT) <
	;. . D PHDR(AXMZ,.AXPAGE) W !			      <
	;. W !,AXTXT					      <
	;Q						      <
PHDR(AXMZ,AXPAGE)	;				      <
	N AXI						      <
	S AXPAGE=AXPAGE+1				      <
	I $E(IOST,1,2)="C-"!$D(AXPAGE(0)) W @IOF	      <
	E  D  ; Don't eject when printing first page to print <
	. W $C(13)					      <
	. S AXPAGE(0)=""				      <
	W "NHE Results for ",$$NAME^XMXUTIL(DUZ),?70,$J("PAGE <
	F AXI=2,3 I $G(^XMB(3.9,AXMZ,2,AXI,0))'="" W !,^(0)   <
	W !,$$REPEAT^XLFSTR("=",79)			      <
	Q						      <
diff -y --suppress-common-lines ./VADemo/r1/AFJXMBOX.m ./VADemo/r2/r/AFJXMBOX.m
AFJXMBOX	;FO-OAKLAND/GMB-SEARCH for PREVIOUSLY COMPLET |	AFJXMBOX	;FJ/CWS;SEARCH for PREVIOUSLY COMPLETED NETWO
	;;5.1;Network Health Exchange;**2,11,34**;Jan 23, 199 |		;;5.1;Network Health Exchange;**2,11**;Jan 23, 1996
	; Totally rewritten 3/2003.  (Previously FJ/CWS.)     |		; 612/fyb
	; Called from ^AFJXWCP1 & ^AFJXWCPM		      |	FIRST	W @IOF R !!,"Which requests would you like   Y) Your 
ENTER	;						      |		S:ANS="" ANS="Y"
	N AXNHEDUZ,AXABORT				      |		D:ANS["Y" ^AFJXPNHF D:ANS["A" HERE^AFJXMBOX D:ANS["N"
	S AXABORT=0					      |		G FIRST
	S AXNHEDUZ=$$FIND1^DIC(200,"","X","NETWORK,HEALTH EXC <
	F  D  Q:AXABORT					      <
	. N DIR,X,Y,AXLIST,AXCNT			      <
	. W @IOF					      <
	. S DIR(0)="SO^Y:Your Own;A:All"		      <
	. S DIR("A")="Select the requests to list"	      <
	. S DIR("B")="Your Own"				      <
	. D ^DIR I $D(DIRUT) S AXABORT=1 Q		      <
	. D LIST^AFJXMABX(AXNHEDUZ,Y,.AXLIST,.AXCNT) Q:'AXCNT <
	. D CHOOSE(.AXLIST,AXCNT)			      <
	Q						      <
CHOOSE(AXLIST,AXCNT)	;				      <
	N DIR,X,Y,AXWHICH				      <
	W !						      <
	S DIR(0)="LCO^1:"_AXCNT				      <
	S DIR("A")="Select the reports you'd like to print"   <
	D ^DIR Q:$D(DIRUT)				      <
	S AXWHICH=Y					      <
	N AXSAVE,I,ZTSK					      <
	W !						      <
	F I="AXLIST(","AXWHICH" S AXSAVE(I)=""		      <
	D EN^XUTMDEVQ("PRINT^AFJXMBOX","AFJX Print Completed  <
	Q:'$D(ZTSK)					      <
	W !,"Print queued.  Task number: ",ZTSK		      <
	D WAIT^XMXUTIL					      <
	Q						      <
PRINT	;						      <
	N AXI,AXRANGE,AXJ,AXMZ,AXPAGE,AXABORT		      <
	S AXABORT=0					      <
	F AXI=1:1:$L(AXWHICH,",")-1 D  Q:AXABORT	      <
	. S AXRANGE=$P(AXWHICH,",",AXI)			      <
	. F AXJ=$P(AXRANGE,"-",1):1:$S(AXRANGE["-":$P(AXRANGE <
	. . D REPORT(AXLIST(AXJ),.AXPAGE,.AXABORT)	      <
	Q						      <
REPORT(AXMZ,AXPAGE,AXABORT)	;			      <
	N AXI,AXTXT					      <
	S (AXI,AXPAGE)=0,AXI=3				      <
	D PHDR^AFJXMABX(AXMZ,.AXPAGE)			      <
	F  S AXI=$O(^XMB(3.9,AXMZ,2,AXI)) Q:'AXI  S AXTXT=$G( <
	. I $Y+3+($E(IOST,1,2)="C-")>IOSL D  Q:AXABORT	      <
	. . I $E(IOST,1,2)="C-" W ! D PAGE^XMXUTIL(.AXABORT)  <
	. . D PHDR^AFJXMABX(AXMZ,.AXPAGE)		      <
	. W !,AXTXT					      <
	I 'AXABORT,$E(IOST,1,2)="C-" D PAGE^XMXUTIL(.AXABORT) <
							      >	HERE	S CT=0 D START,HEAD,PART2,TEXT,EXIT
							      >		Q
							      >	START	; BEGINNING
							      >		; 612/fyb - remove hard sets, use HOME^%ZIS
							      >		D HOME^%ZIS S:'$D(DTIME) DTIME=300 S U="^",(BEND,EMS)
							      >		S NPX="" F  S NPX=$O(^VA(200,"B","NETWORK,HEALTH EXCH
							      >		Q
							      >	HEAD1	Q:BEND>0  I IOST["C-" R !!,"Press return to continue 
							      >	HEAD	W @IOF,?10,"THIS REPORT CAN BE SENT TO A PRINTER OR R
							      >		W !,"Message #",?20,"Subject",?60,"Date Sent",! S J=0
							      >		Q
							      >	PART2	S MSG="" F I=MSG:0 S MSG=$O(^XMB(3.7,NHXU,2,1,1,MSG))
							      >		Q
							      >	DAT	;
							      >		S MESSA=$P($G(^XMB(3.9,MSG,0)),U,1),SNDR=$P($G(^XMB(3
							      >		Q
							      >	WRITE	I $E(DAT,4,4)?1A S X=$P(DAT," ",1,3) D ^%DT S DAT=Y,D
							      >		S:DAT'["@" DAT=$E(DAT,4,5)_"/"_$E(DAT,6,7)_"/"_$E(DAT
							      >	WDT	Q:(MESSA'["<")!($G(BEND)'="")  S CT=CT+1,CT(CT)=MSG W
							      >		Q
							      >	TEXT	W ! S DIR("A")="Type one number eg. 1 or up to ten nu
							      >		;S ONE=$P(EMS,",",1),TWO=$P(EMS,",",2),THR=$P(EMS,","
							      >		S Y=0 F X="ONE","TWO","THR","FUR","FIV","SIX","SEV","
							      >		S:ONE'="" ^TMP("NHMP",$J,ONE)="" S:TWO'="" ^TMP("NHMP
							      >		S:SEV'="" ^TMP("NHMP",$J,SEV)="" S:EIG'="" ^TMP("NHMP
							      >		;
							      >	BEGIN	N %A,%E,%X D DT^DICRW S %ZIS="MFQ" D ^%ZIS Q:POP
							      >		; 612/fyb - through BEGIN+8.  Queueing/Browser Suppor
							      >		I $D(IO("Q")) K IO("Q"),ZTI,ZTSK D  Q
							      >		. S ZTIO=ION_";"_IOST,ZTSAVE("*")="",ZTRTN="PRINT^AFJ
							      >		. D ^%ZTLOAD I $D(ZTSK) W !,"Queued as Task #",ZTSK
							      >		. K ZTDESC,ZTIO,ZTSAVE,ZTSK
							      >		U IO D PRINT,^%ZISC ;G FIRST Q ; 612/fyb - GOTO FIRST
							      >		Q
							      >	PRINT	I ONE'="" S MES=ONE D SPTS
							      >		I TWO'="" S MES=TWO D SPTS
							      >		I THR'="" S MES=THR D SPTS
							      >		I FUR'="" S MES=FUR D SPTS
							      >		I FIV'="" S MES=FIV D SPTS
							      >		I SIX'="" S MES=SIX D SPTS
							      >		I SEV'="" S MES=SEV D SPTS
							      >		I EIG'="" S MES=EIG D SPTS
							      >		I NIN'="" S MES=NIN D SPTS
							      >		I TEN'="" S MES=TEN D SPTS
							      >		Q
							      >		;
							      >	SPTS	S MESSA=$P($G(^XMB(3.9,MES,0)),U,1)
							      >		I MESSA'["<" W !,"This does not appear to be a Networ
							      >		Q:'$D(^XMB(3.9,MES,2,1,0))  S PAGE=1 W @IOF,?70,"PAGE
							      >		Q
							      >	HEAD2	I IOST["C-" R !!!,"Press return to continue or ""^"" 
							      >		S PAGE=PAGE+1 W @IOF,?70,"PAGE ",PAGE I $G(MES),$G(^X
							      >		Q
							      >	EXIT	K ^TMP("NHMP",$J),CT,DAT,DIR,EIG,EMS,FIV,FUR,MES,MESS
Only in ./VADemo/r2/r/: AFJXPNHF.m
Only in ./VADemo/r2/r/: AFJXPNHI.m
Only in ./VADemo/r2/r/: AFJXREW.m
diff -y --suppress-common-lines ./VADemo/r1/AFJXSFAL.m ./VADemo/r2/r/AFJXSFAL.m
	;;5.1;Network Health Exchange;**31,32,33,34**;Jan 23, |		;;5.1;Network Health Exchange;**31,32,33**;Jan 23, 19
	D EN^XUTMDEVQ("PRINT^AFJXSFAL","AFJX Print NHE Inquir |		D EN^XUTMDEVQ("PRINT^AFJXSFAL","AFJX Print Network He
	S AXI=3,(AXABORT,AXPAGE)=0			      |		S (AXI,AXABORT)=0,AXPAGE=1
	I $E(IOST,1,2)="C-" W @IOF			      |		I $G(IOST)["C-" W @IOF
	. I $Y+3+($E(IOST,1,2)="C-")>IOSL D  Q:AXABORT	      |		. I $Y+3+($G(IOST)["C-")>IOSL D  Q:AXABORT
	. . I $E(IOST,1,2)="C-" W ! D PAGE^XMXUTIL(.AXABORT)  |		. . I $G(IOST)["C-" W ! D PAGE^XMXUTIL(.AXABORT) Q:AX
	S AXPAGE=AXPAGE+1				      |		N I
	W "NHE Results for ",$$NAME^XMXUTIL(DUZ),?70,$J("Page |		W "NHE Results for ",$$NAME^XMXUTIL(DUZ),?70,"Page ",
	N I S I=0 F  S I=$O(AXHDR(I)) Q:'I  W !,AXHDR(I)      |		S I=0 F  S I=$O(AXHDR(I)) Q:'I  W !,AXHDR(I)
	W !,$$REPEAT^XLFSTR("=",79)			      |		W !,$$REPEAT^XLFSTR("-",79)
Only in ./VADemo/r2/r/: AFJXWCBP.m
diff -y --suppress-common-lines ./VADemo/r1/AFJXWCP1.m ./VADemo/r2/r/AFJXWCP1.m
	;;5.1;Network Health Exchange;**1,31,34**;Jan 23, 199 |		;;5.1;Network Health Exchange;**1,31**;Jan 23, 1996
	D:Y ENTER^AFJXMBOX				      |		D:Y FIRST^AFJXMBOX
Only in ./VADemo/r2/r/: AFJXWCPB.m
Only in ./VADemo/r2/r/: AFJXWCPD.m
diff -y --suppress-common-lines ./VADemo/r1/AFJXWCPM.m ./VADemo/r2/r/AFJXWCPM.m
	;;5.1;Network Health Exchange;**6,22,31,33,34**;Jan 2 |		;;5.1;Network Health Exchange;**6,22,31,33**;Jan 23, 
	D ENTER^AFJXMBOX				      |		D ^AFJXMBOX
							      >		K ANS,BEND,I,J,K,MSG,NHXU,NPX,X,Y,Z,ZTRTN
	D ENTER^AFJXMABX				      |		D ^AFJXMABX
							      >		K J,K,NHXU,NPX,ANS,I,ITR,ZTRTN
Only in ./VADemo/r2/r/: AFJXWCPY.m
Only in ./VADemo/r1/: ALPBBK.m
diff -y --suppress-common-lines ./VADemo/r1/ALPBCBU.m ./VADemo/r2/r/ALPBCBU.m
ALPBCBU	;OIFO-DALLAS/SED/KC/MW  BCMA-BCBU INPT TO HL7 ;5/2/20 |	ALPBCBU	;OIFO-DALLAS/SED/KC/MW  BCMA-BACKUP INPT TO HL7 ;5/2/
	N ALPRSLT					      <
	;I $P(ALPRSLT,U,2)'="" D ERRLG			      |		I $P(ALPRSLT,U,2)'="" D ERRLG
	N ALPRSLT					      <
NURV(ALDFN,ALPORD)	;Use this entry to send verifying nur <
	N ALPRSLT					      <
	;ALDFN is the IEN of the patient		      <
	;ALPORDR is the order number			      <
	Q:'$D(ALDFN)					      <
	Q:'$D(ALPORD)					      <
	;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL	      <
	Q:+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLI <
	K ALPB						      <
	D EN^PSJBCBU(ALDFN,ALPORD,.ALPB)		      <
	S ALPBI=0					      <
	F  S ALPBI=$O(ALPB(ALPBI)) Q:ALPBI'>0  D	      <
	. I $E(ALPB(ALPBI),1,3)="MSH" S MSH=ALPBI	      <
	. I $E(ALPB(ALPBI),1,3)="PID" S PID=ALPBI	      <
	. I $E(ALPB(ALPBI),1,3)="PV1" S PV1=ALPBI	      <
	. I $E(ALPB(ALPBI),1,3)="ORC" S ORC=ALPBI	      <
	I +MSH'>0 Q   ;MISSING MSH SEGMENT BAD MESSAGE	      <
	S MSCTR=$E(ALPB(MSH),4,8)			      <
	S ALPRSLT=$$INI^ALPBINP()			      <
	;I $P(ALPRSLT,U,2)'="" D ERRLG			      <
	K ALPB,ALPBI					      <
	Q						      <
	N ALPRSLT					      <
	S XQAMSG="BCBU Contingency Error"		      |		S XQAMSG="BCBU Contingecy Error"
	W @IOF,!,"PSB BCBU Contingency Error",!		      |		W @IOF,!,"PSB BCBU Contingecy Error",!
diff -y --suppress-common-lines ./VADemo/r1/ALPBELOG.m ./VADemo/r2/r/ALPBELOG.m
ALPBELOG	;OIFO-DALLAS MW,SED,KC - BCBU LOG PROCESSOR ; |	ALPBELOG	;emc,ets/mw,sd,kc-error log processor ;01/01/
	I $O(^ALPB(53.71,"C",""))="" D  Q		      |		I +$O(^ALPB(53.71,"C",0))'>0 D  Q
	S ALPBLINE=0					      |		S (ALPBIEN,ALPBLINE)=0
	S ALPBIEN=""					      |		F  S ALPBIEN=$O(^ALPB(53.71,"C",ALPBIEN)) Q:'ALPBIEN 
	F  S ALPBIEN=$O(^ALPB(53.71,"C",ALPBIEN)) Q:ALPBIEN=" |		.D CLEAN^ALPBUTL1(ALPBIEN)
	.I ALPBIEN>0 D CLEAN^ALPBUTL1(ALPBIEN)		      |		.I '$D(^ALPB(53.7,ALPBIEN,0)) Q
	.I ALPBIEN>0&('$D(^ALPB(53.7,ALPBIEN,0))) Q	      <
	.I ALPBPDAT="" S ALPBPDAT="SYSTEM/FILER ERROR^"	      |		.I ALPBPDAT="" K ALPBPDAT Q
	.S ALPBDATA(ALPBLINE,0)=" "_$P(ALPBPDAT,U)	      |		.S ALPBDATA(ALPBLINE,0)=" "_$P(ALPBPDAT,U)_" (SSN: "_
	.I $P(ALPBPDAT,U,2)'="" S ALPBDATA(ALPBLINE,0)=ALPBDA <
diff -y --suppress-common-lines ./VADemo/r1/ALPBFRM1.m ./VADemo/r2/r/ALPBFRM1.m
ALPBFRM1	;OIFO-DALLAS MW,SED,KC -STANDARD PRINT FORMAT |	ALPBFRM1	;emc,ets/mw,sd,kc-standard print formatting u
	; RESULTS = an array passed by reference into which t |		; RESULTS = an array passed by reference into which t
	;           entry is set up returns a formatted array |		;           entry is set up returns a formated array 
	N ALPBADM,ALPBDAYS,ALPBDRUG,ALPBIBOX,ALPBNBOX,ALPBPBO |		N ALPBADM,ALPBDAYS,ALPBIBOX,ALPBNBOX,ALPBPBOX,ALPBSTO
	; to use BOLD, comment out the next line and remove c <
	; the following five lines...			      <
	S BOLDON="<<",BOLDOFF=">>"			      <
	;S X="IOINHI;IOINORM"				      <
	;D ENDR^%ZISS					      <
	;S BOLDON=$G(IOINHI)				      <
	;S BOLDOFF=$G(IOINORM)				      <
	;D KILL^%ZISS					      <
	I DAYS=3 S RESULTS(2)=RESULTS(2)_"   Notes"	      |		;I ALPBADM<16&(DAYS=3) S RESULTS(2)=RESULTS(2)_"   No
							      >		; line 5...
							      >		; order number and type...
							      >		S RESULTS(5)="     Order #: "_$P(DATA(0),"^")
							      >		S RESULTS(5)=$$PAD^ALPBUTL(RESULTS(5),25)_"Type: "_$$
							      >		S RESULTS(6)="      Status: "_$P(DATA(0),"^",3)
	S LINE=4					      |		S LINE=6
	..S ALPBDRUG=$G(BOLDON)_$P(DATA(7,ALPBX,0),"^",2)_$G( |		..S RESULTS(LINE)=$G(RESULTS(LINE))_$P(DATA(7,ALPBX,0
	..;S RESULTS(LINE)=$G(RESULTS(LINE))_$P(DATA(7,ALPBX, <
	..S RESULTS(LINE)=$G(RESULTS(LINE))_ALPBDRUG	      <
	..K ALPBDRUG					      <
	..S ALPBDRUG=$P(DATA(8,ALPBX,0),"^",2)		      |		..S RESULTS(LINE)=RESULTS(LINE)_$P(DATA(8,ALPBX,0),"^
	..I $P(DATA(8,ALPBX,0),"^",3)'=""&(ALPBDRUG'[$P(DATA( |		..I $P(DATA(8,ALPBX,0),"^",3)'=""&($P(DATA(8,ALPBX,0)
	..S ALPBDRUG=$G(BOLDON)_ALPBDRUG_$G(BOLDOFF)	      <
	..S RESULTS(LINE)=RESULTS(LINE)_ALPBDRUG	      <
	..K ALPBDRUG					      <
	..S ALPBDRUG=$P(DATA(9,ALPBX,0),"^",2)		      |		..S RESULTS(LINE)=RESULTS(LINE)_$P(DATA(9,ALPBX,0),"^
	..I $P(DATA(9,ALPBX,0),"^",3)'=""&(ALPBDRUG'[$P(DATA( |		..I $P(DATA(9,ALPBX,0),"^",3)'=""&($P(DATA(9,ALPBX,0)
	..S ALPBDRUG=$G(BOLDON)_ALPBDRUG_$G(BOLDOFF)	      <
	..S RESULTS(LINE)=RESULTS(LINE)_ALPBDRUG	      <
	..K ALPBDRUG					      <
	;Set PRN Flag					      <
	S ALPBPRNG=0					      <
	S:$P($G(DATA(4)),"^",3)["PRN" ALPBPRNG=1	      <
	; order number and type...			      <
	S LINE=LINE+1					      <
	S RESULTS(LINE)="     Order #: "_$P(DATA(0),"^")      <
	S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),25)_"Type <
	; order status...				      <
	S LINE=LINE+1					      <
	S RESULTS(LINE)="      Status: "_$P($P(DATA(0),"^",3) <
	;S ALPBPRN=ALPBADM+4				      <
	.S ALPBPRN=I+3					      <
	; if PRN med, add line for documenting effectiveness. <
	I +ALPBPRNG D					      <
	.S ALPBFLG=0,ALPBPRN=ALPBPRN+1			      <
	.S:'$D(RESULTS(ALPBPRN)) RESULTS(ALPBPRN)=" ",ALPBFLG <
	.S RESULTS(ALPBPRN)=$$PAD^ALPBUTL(RESULTS(ALPBPRN),63 <
	.S:ALPBFLG LINE=LINE+1				      <
diff -y --suppress-common-lines ./VADemo/r1/ALPBFRM2.m ./VADemo/r2/r/ALPBFRM2.m
ALPBFRM2	;OIFO-DALLAS MW,SED,KC-STANDARD SCREEN DISPLA |	ALPBFRM2	;emc,ets/mw,sd,kc-standard screen display for
	S RESULTS(3)="       Status: "_$P($P(DATA(0),"^",3)," |		S RESULTS(3)="       Status: "_$P(DATA(0),"^",3)
	S RESULTS(3)="This record last updated: "_$S($P(DATA( |		S RESULTS(3)="BCBU Record Last Updated: "_$S($P(DATA(
diff -y --suppress-common-lines ./VADemo/r1/ALPBFRMU.m ./VADemo/r2/r/ALPBFRMU.m
ALPBFRMU	;OIFO-DALLAS MW,SED,KC-STANDARD PRINT FORMATT |	ALPBFRMU	;emc,ets/mw,sd,kc-standard print formatting u
	; DATA    = an array passed by reference containing t |		; DATA = an array passed by reference containing the 
	;           a patient's record in ^ALPB(53.7,...)     |		;        be formated
	; PG      = page number to use			      |		; PG   = page number to use
	N ALPBALG,ALPBALGL,ALPBALGX,ALPBX,LINE		      |		N ALPBCNT,ALPBX,LINE
	S RESULTS(4)=$$PAD^ALPBUTL(RESULTS(4),12)_"This recor |		S RESULTS(4)=$$PAD^ALPBUTL(RESULTS(4),12)_"BCBU Recor
	.S RESULTS(LINE)=""				      |		.S RESULTS(LINE)="Allergies: "
	.S ALPBALGX="Allergies: "			      <
	.S ALPBALGL=$L(ALPBALGX)-1			      <
	..S ALPBALG=$P($G(DATA(1,ALPBX,0)),"^",2)	      |		..S ALPBCNT=ALPBCNT+1
	..I ALPBALG="" K ALPBALG Q			      |		..I ALPBCNT>5 D
	..I $L(ALPBALGX_ALPBALG_"; ")>90 D		      <
	...S RESULTS(LINE)=""				      |		...S RESULTS(LINE)=" "
	...S ALPBALGX=""				      |		...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),12)
	...S ALPBALGX=$$PAD^ALPBUTL(ALPBALGX,ALPBALGL)	      |		..S RESULTS(LINE)=RESULTS(LINE)_$P($G(DATA(1,ALPBX,0)
	..S ALPBALGX=ALPBALGX_ALPBALG_$S(+$O(DATA(1,ALPBX)):" |		..I +$O(DATA(1,ALPBX)) S RESULTS(LINE)=RESULTS(LINE)_
	..S RESULTS(LINE)=ALPBALGX			      <
diff -y --suppress-common-lines ./VADemo/r1/ALPBGEN1.m ./VADemo/r2/r/ALPBGEN1.m
ALPBGEN1	;SFVAMC/JC - Parse and File HL7 PMU messages  |	ALPBGEN1	;SFVAMC/JC - Parse and File HL7 PMU messages 
							      >		;I "B01B02"'[$G(ALPBMT) G PERR
							      >		. ;Verify SSN
	H 1 S DATE=$$NOW^XLFDT M ^TMP("BCBU",$J,$S($G(ALPBSSN |		H 1 S DATE=$$NOW^XLFDT M ^TMP("BCBU","APPLICATION",DA
diff -y --suppress-common-lines ./VADemo/r1/ALPBGEN2.m ./VADemo/r2/r/ALPBGEN2.m
ALPBGEN2	;SFVAMC/JC - Init New Person Data on Workstat |	ALPBGEN2	;SFVAMC/JC - Init New Person Data on Workstat
	S (ALPBK)=0,ALPBJ="" F  S ALPBJ=$O(^VA(200,ALPBJ)) Q: |		S (ALPBK,ALPBJ)=0 F  S ALPBJ=$O(^VA(200,ALPBJ)) Q:ALP
	. Q:+ALPBJ<1					      |		. Q:ALPBJ<1
diff -y --suppress-common-lines ./VADemo/r1/ALPBGEN.m ./VADemo/r2/r/ALPBGEN.m
ALPBGEN	;SFVAMC/JC - Build HL7 PMU messages ;10/08/2003  14:1 |	ALPBGEN	;SFVAMC/JC - Build HL7 PMU messages ;04/18/2003  12:4
	;;3.0;BAR CODE MED ADMIN;**7**;May 2002		      |		;;2.0;BAR CODE MED ADMIN;**17**;May 2002
	;						      <
	;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL	      <
	Q:+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLI <
	;						      <
	;SFVAMC/JC - 10/8/03 ADD CHECK FOR BCMA USER STATUS   <
	Q:+$$ISBCMA^ALPBGEN2(XUIEN)<1			      <
	;						      <
	S EC=$G(HL("ECH")) Q:EC=""  ;Encoding Characters      |		S EC=$G(HL("ECH")) Q:EC=""  ;Encoding Charaters
	S RS=$E(EC,2) ;Repetition separator		      |		S RS=$E(EC,2) ;Repitition separator
	S EFS=ESC_"F"_ESC ;escaped field separator	      |		S EFS=ESC_"F"_ESC ;escaped field sep
	S ECS=ESC_"S"_ESC ;escaped component separator	      |		S ECS=ESC_"S"_ESC ;escaped component sep
	S ERS=ESC_"R"_ESC ; escaped Repetition separator      |		S ERS=ESC_"R"_ESC ; escaped repitition sep
	N ALPBSSN,STF S STF="STF"			      |		N SSN,STF S STF="STF"
	S ALPBSSN=$TR($G(XUSR("ALPBSSN")),"-","") S:+ALPBSSN  |		S SSN=$TR($G(XUSR("SSN")),"-","") S:+SSN SSN=$$M10^HL
	S $P(STF,FS,3)=ALPBSSN_CS_"USSSA"_CS_"SS"_RS_$$ESC($G |		S $P(STF,FS,3)=SSN_CS_"USSSA"_CS_"SS"_RS_$$ESC($G(XUS
	. K DIC,D,X,Y					      |		. Q:'$D(^DG(40.8,"AD",ALPBDIV))  ;does institution li
	. S DIC="^DG(40.8,",D="AD",X=ALPBDIV,DIC(0)="XN"      |		. S ALPBDIV1=$O(^DG(40.8,"AD",ALPBDIV,0)) ;MC Div ien
	. D IX^DIC					      |		. K HLL D GET^ALPBPARM(.HLL,ALPBDIV1)
	. Q:+Y'>0					      <
	. S ALPBDIV1=+Y					      <
	. K DIC,D,X,Y					      <
	. D GET^ALPBPARM(.HLL,ALPBDIV1)			      <
diff -y --suppress-common-lines ./VADemo/r1/ALPBHL1.m ./VADemo/r2/r/ALPBHL1.m
ALPBHL1	;OIFO-DALLAS MW,SED,KC - BCBU main HL7 message proces |	ALPBHL1	;emc,ets/mw,sd,kc-main HL7 message processor ;01/01/0
	;;3.0;BAR CODE MED ADMIN;**7**;May 2002		      |		;;2.0;BAR CODE MED ADMIN;**17**;May 2002
	; using patient's DFN, get BCBU record number...      |		; using patient's SSN, get patient's record number...
	S ALPBIEN=0					      |		S DIC="^ALPB(53.7,"
	I $D(^ALPB(53.7,ALPBPDFN)) S ALPBIEN=ALPBPDFN	      |		S DIC(0)="MZ"
							      >		S X=ALPBPSSN
							      >		D ^DIC K DIC
							      >		S ALPBIEN=+Y
							      >		.S DIC("DR")="1///^S X=ALPBPSSN;2///^S X=ALPBPDOB;3//
	; file/update patient demographic data...	      <
	S ALPBFILE(53.7,ALPBIEN_",",.01)=ALPBPNAM	      <
	S ALPBFILE(53.7,ALPBIEN_",",1)=ALPBPSSN		      <
	S ALPBFILE(53.7,ALPBIEN_",",2)=ALPBPDOB		      <
	S ALPBFILE(53.7,ALPBIEN_",",3)=ALPBPSEX		      <
	D FILE^DIE("","ALPBFILE","ALPBFERR")		      <
	I +$G(ALPBFERR("DIERR")) D ERRLOG^ALPBUTL1(+$G(ALPBIE <
	K ALPBFERR,ALPBFILE				      <
	;						      <
	; file, delete its drug(s), additive(s) and/or soluti |		; file, delete it so that it can be rebuilt...
	; they will be rebuilt by the other segments in this  |		I '+$G(ALPBMLOG)&(ALPBOIEN>0) D
	I +$G(ALPBMLOG)=0&(ALPBOIEN>0) D CLORD^ALPBUTL2(ALPBI |		.D DELORD^ALPBUTL(ALPBIEN,ALPBOIEN)
							      >		.S ALPBOIEN=0
	..;chech for any continuation lines		      <
	..S J=0 F  S J=$O(ALPBMTXT(I,J)) Q:'J  S ALPBDATA=ALP <
diff -y --suppress-common-lines ./VADemo/r1/ALPBHL1U.m ./VADemo/r2/r/ALPBHL1U.m
ALPBHL1U	;OIFO-DALLAS MW,SED,KC -HL7 MESSAGE SEGMENT P |	ALPBHL1U	;emc,ets/mw,sd,kc-HL7 message segment parser 
	;;3.0;BAR CODE MED ADMIN;**7**;May 2002		      |		;;2.0;BAR CODE MED ADMIN;**17**;May 2002
	..S ALPBTEXT(1)="CAUTION!  THIS IS A PENDING ORDER :: |		..S ALPBTEXT(1)="CAUTION!  THIS IS A PENDING ORDER ::
	S ALPBSCHD=$P(ALPBX,CS,2)			      |		S ALPBSCHD=$P($P(ALPBX,CS,2),SCS)
	S ALPBFILE(53.702,ALPBFIEN,7.3)=$P($P(DATA,FS,22),CS, |		S ALPBFILE(53.702,ALPBFIEN,7.3)=$P($P(ALPBX,CS,2),SCS
diff -y --suppress-common-lines ./VADemo/r1/ALPBIND.m ./VADemo/r2/r/ALPBIND.m
ALPBIND	;OIFO-DALLAS/SED/KC/MW  BCMA-BCBU INPT TO HL7 INIT ;5 |	ALPBIND	;OIFO-DALLAS/SED/KC/MW  BCMA-BACKUP INPT TO HL7 INIT 
							      >		Q
	K PID,PV1,^TMP("PSJ",$J),^TMP("PSJBU",$J)	      |		K PID,PV1,^TMP("PSJ",$J),^TMP("PSJBU")
	S X=$S(X>0:"T-"_X,1:"T-30")			      |		S X=$S(X>0:"T-"_X,1:"T-90")
	S MSCTR=$E(ALPB(MSH),4,8),ALPORD=ALPORDR	      |		S MSCTR=$E(ALPB(MSH),4,8)
	S X=$S(X>0:"T-"_X,1:"T-15")			      |		S X=$S(X>0:"T-"_X,1:"T-30")
diff -y --suppress-common-lines ./VADemo/r1/ALPBIN.m ./VADemo/r2/r/ALPBIN.m
ALPBIN	;OIFO-DALLAS/SED/KC/MW  BCMA-BCBU INPT TO HL7 INIT ;5 |	ALPBIN	;OIFO-DALLAS/SED/KC/MW  BCMA-BACKUP INPT TO HL7 INIT 
	;I  $D(DIRUT)!$D(ALPHLL) W !!,"No Selected Workstatio |		;I  $D(DIRUT)!$D(ALPHLL) W !!,"No Selected Workstaion
	I '$D(ALPBANS)!$D(ALPHLL) W !!,"No Selected Workstati |		I '$D(ALPBANS)!$D(ALPHLL) W !!,"No Selected Workstaio
diff -y --suppress-common-lines ./VADemo/r1/ALPBINP.m ./VADemo/r2/r/ALPBINP.m
ALPBINP	;OIFO-DALLAS/SED/KC/MW  BCMA - BCBU INPT TO HL7 ;5/2/ |	ALPBINP	;OIFO-DALLAS/SED/KC/MW  BCMA-BACKUP INPT TO HL7 ;5/2/
	;Also the patient must have an inpatient status	      |		;Also the patient must have a inpatient status
	I $P(@ALPMSG@(PV1),MSFS,3)'="I" Q "1^^Not an Inpatien |		I $P(@ALPMSG@(PV1),MSFS,3)'="I" Q "1^^Not a Inpatient
SEED	;Entry point for ^ALPBIND			      |	SEED	;Entry point for ^ALPBINT
	. I $E(HLA("HLS",SUB),1,3)="RXE" S RXE=SUB	      <
	. I $E(HLA("HLS",SUB),1,3)="PID" S PID=SUB	      <
	. I $E(HLA("HLS",SUB),1,3)="PV1" S PV1=SUB	      <
	I '$D(HLA("HLS",PID)) Q "0^MSG^Missing PID Segment Ba |		S HLA("HLS",PID)=$$EN^VAFHLPID($P(HLA("HLS",PID),HLFS
	I +ALPDFN'>0 Q "0^MSG^Invalid or Missing Patient - PI <
	S HLA("HLS",PID)=$$EN^VAFHLPID(ALPDFN,"2,7,8,19")     <
	;Fix RXE segement for Administration Type	      <
	D RXE						      <
	. S ALPADR=""					      <
	. I $P($P(GMRAL(ALPI),U,8),";",2)="P" S ALPADR="**ADR <
	. S ALPDATA=ALPDATA_HLFS_ALPI_HLCS_ALPADR_$E($P(GMRAL |		. S ALPDATA=ALPDATA_HLFS_ALPI_HLCS_$E($P(GMRAL(ALPI),
RXE	;						      <
	Q:+$G(RXE)'>0					      <
	K ^TMP("PSJ1",$J)				      <
	Q:'$D(HLA("HLS",RXE))				      <
	S DATA=HLA("HLS",RXE)				      <
	D EN^PSJBCMA1(ALPDFN,ALPORD,1)			      <
	S TYP=$P($G(^TMP("PSJ1",$J,4)),U,2)		      <
	Q:TYP="CONTINUOUS"				      <
	Q:TYP="FILL ON REQUEST"				      <
	S ALP1=$P(DATA,HLFS,2),ALP2=$P(ALP1,HLCS,2)	      <
	I ALP1[TYP Q					      <
	I ALP2[TYP Q					      <
	S $P(ALP2,"&",1)=$P(ALP2,"&",1)_" "_TYP		      <
	S $P(ALP1,HLCS,2)=ALP2,$P(DATA,HLFS,2)=ALP1	      <
	S HLA("HLS",RXE)=DATA				      <
	K TYP,ALP1,ALP2,^TMP("PSJ1",$J)			      <
	Q						      <
	S ALPDT=$P($G(^PSB(53.79,ALPML,0)),U,6)		      |		S ALPDT=$P($G(^PSB(53.79,ALPML,0)),U,4)
	;						      <
ADMQ	;Need to que a single patient init for admissions     <
	S ALDFN=ALPDFN					      <
	S ZTDTH=$$NOW^XLFDT				      <
	S ZTRTN="PAT^ALPBIND"				      <
	S ZTDESC="PSB - Initialize Single Patient on Admissio <
	S ZTIO="",ZTSAVE("ALDFN")=""			      <
	D ^%ZTLOAD					      <
	K ZTIO,ZTDESC,ZTRTN,ZTSK			      <
	Q						      <
	I $G(ALPTT)="ADMISSION" D ADMQ			      <
diff -y --suppress-common-lines ./VADemo/r1/ALPBPALL.m ./VADemo/r2/r/ALPBPALL.m
ALPBPALL	;OIFO-DALLAS MW,SED,KC-PRINT 3-DAY MAR BCMA B |	ALPBPALL	;emc/MW,SD,KC-print 3-day MAR BCMA backup rep
diff -y --suppress-common-lines ./VADemo/r1/ALPBPARM.m ./VADemo/r2/r/ALPBPARM.m
ALPBPARM	;SFVAMC/JC - Parameter Definitions ;05/02/200 |	ALPBPARM	;SFVAMC/JC - Parameter Definitions ;03/07/200
	. Q:$P(LST(X),U,2)']""				      <
	. N LNK870 S LNK870=$P(LST(X),U,2) Q:$E(LNK870,1,2)=" <
diff -y --suppress-common-lines ./VADemo/r1/ALPBPPAT.m ./VADemo/r2/r/ALPBPPAT.m
ALPBPPAT	;OIFO-DALLAS MW,SED,KC-PRINT 3-DAY MAR BCBU B |	ALPBPPAT	;emc/mw,sd,kc-print 3-day MAR BCMA backup rep
diff -y --suppress-common-lines ./VADemo/r1/ALPBPWRD.m ./VADemo/r2/r/ALPBPWRD.m
ALPBPWRD	;OIFO-DALLAS MW,SED,KC-PRINT 3-DAY MAR BCMA B |	ALPBPWRD	;emc/MW,SD,KC-print 3-day MAR BCMA backup rep
	..S ZTRTN="DQ^ALPBPWRD"				      |		..S ZTRTN="DQ^ALPBHL2"
Only in ./VADemo/r2/r/: ALPBSID.m
diff -y --suppress-common-lines ./VADemo/r1/ALPBSP1.m ./VADemo/r2/r/ALPBSP1.m
ALPBSP1	;OIFO-DALLAS MW,SED,KC-LIST AND SELECT PATIENT'S ORDE |	ALPBSP1	;emc,ets/mw,sd,kc-list and select patient's orders ;0
	.I $G(ALPBORDS(ALPBX,2))="" S ALPBORDS(ALPBX,2)="XX"  |		.S ALPBORDS("B",$G(ALPBORDS(ALPBX,2),"XX"),ALPBORDS(A
	.S ALPBORDS("B",ALPBORDS(ALPBX,2),ALPBORDS(ALPBX),ALP <
	...I $G(ALPBORDS(ALPBX,4))'="" D		      <
	....S ALPBY=$P(ALPBORDS(ALPBX,4),"^",1,3)	      <
	....S ALPBY=$TR(ALPBY,"^"," ")			      <
	....S ALPBDATA=ALPBDATA_" ("_ALPBY_")"		      <
	....K ALPBY					      <
diff -y --suppress-common-lines ./VADemo/r1/ALPBSP2.m ./VADemo/r2/r/ALPBSP2.m
ALPBSP2	;OIFO-DALLAS MW,SED,KC-SHOW SELECTED PATIENT ORDERS(S |	ALPBSP2	;emc,ets/mw,sd,kc-show selected patient order(s) ;01/
diff -y --suppress-common-lines ./VADemo/r1/ALPBSPAT.m ./VADemo/r2/r/ALPBSPAT.m
ALPBSPAT	;OIFO-DALLAS MW,SED,KC-SELECT AND SHOW PATIEN |	ALPBSPAT	;emc,ets/mw,sd,kc-select and show patient ord
diff -y --suppress-common-lines ./VADemo/r1/ALPBSWRD.m ./VADemo/r2/r/ALPBSWRD.m
ALPBSWRD	;OIFO-DALLAS MW,SED,KC - display BCBU records |	ALPBSWRD	;emc/MW,SD,KC-display BCMA records for patien
Only in ./VADemo/r2/r/: ALPBT1.m
Only in ./VADemo/r2/r/: ALPBTST.m
diff -y --suppress-common-lines ./VADemo/r1/ALPBUTL1.m ./VADemo/r2/r/ALPBUTL1.m
ALPBUTL1	;OIFO-DALLAS MW,SED,KC-BCBU BACKUP REPORT FUN |	ALPBUTL1	;emc,ets/maw,sd,kc-BCMA backup report functio
	I $G(ST)="" Q ""				      |		I ST="" Q ""
diff -y --suppress-common-lines ./VADemo/r1/ALPBUTL2.m ./VADemo/r2/r/ALPBUTL2.m
ALPBUTL2	;OIFO-DALLAS MW,SED,KC-BCBU BACKUP REPORT FUN |	ALPBUTL2	;emc,ets/maw,sd,kc-BCBU functions and utiliti
	;;2.0;BAR CODE MED ADMIN;**17**;May 2002	      |		       ;;2.0;BAR CODE MED ADMIN;**17**;May 2002
	;						      <
CLORD(IEN,OIEN)	; delete drug(s), additive(s) and/or solution <
	; for a specified order...			      <
	; IEN  = patient's record number in file 53.7	      <
	; OIEN = order's sub-record number in file 53.7	      <
	; returns nothing				      <
	I +$G(IEN)=0!(+$G(OIEN)=0) Q			      <
	N DA,DIK,SUB,X,XIEN,Y				      <
	F SUB=7,8,9 D					      <
	.S XIEN=0					      <
	.F  S XIEN=$O(^ALPB(53.7,IEN,2,OIEN,SUB,XIEN)) Q:'XIE <
	..S DA=XIEN					      <
	..S DA(1)=OIEN					      <
	..S DA(2)=IEN					      <
	..S DIK="^ALPB(53.7,"_DA(2)_",2,"_DA(1)_","_SUB_","   <
	..D ^DIK					      <
	..K DA,DIK					      <
	.K XIEN						      <
	Q						      <
Only in ./VADemo/r1/: ALPBUTL3.m
diff -y --suppress-common-lines ./VADemo/r1/ALPBUTL.m ./VADemo/r2/r/ALPBUTL.m
ALPBUTL	;OIFO-DALLAS MW,SED,KC-BCMA BCBU REPORT FUNCTIONS AND |	ALPBUTL	;emc,ets/maw,sd,kc-BCMA backup report functions and u
	S RESULT=STRING F I=$L(RESULT):1:SPACES S RESULT=RESU |		S RESULT=STRING
							      >		F I=$L(RESULT):1:SPACES S RESULT=RESULT_" "
	S (RESULT,TODAY)=+$E(START,6,7)			      |		S TODAY=+$E(START,6,7)
							      >		S RESULT=TODAY
	S DIM=$$DIM(START),TODAY=+$E(START,6,7),MON1=+$E(STAR |		S DIM=$$DIM(START)
	S (RESULT,MON)=$$MONN(MON1)			      |		S TODAY=+$E(START,6,7)
							      >		S MON1=+$E(START,4,5)
							      >		S MON=$$MONN(MON1)
							      >		S RESULT=MON
	.S MON=$$MONN(MON1),RESULT=RESULT_MON		      |		.S MON=$$MONN(MON1)
	.S DIM=$$DIM($E(START,1,3)_$S(MON1<10:"0"_MON1,1:MON1 |		.S RESULT=RESULT_MON
							      >		.S DIM=$$DIM($E(START,1,3)_$S(MON1<10:"0"_MON1,1:MON1
							      >		.S TODAY=0
	S RESULT=$E(RESULT,1,I),RESULT=$TR(RESULT,XSPACE,XSTR |		S RESULT=$E(RESULT,1,I)
							      >		S RESULT=$TR(RESULT,XSPACE,XSTRIP)
	S RESULTS(0)=" "_$E(START,4,5)_"/"_$E(START,6,7)_" ", |		S RESULTS(0)=" "_$E(START,4,5)_"/"_$E(START,6,7)_" "
							      >		S RESULTS(1)=START
	.S X1=START,X2=I				      |		.S X1=START
							      >		.S X2=I
	.S RESULTS(I+1)=X,RESULTS(0)=RESULTS(0)_" "_$E(X,4,5) |		.S RESULTS(I+1)=X
							      >		.S RESULTS(0)=RESULTS(0)_" "_$E(X,4,5)_"/"_$E(X,6,7)_
	..S RESULTS(0)=RESULTS(0)+1,RESULTS(RESULTS(0))=ALPBW |		..S RESULTS(0)=RESULTS(0)+1
							      >		..S RESULTS(RESULTS(0))=ALPBWARD
	..S RESULTS(0)=RESULTS(0)+1,RESULTS(RESULTS(0))=ALPBW |		..S RESULTS(0)=RESULTS(0)+1
							      >		..S RESULTS(RESULTS(0))=ALPBWARD
	...S RESULTS(0)=RESULTS(0)+1,RESULTS(RESULTS(0))=ALPB |		...S RESULTS(0)=RESULTS(0)+1
							      >		...S RESULTS(RESULTS(0))=ALPBWARD
	...S RESULTS(0)=RESULTS(0)+1,RESULTS(RESULTS(0))=ALPB |		...S RESULTS(0)=RESULTS(0)+1
							      >		...S RESULTS(RESULTS(0))=ALPBWARD
	.S ORDERDAT(4)=$G(^ALPB(53.7,IEN,2,ORDERIEN,4))	      <
	.;S RESULTS(ORDERIEN,4)=$P($G(ORDERDAT(4)),"^",3)     <
	.S RESULTS(ORDERIEN,4)=$G(ORDERDAT(4))		      <
	S DA=IEN,DIK="^ALPB(53.7,"			      |		S DA=IEN
							      >		S DIK="^ALPB(53.7,"
	S DA=OIEN,DA(1)=IEN,DIK="^ALPB(53.7,"_DA(1)_",2,"     |		S DA=OIEN
							      >		S DA(1)=IEN
							      >		S DIK="^ALPB(53.7,"_DA(1)_",2,"
Only in ./VADemo/r1/: ANRVOA.m
Only in ./VADemo/r1/: ANRVOB.m
diff -y --suppress-common-lines ./VADemo/r1/AUPNSICD.m ./VADemo/r2/r/AUPNSICD.m
AUPNSICD	;OHPRD/LAB - Screen Purpose of Visit/ICD9 cod |	AUPNSICD	;OHPRD/LAB - Screen Purpose of Visit/ICD9 cod
	;;1.0;PCE PATIENT CARE ENCOUNTER;**121,149**;Aug 12,  |		;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
	N ICDSTR,ICDVDT					      <
	;S ICDSTR=$$ICDDX^ICDCODE(Y,$P(^AUPNVSIT(PXCEVIEN,0), <
	S ICDSTR=$$ICDDX^ICDCODE(Y,+^AUPNVSIT(PXCEVIEN,0)),IC <
	;I $P(^ICD9(Y,0),U,1)'="E",$P(^(0),U,9)=""	      |		I $P(^ICD9(Y,0),U,1)'="E",$P(^(0),U,9)=""
	I $P(ICDSTR,U,2)'="E",$P(ICDSTR,U,10)=1		      <
	;I $P(^ICD9(Y,0),U,9)'=1			      |		I $P(^ICD9(Y,0),U,9)'=1
	I $P(ICDSTR,U,10)=1				      <
Only in ./VADemo/r1/: AWCMCPR1.m
Only in ./VADemo/r1/: AWCMCPR2.m
Only in ./VADemo/r1/: AWCMCPR3.m
Only in ./VADemo/r1/: AWCMCPR4.m
Only in ./VADemo/r1/: AWCMCPS2.m
Only in ./VADemo/r1/: AWCMCPST.m
Only in ./VADemo/r1/: AWCMCPUR.m
Only in ./VADemo/r1/: AWCMFTP1.m
Only in ./VADemo/r1/: AWCMFTP.m
Only in ./VADemo/r1/: BPSECA1.m
Only in ./VADemo/r1/: BPSECA2.m
Only in ./VADemo/r1/: BPSECA4.m
Only in ./VADemo/r1/: BPSECA5.m
Only in ./VADemo/r1/: BPSECA7.m
Only in ./VADemo/r1/: BPSECA8.m
Only in ./VADemo/r1/: BPSECA9.m
Only in ./VADemo/r1/: BPSECFM.m
Only in ./VADemo/r1/: BPSECP0.m
Only in ./VADemo/r1/: BPSECP1.m
Only in ./VADemo/r1/: BPSECP2.m
Only in ./VADemo/r1/: BPSECP3.m
Only in ./VADemo/r1/: BPSECR0.m
Only in ./VADemo/r1/: BPSECR1.m
Only in ./VADemo/r1/: BPSECR2.m
Only in ./VADemo/r1/: BPSECX0.m
Only in ./VADemo/r1/: BPSECX1.m
Only in ./VADemo/r1/: BPSECX4.m
Only in ./VADemo/r1/: BPSECZ3.m
Only in ./VADemo/r1/: BPSECZA.m
Only in ./VADemo/r1/: BPSER1A.m
Only in ./VADemo/r1/: BPSER2A.m
Only in ./VADemo/r1/: BPSER3A.m
Only in ./VADemo/r1/: BPSER4A.m
Only in ./VADemo/r1/: BPSES00.m
Only in ./VADemo/r1/: BPSJACK.m
Only in ./VADemo/r1/: BPSJAREG.m
Only in ./VADemo/r1/: BPSJHLI.m
Only in ./VADemo/r1/: BPSJHLT.m
Only in ./VADemo/r1/: BPSJINI1.m
Only in ./VADemo/r1/: BPSJINIT.m
Only in ./VADemo/r1/: BPSJPHNM.m
Only in ./VADemo/r1/: BPSJPREG.m
Only in ./VADemo/r1/: BPSJUTL1.m
Only in ./VADemo/r1/: BPSJUTL.m
Only in ./VADemo/r1/: BPSJVAL1.m
Only in ./VADemo/r1/: BPSJVAL2.m
Only in ./VADemo/r1/: BPSJVAL.m
Only in ./VADemo/r1/: BPSJXI1.m
Only in ./VADemo/r1/: BPSJZPR.m
Only in ./VADemo/r1/: BPSJZQR.m
Only in ./VADemo/r1/: BPSJZRP.m
Only in ./VADemo/r1/: BPSMHDR.m
Only in ./VADemo/r1/: BPSOS02.m
Only in ./VADemo/r1/: BPSOS03.m
Only in ./VADemo/r1/: BPSOS2A.m
Only in ./VADemo/r1/: BPSOS2B.m
Only in ./VADemo/r1/: BPSOS2C.m
Only in ./VADemo/r1/: BPSOS2D.m
Only in ./VADemo/r1/: BPSOS2E.m
Only in ./VADemo/r1/: BPSOS2F.m
Only in ./VADemo/r1/: BPSOS2.m
Only in ./VADemo/r1/: BPSOS6A.m
Only in ./VADemo/r1/: BPSOS6E.m
Only in ./VADemo/r1/: BPSOS6F.m
Only in ./VADemo/r1/: BPSOS6G.m
Only in ./VADemo/r1/: BPSOS6H.m
Only in ./VADemo/r1/: BPSOS6I.m
Only in ./VADemo/r1/: BPSOS6K.m
Only in ./VADemo/r1/: BPSOS6L.m
Only in ./VADemo/r1/: BPSOS6N.m
Only in ./VADemo/r1/: BPSOS96.m
Only in ./VADemo/r1/: BPSOS97.m
Only in ./VADemo/r1/: BPSOSAA.m
Only in ./VADemo/r1/: BPSOSAB.m
Only in ./VADemo/r1/: BPSOSAD.m
Only in ./VADemo/r1/: BPSOSA.m
Only in ./VADemo/r1/: BPSOSAM.m
Only in ./VADemo/r1/: BPSOSAN.m
Only in ./VADemo/r1/: BPSOSAO.m
Only in ./VADemo/r1/: BPSOSAP.m
Only in ./VADemo/r1/: BPSOSAQ.m
Only in ./VADemo/r1/: BPSOSAR.m
Only in ./VADemo/r1/: BPSOSAS.m
Only in ./VADemo/r1/: BPSOSAW.m
Only in ./VADemo/r1/: BPSOSAY.m
Only in ./VADemo/r1/: BPSOSAZ.m
Only in ./VADemo/r1/: BPSOSB0.m
Only in ./VADemo/r1/: BPSOSB1.m
Only in ./VADemo/r1/: BPSOSB2.m
Only in ./VADemo/r1/: BPSOSB4.m
Only in ./VADemo/r1/: BPSOSB5.m
Only in ./VADemo/r1/: BPSOSBA.m
Only in ./VADemo/r1/: BPSOSBC.m
Only in ./VADemo/r1/: BPSOSBD.m
Only in ./VADemo/r1/: BPSOSBE.m
Only in ./VADemo/r1/: BPSOSBI.m
Only in ./VADemo/r1/: BPSOSBL.m
Only in ./VADemo/r1/: BPSOSB.m
Only in ./VADemo/r1/: BPSOSBP.m
Only in ./VADemo/r1/: BPSOSBQ.m
Only in ./VADemo/r1/: BPSOSBT.m
Only in ./VADemo/r1/: BPSOSBU.m
Only in ./VADemo/r1/: BPSOSBW.m
Only in ./VADemo/r1/: BPSOSC1.m
Only in ./VADemo/r1/: BPSOSC2.m
Only in ./VADemo/r1/: BPSOSC3.m
Only in ./VADemo/r1/: BPSOSCA.m
Only in ./VADemo/r1/: BPSOSCF.m
Only in ./VADemo/r1/: BPSOSD1.m
Only in ./VADemo/r1/: BPSOSEC.m
Only in ./VADemo/r1/: BPSOSFD.m
Only in ./VADemo/r1/: BPSOSH2.m
Only in ./VADemo/r1/: BPSOSH4.m
Only in ./VADemo/r1/: BPSOSH5.m
Only in ./VADemo/r1/: BPSOSH6.m
Only in ./VADemo/r1/: BPSOSH7.m
Only in ./VADemo/r1/: BPSOSHF.m
Only in ./VADemo/r1/: BPSOSHR.m
Only in ./VADemo/r1/: BPSOSHU.m
Only in ./VADemo/r1/: BPSOSI7.m
Only in ./VADemo/r1/: BPSOSI8.m
Only in ./VADemo/r1/: BPSOSIB.m
Only in ./VADemo/r1/: BPSOSI.m
Only in ./VADemo/r1/: BPSOSIO.m
Only in ./VADemo/r1/: BPSOSIP.m
Only in ./VADemo/r1/: BPSOSIW.m
Only in ./VADemo/r1/: BPSOSIY.m
Only in ./VADemo/r1/: BPSOSIZ.m
Only in ./VADemo/r1/: BPSOSJ1.m
Only in ./VADemo/r1/: BPSOSK2.m
Only in ./VADemo/r1/: BPSOSK.m
Only in ./VADemo/r1/: BPSOSL1.m
Only in ./VADemo/r1/: BPSOSL.m
Only in ./VADemo/r1/: BPSOSM1.m
Only in ./VADemo/r1/: BPSOSMA.m
Only in ./VADemo/r1/: BPSOSMB.m
Only in ./VADemo/r1/: BPSOSMC.m
Only in ./VADemo/r1/: BPSOSM.m
Only in ./VADemo/r1/: BPSOSMZ.m
Only in ./VADemo/r1/: BPSOSN0.m
Only in ./VADemo/r1/: BPSOSN4.m
Only in ./VADemo/r1/: BPSOSN7.m
Only in ./VADemo/r1/: BPSOSO1.m
Only in ./VADemo/r1/: BPSOSO2.m
Only in ./VADemo/r1/: BPSOSO3.m
Only in ./VADemo/r1/: BPSOSO4.m
Only in ./VADemo/r1/: BPSOSO5.m
Only in ./VADemo/r1/: BPSOSQ1.m
Only in ./VADemo/r1/: BPSOSQ2.m
Only in ./VADemo/r1/: BPSOSQ3.m
Only in ./VADemo/r1/: BPSOSQ4.m
Only in ./VADemo/r1/: BPSOSQF.m
Only in ./VADemo/r1/: BPSOSQG.m
Only in ./VADemo/r1/: BPSOSQH.m
Only in ./VADemo/r1/: BPSOSQJ.m
Only in ./VADemo/r1/: BPSOSQL.m
Only in ./VADemo/r1/: BPSOSQS.m
Only in ./VADemo/r1/: BPSOSR1.m
Only in ./VADemo/r1/: BPSOSR2.m
Only in ./VADemo/r1/: BPSOSR4.m
Only in ./VADemo/r1/: BPSOSRB.m
Only in ./VADemo/r1/: BPSOSS2.m
Only in ./VADemo/r1/: BPSOSS3.m
Only in ./VADemo/r1/: BPSOSS6.m
Only in ./VADemo/r1/: BPSOSS7.m
Only in ./VADemo/r1/: BPSOSS8.m
Only in ./VADemo/r1/: BPSOSS9.m
Only in ./VADemo/r1/: BPSOSSG.m
Only in ./VADemo/r1/: BPSOSU1.m
Only in ./VADemo/r1/: BPSOSU2.m
Only in ./VADemo/r1/: BPSOSU3.m
Only in ./VADemo/r1/: BPSOSU4.m
Only in ./VADemo/r1/: BPSOSU5.m
Only in ./VADemo/r1/: BPSOSU7.m
Only in ./VADemo/r1/: BPSOSU8.m
Only in ./VADemo/r1/: BPSOSU9.m
Only in ./VADemo/r1/: BPSOSUA.m
Only in ./VADemo/r1/: BPSOSUB.m
Only in ./VADemo/r1/: BPSOSUC.m
Only in ./VADemo/r1/: BPSOSUD.m
Only in ./VADemo/r1/: BPSOSUE.m
Only in ./VADemo/r1/: BPSOSXA.m
Only in ./VADemo/r1/: BPSOSXE.m
Only in ./VADemo/r1/: BPSOSX.m
Only in ./VADemo/r1/: BPSRDT.m
Only in ./VADemo/r1/: BPSUTIL.m
Only in ./VADemo/r2/r/: CJS2.m
diff -y --suppress-common-lines ./VADemo/r1/DDWT1.m ./VADemo/r2/r/DDWT1.m
	;;22.0;VA FileMan;**18**;Mar 30, 1999		      |		;;22.0;VA FileMan;**18,GTM**;Mar 30, 1999
							      >		;;GT.M PORT;2.00;*under development*;4.3-001A;Unix,VM
							      >		;
							      >		; worked around the GT.M bug with SET $EXTRACT. two l
							      >		; STATUS changed 999 to +999 (HOU/DJW,PUG/TOAD).
							      >		;
	S $E(DDWS,IOM\2+1-($L(DDWX)\2),999)=DDWX	      |		S $E(DDWS,IOM\2+1-($L(DDWX)\2),+999)=DDWX
	S $E(DDWS,IOM-$L(DDWX),999)=DDWX		      |		S $E(DDWS,IOM-$L(DDWX),+999)=DDWX
Only in ./VADemo/r2/r/: DENTVCNV.m
Only in ./VADemo/r2/r/: DENTVDD.m
Only in ./VADemo/r2/r/: DENTVI01.m
Only in ./VADemo/r2/r/: DENTVI02.m
Only in ./VADemo/r2/r/: DENTVI03.m
Only in ./VADemo/r2/r/: DENTVI04.m
Only in ./VADemo/r2/r/: DENTVI05.m
Only in ./VADemo/r2/r/: DENTVIP1.m
Only in ./VADemo/r2/r/: DENTVIP.m
Only in ./VADemo/r2/r/: DENTVRP1.m
Only in ./VADemo/r2/r/: DENTVRP2.m
Only in ./VADemo/r2/r/: DENTVRP3.m
Only in ./VADemo/r2/r/: DENTVRP4.m
Only in ./VADemo/r2/r/: DENTVRP5.m
Only in ./VADemo/r2/r/: DENTVRP6.m
Only in ./VADemo/r2/r/: DENTVRP7.m
Only in ./VADemo/r2/r/: DENTVRP8.m
Only in ./VADemo/r2/r/: DENTVRP9.m
Only in ./VADemo/r2/r/: DENTVUTL.m
diff -y --suppress-common-lines ./VADemo/r1/DG1010P1.m ./VADemo/r2/r/DG1010P1.m
	;;5.3;Registration;**489**;Aug 13, 1993		      |		;;5.3;Registration;;Aug 13, 1993
	W !,DGLUND					      |		W ?131,$C(13),DGLUND
CA	;Display confidential address information	      <
	N DGACT,DGCAT,DGCATN,DGCATS,VAPA		      <
	D ADD^VADPT					      <
	W !,"11. CONFIDENTIAL ADDRESS",?66,"|"		      <
	I VAPA(12)=""!(VAPA(12)=0) D  G SEX		      <
	.W !?11,"Not Applicable",?66,"|"		      <
	.W !,DGLUND					      <
	W !,DGL2					      <
	W !,"11A.  STREET ADDRESS:",?21,VAPA(13)	      <
	W ?66,"| ","11B.  CITY:  ",$E(VAPA(16),0,19),?99,"| 1 <
	W !,?21,VAPA(14)				      <
	W ?66,"| ","11D.  ZIP CODE:  ",$P(VAPA(18),"^",2),?99 <
	W !,?21,VAPA(15),?66,"| 11F. START DATE: ",$P(VAPA(20 <
	W !,$E(DGL2,1,99),"|",$E(DGL2,1,32)		      <
	W !,"11G. Active Confidential Address Categories",?66 <
	S DGCATS="" F  S DGCATS=$O(VAPA(22,DGCATS)) Q:DGCATS= <
	.S DGCAT=VAPA(22,DGCATS),DGACT=$P(DGCAT,"^",3),DGCATN <
	.I DGACT="Y" W !?11,DGCATN,?66,"|"		      <
	W !,DGLUND					      <
	W !,"12.  PATIENT'S SEX",?33,"| ","13.  MOTHER'S MAID |		W !,"11.  PATIENT'S SEX",?33,"| ","12.  MOTHER'S MAID
	W !,"16.  RELIGIOUS PREFERENCE",?33,"| ","17.  DATE O |		W !,"15.  RELIGIOUS PREFERENCE",?33,"| ","16.  DATE O
diff -y --suppress-common-lines ./VADemo/r1/DG1010P5.m ./VADemo/r2/r/DG1010P5.m
	;;5.3;Registration;**570**;Aug 13, 1993		      |		;;5.3;Registration;;Aug 13, 1993
	N DGIB,DGIBA,DGYN,DGIB8,DGIB4,DGINS,DGX ; changes for |		W !?4,"COVERAGE: ",$$YN2(DGP(.31),11),?44,"| ",?50
	S DGYN=$$INSUR^IBBAPI(DFN,,"R",.DGINS,"1,10,11,12")   |		I X'="Y" W "NOT APPLICABLE" G GI
	W !?4,"COVERAGE: ",$S(DGYN:"YES",1:"NO"),?44,"| ",?50 <
	I 'DGYN W "NOT APPLICABLE" G GI			      <
	S (DGVT,DGSP,DGOT)="",DGX=0			      |		S (DGVT,DGSP,DGOT)=""
	F  S DGX=$O(DGINS("IBBAPI","INSUR",DGX)) Q:'DGX  D    |		F DGINS=0:0 S DGINS=$O(^DPT(DFN,.312,DGINS)) Q:DGINS'
	. S DGIB8=$G(DGINS("IBBAPI","INSUR",DGX,10)),DGIB4=$G |		.S DGI=^DPT(DFN,.312,DGINS,0)
	. I $S((DGIB8>(9999999-DFN1)):1,(DGIB4']""):0,((99999 |		.I $S(($P(DGI,U,8)>(9999999-DFN1)):1,($P(DGI,U,4)']""
	. I $P(DGINS("IBBAPI","INSUR",DGX,12),U,1)="P" S DGVT |		.I $P(DGI,U,6)="v" S DGVT="PATIENT'S INSURANCE"
	. I $P(DGINS("IBBAPI","INSUR",DGX,12),U,1)="S" S DGSP |		.I $P(DGI,U,6)="s" S DGSP="SPOUSE'S INSURANCE"
	. I $P(DGINS("IBBAPI","INSUR",DGX,12),U,1)="O" S DGOT |		.I $P(DGI,U,6)="o" S DGOT="OTHER"
diff -y --suppress-common-lines ./VADemo/r1/DG1010PA.m ./VADemo/r2/r/DG1010PA.m
	;;5.3;Registration;**18,28,86,108,113,570**;Aug 13, 1 |		;;5.3;Registration;**18,28,86,108,113**;Aug 13, 1993
	. I '($$INSUR^IBBAPI(DFN)) S DGFAIL=1		      |		.I '($O(^DPT(DFN,.312,0))) S DGFAIL=1
diff -y --suppress-common-lines ./VADemo/r1/DG1010S1.m ./VADemo/r2/r/DG1010S1.m
DG1010S1	;ALB/MRL/EG - SUPPLEMENTAL DATA SHEET FOR 10- |	DG1010S1	;ALB/MRL - SUPPLEMENTAL DATA SHEET FOR 10-10 
	;;5.3;Registration;**606,568,585**;Aug 13, 1993	      |		;;5.3;Registration;;Aug 13, 1993
	N DGARRAY,I,SDOUT,CLIEN,APTDT			      <
	S DGARRAY("FLDS")="1;2",DGARRAY(4)=DFN,I=$$SDAPI^SDAM |		F J=0:0 S I2=$O(^DPT(DFN,"S",I2)) Q:I2=""  I $S($P(^(
	;it's not clear if it is an error or clinic or patien <
	;if an error,there will be no lower subscripts eg 01/ <
	I $D(^TMP($J,"SDAMA301",101))=1 S I1=1,DGD="** Appoin <
	I $D(^TMP($J,"SDAMA301",101))'=1 D		      <
	.S (DGD,CLIEN)="" F  S CLIEN=$O(^TMP($J,"SDAMA301",DF <
	..S APTDT=DT F  S APTDT=$O(^TMP($J,"SDAMA301",DFN,CLI <
	...S SDOUT=^TMP($J,"SDAMA301",DFN,CLIEN,APTDT),I1=1,D <
	W:(128-$X)<$L(DGD) !?9 W DGD			      <
	K DGARRAY,^TMP($J,"SDAMA301"),SDOUT,CLIEN,APTDT	      <
	S DGD=+$P(^DGPM(+DGD,0),"^",16),Y=+^(0),DGDAT=Y	      |		S DGD=+$P(^DGPM(+DGD,0),"^",16),Y=+^(0)
	S I3="" F I=5:1:15 I I'=10 S I2=$P(I1,U,I) Q:'I2  S I |		S I3="" F I=5:1:15 I I'=10 S I2=$P(I1,U,I) Q:'I2  S I
	W:'I3 "NO DIAGNOSES ON FILE FOR THIS ADMISSION PERIOD |		W:'I3 "NO DIAGNOSES ON FILE FOR THIS ADMISSION PERIOD
	W !?5,"7c. Admit Diagnosis:  ",X,!?5,DGLSUP,!?5,"7d.  |		W !?5,"7c. Admit Diagnosis:  ",X,!?5,DGLSUP,!?5,"7d. 
	K DGAD,DGD,DGEL,I,I1,I2,Y,DGDAT G ^DG1010S2	      |		K DGAD,DGD,DGEL,I,I1,I2,Y G ^DG1010S2
diff -y --suppress-common-lines ./VADemo/r1/DG10.m ./VADemo/r2/r/DG10.m
DG10	;ALB/MRL,DAK,AEG-LOAD/EDIT PATIENT DATA ; 1/12/04 4:5 |	DG10	;ALB/MRL,DAK,AEG-LOAD/EDIT PATIENT DATA ; 15 Jul 2000
	;;5.3;Registration;**32,109,139,149,182,326,513,425,5 |		;;5.3;Registration;**32,109,139,149,182,326**;Aug 13,
	I $G(DGPRFLG)=1,$G(DGPLOC)=1 D  G Q:$G(DGRPOUT),A1    |		I $G(DGPRFLG)=1,$G(DGPLOC)=1 D  G A1
	.; D EN^DGRPD,REG^IVMCQ($G(DFN))		      |		. D EN^DGRPD,REG^IVMCQ($G(DFN))
	. D EN^DGRPD					      <
	. Q:$G(DGRPOUT)					      <
	. D REG^IVMCQ($G(DFN))				      <
	N Y D PAUSE I DGNEW D NEW^DGRP S DA=DFN,VET=$S($D(^DP |		I DGNEW D NEW^DGRP S DA=DFN,VET=$S($D(^DPT(DFN,"VET")
	I +$G(DGNEW) D					      <
	. ; query CMOR for Patient Record Flag Assignments if <
	. ; display results				      <
	. I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN)      <
	;						      <
CP	;If not (autoexempt or MTested) & no CP test this yea |	CP	; If not (autoexempt or MTested) & no CP test this ye
	;prompt for add/edit cp test			      |		; prompt for add/edit cp test
diff -y --suppress-common-lines ./VADemo/r1/DG3PR0.m ./VADemo/r2/r/DG3PR0.m
	;;5.3;Registration;**26,69,570**;Aug 13, 1993	      |		;;5.3;Registration;**26,69**;Aug 13, 1993
START	K ^UTILITY($J)					      |	START	K ^UTILITY($J) S (N(1),N(0),DG(1),DG(0))="" D ALL^IBC
	N DGIBB,DGX,DGINS,DGBLD				      <
	S (N(1),N(0),DG(1),DG(0))=""			      <
	I $$INSUR^IBBAPI(DFN,,,.DGIBB,"*")		      <
	S DGX="DGIBB(""IBBAPI"",""INSUR"")" M DGINS=@DGX      <
	;						      <
	F I=0:0 S I=$O(DGINS(I)) Q:'I  D		      <
	. S L=+DGINS(I,1)				      <
	. S M=$P($G(DGINS(I,12)),U)			      <
	. S M=$S(M="P":"v",M="S":"s",M="O":"o",1:0)	      <
	. S DGBLD=L ; ID Number				      <
	. S $P(DGBLD,U,2)=DGINS(I,14) ; Subscriber ID 	      <
	. S $P(DGBLD,U,3)=DGINS(I,18) ; Group Policy No.      <
	. S $P(DGBLD,U,4)=DGINS(I,11) ; Expiration Date	      <
	. S $P(DGBLD,U,6)=M ; Subscriber Relationship (Whose  <
	. S $P(DGBLD,U,8)=DGINS(I,10) ; Effective Date	      <
	. S $P(DGBLD,U,16)=$S(M="v":"01",M="s":"02",M="o":"09 <
	. S $P(DGBLD,U,17)=DGINS(I,13) ; Subscriber Name      <
	. S $P(DGBLD,U,18)=+DGINS(I,8) ; Group Plan (Policy N <
	. S $P(DGBLD,U,20)=+DGINS(I,7) ; Coord. of Benefits   <
	. S $P(DGBLD,U,30)=I ; Save of Insurance API Index    <
	. S ^UTILITY($J,M,L)=DGBLD			      <
	;						      <
	;						      |	SET	S A=DG(I),A=$S($D(^DIC(36,+A,0)):^(0),1:""),B=$G(^DIC
SET	;						      |		S X(I)=$P(A,U,1)_U_$P($G(^DIC(36,+DG(I),.13)),U,1)_U_
	N DGX						      <
	S DGX=$P($G(DG(I)),U,30)			      <
	S A=$S(DGX>0:$P(DGINS(DGX,1),U,2),1:"") ; Insurance C <
	S X=""						      <
	S:DGX>0 X=DGINS(DGX,3)_", "_$P(DGINS(DGX,4),U,2)_" "_ <
	;						      <
	S X(I)=A_U_$S(DGX>0:DGINS(DGX,6),1:"")_U_$S(DGX>0:DGI <
	S Y=$S(DGX>0:DGINS(DGX,10),1:""),Y=$$FMTE^XLFDT(Y) ;  <
	S X(I)=X(I)_Y_U					      <
	S Y="",Y=$$FMTE^XLFDT(Y)  ; Renewal Date (Not availab <
	S X(I)=X(I)_Y					      <
	;						      <
diff -y --suppress-common-lines ./VADemo/r1/DG3PR1.m ./VADemo/r2/r/DG3PR1.m
	;;5.3;Registration;**26,570**;Aug 13, 1993	      |		;;5.3;Registration;**26**;Aug 13, 1993
	S DFN=$P(DGAD,"^",3)				      |		S DFN=$P(DGAD,"^",3) I $S('DFN:1,'$D(^DPT(DFN,0)):1,'
	I $S('DFN:1,'$D(^DPT(DFN,0)):1,'$$INSUR^IBBAPI(DFN,"" <
diff -y --suppress-common-lines ./VADemo/r1/DG3PR2.m ./VADemo/r2/r/DG3PR2.m
	;;5.3;Registration;**26,606,617,570**;Aug 13, 1993    |		;;5.3;Registration;**26**;Aug 13, 1993
	;570						      |		D ALL^IBCNS1(DFN,"DGIBINS") F I=0:0 S I=$O(DGIBINS(I)
	;D ALL^IBCNS1(DFN,"DGIBINS") F I=0:0 S I=$O(DGIBINS(I <
	N DGX,DGDATA					      <
	I $$INSUR^IBBAPI(DFN,,"R",.DGDATA,"1,8,9,11,12,14,18" <
	S DGX="DGDATA(""IBBAPI"",""INSUR"")" M DGIBINS=@DGX   <
	F I=0:0 S I=$O(DGIBINS(I)) Q:'I  D		      <
	. W !,$S('+DGIBINS(I,9):"*",1:" "),$E($P(DGIBINS(I,1) <
	. I $D(DGIBINS(I,18)) W $G(DGIBINS(I,18)) ; Group Pol <
	. S DGINS=$S($P(DGIBINS(I,9),U,2)="NO":1,1:0) D INS2  <
	;						      <
	N DGDAT,DXD					      |		S DGPR=DGAD F I=0:0 S I=$O(^UTILITY("DG",$J,"M",I)) Q
	S DGDAT=$P(^DGPT(DGPTF,0),"^",2)		      |		Q:'DGFL  S DGPMIFN=DGCA D ^DGPMLOS W !?39,"----  ----
	S DGPR=DGAD F I=0:0 S I=$O(^UTILITY("DG",$J,"M",I)) Q <
	;Q:'DGFL  S DGPMIFN=DGCA D ^DGPMLOS W !?39,"----  --- <
	Q:'DGFL  S DGPMIFN=DGCA				      <
	D ^DGPMLOS W !?39,"----  ----------",!?26,"TOTAL LOS: <
	F I=0:0 S I=$O(^UTILITY("DG",$J,"S",I)) Q:'I  S J=^(I |		F I=0:0 S I=$O(^UTILITY("DG",$J,"S",I)) Q:'I  S J=^(I
DIAG	S M=0 F K=5:1:15 I K'=10 S L=$P(J,"^",K) I L S DXD=$$ |	DIAG	S M=0 F K=5:1:15 I K'=10 S L=$P(J,"^",K) I L W:M ! W 
OP	S M=0 F K=8:1:12 S L=$P(J,"^",K) I L S DXD=$$ICDOP^IC |	OP	S M=0 F K=8:1:12 S L=$P(J,"^",K) I L W:M ! W ?45,$S($
	;570						      |		I $P(X,"^",2)="N" S DGINS=1
	N X						      |		S X=$P(J,"^",4) W:X]"" ?63,$E(X,4,5),"/",$E(X,6,7),"/
	;I $P(X,"^",2)="N" S DGINS=1			      <
	;S X=$P(J,"^",4) W:X]"" ?63,$E(X,4,5),"/",$E(X,6,7)," <
	I $P(DGIBINS(I,9),U,2)="NO" S DGINS=1		      <
	S X=DGIBINS(I,11) W:X]"" ?63,$$FMTE^XLFDT(X,"2D")     <
	S X=$P(DGIBINS(I,12),U) W ?73,$S(X="P":"VETERAN",X="S <
Only in ./VADemo/r1/: DG53358C.m
Only in ./VADemo/r1/: DG53358D.m
Only in ./VADemo/r1/: DG53463.m
Only in ./VADemo/r1/: DG53478I.m
Only in ./VADemo/r1/: DG53514.m
Only in ./VADemo/r1/: DG53522P.m
Only in ./VADemo/r1/: DG53528P.m
Only in ./VADemo/r1/: DG53558.m
Only in ./VADemo/r1/: DG53558M.m
Only in ./VADemo/r1/: DG53568A.m
Only in ./VADemo/r1/: DG53588P.m
Only in ./VADemo/r1/: DG53602S.m
Only in ./VADemo/r1/: DG53625P.m
Only in ./VADemo/r1/: DG53B563.m
Only in ./VADemo/r1/: DG53E451.m
Only in ./VADemo/r1/: DG53E574.m
Only in ./VADemo/r1/: DG53P425.m
Only in ./VADemo/r1/: DG53P451.m
Only in ./VADemo/r1/: DG53P543.m
Only in ./VADemo/r1/: DG53P555.m
Only in ./VADemo/r1/: DG53P574.m
Only in ./VADemo/r1/: DG53P593.m
Only in ./VADemo/r1/: DG53P597.m
Only in ./VADemo/r1/: DG53P600.m
Only in ./VADemo/r1/: DG53P604.m
Only in ./VADemo/r1/: DG53S451.m
Only in ./VADemo/r1/: DGAPI.m
diff -y --suppress-common-lines ./VADemo/r1/DGBLRV.m ./VADemo/r2/r/DGBLRV.m
	;;5.3;Registration;**26,570**;Aug 13, 1993	      |		;;5.3;Registration;**26**;Aug 13, 1993
INS	; -- new insurance logic, modified for IBBAPI insuran |	INS	; -- new insurance logic
	N DGIBINS,DGIBDT,DGDATA,DGIB,DGX		      |		N DGIBINS,DGIBDT
	S DGIBDT=$P(DGIBDT,".")				      |		D ALL^IBCNS1(DFN,"DGIBINS",2,DGIBDT)
	S DGIB=$$INSUR^IBBAPI(DFN,DGIBDT,"R",.DGDATA,"*")     |		S P=1
	S DGX="DGDATA(""IBBAPI"",""INSUR"")" M DGIBINS=@DGX   |		I $G(DGIBINS(0)) F I=0:0 S I=$O(DGIBINS(I)) Q:'I  D
	S P=1,I=0					      |		.S DGINS=$G(DGIBINS(I,0)) I $P(DGINS,U,4)>DT!($P(DGIN
	I DGIB F  S I=$O(DGIBINS(I)) Q:'I  D		      <
	. I DGIBINS(I,11)>DT!(DGIBINS(I,11)="") D	      <
	. . K DGINAD D:DGI ADDR				      <
	. . S I(P)=+DGIBINS(I,1)_U_DGIBINS(I,14)_U	      <
	. . N DGGRP					      <
	. . S DGGRP=DGIBINS(I,18) ; Group Policy Number	      <
	. . S I(P)=I(P)_$G(DGGRP)_U			      <
	. . S I(P)=I(P)_$P(DGIBINS(I,8),U,2)_U_$S($D(DGINAD): <
	. . S P=P+1					      <
ADDR	; 						      |	ADDR	S DGIMULT=$S($D(^DIC(36,+DGINS,.11)):^(.11),1:"") Q:D
	S DGINAD=$S(DGIBINS(I,2)]"":DGIBINS(I,2)_", ",1:"")_$ |		S DGINAD=$S($P(DGIMULT,U,1)]"":$P(DGIMULT,U,1)_", ",1
	Q						      |		S DGINAD=DGINAD_$S('$D(^DIC(5,+$P(DGIMULT,U,5),0)):""
51	W $S($D(DGIBINS(P)):$P(DGIBINS(P,1),U,2),1:"") Q      |	51	W $S('$D(I(P)):"",$D(^DIC(36,+I(P),0)):$P(^(0),U),1:"
71	W $S($D(DGIBINS(P)):DGIBINS(P,6),1:"") Q	      |	71	W $S('$D(I(P)):"",$D(^DIC(36,$P(I(P),"^",K),.13)):$P(
81	W " " Q  ; Pre-certification phone# not currently ava |	81	W $S('$D(I(P)):"",$D(^DIC(36,$P(I(P),"^",1),.13)):$P(
82	W " " Q  ; Billing phone# not currently available in  |	82	W $S('$D(I(P)):"",$D(^DIC(36,$P(I(P),"^",1),.13)):$P(
	S DIS(0)="S DFN=$P(^DGPM(D0,0),U,3) I $P(^(0),""^"",2 |		S DIS(0)="S DFN=$P(^DGPM(D0,0),U,3) I $P(^(0),""^"",2
	I $S('$$INSUR^IBBAPI(DFN,"","A"):1,'$D(^DPT(DFN,"VET" |		I $S('$O(^DPT(DFN,.312,0)):1,'$D(^DPT(DFN,"VET")):1,^
Only in ./VADemo/r1/: DGBT1P2.m
Only in ./VADemo/r1/: DGBT1P3.m
diff -y --suppress-common-lines ./VADemo/r1/DGBT2.m ./VADemo/r2/r/DGBT2.m
DGBT2	;ALB/LM - BENEFICIARY TRAVEL SCREEN 2 ; 07/09/2004    |	DGBT2	;ALB/LM - BENEFICIARY TRAVEL SCREEN 2 ;5/24/91  09:19
	;;1.0;Beneficiary Travel;**7,8**;September 25, 2001   |		;;1.0;Beneficiary Travel;;September 25, 2001
APPT	I $D(DGBTCL(101)) W ?14,DGBTCL(101) Q		      |	APPT	I $D(DGBTCL) S DGBTCN=+$P(DGBTCL(I),"^") W ?14,$S($D(
	.W ?14,$P(DGBTCL(I),U)," ("_$$FMTE^DILIBF(I,"5U")_")" |		.S X=$P(DGBTCL(I),"^",2)
	.S X=$P(DGBTCL(I),U,2)				      |		.W ?50,$S(X["NT":"NO ACTION TAKEN",X["N":"NO-SHOW",X[
	.W ?50,$S(X["NT":"NO ACTION TAKEN",X["N":"NO-SHOW",X[ <
	.W ?66,$P("C&P^10-10^SCHED.^UNSCHED.",U,+$P(DGBTCL(I) <
	.W ?73,$S($D(^SD(409.1,+$P(DGBTCL(I),U,4),0)):$P(^SD( <
AMT	N X3 ;Fresh copy for COMMA^%DTC. Leftovers causing er |	AMT	S X=$P(^DGBT(392,DGBTPDT,0),"^",9),X2="2$" D COMMA^%D
	S X=$P(^DGBT(392,DGBTPDT,0),"^",9),X2="2$" D COMMA^%D <
diff -y --suppress-common-lines ./VADemo/r1/DGBTCD.m ./VADemo/r2/r/DGBTCD.m
	;;1.0;Beneficiary Travel;**2,7,9**;September 25, 2001 |		;;1.0;Beneficiary Travel;;September 25, 2001
	W ?51,"Most Econ. Cost: " S X=$P(DGBTVAR(0),U,8),X2=" |		W ?51,"Most Econ. Cost: " S X=$P(DGBTVAR(0),U,8),X2="
	I $D(^DG(43,1,"BT")) I $P(^DG(43,1,"BT"),U,2)=1 W ?51 |		I $D(^DG(43,1,"BT")) I $P(^DG(43,1,"BT"),U,2)=1 W ?51
	I DGBTACCT'=4&(DGBTACCT'=5) D			      |		I DGBTACCT'=4&(DGBTACCT'=5) W !?5,"Carrier: ",$S($P(D
	. S DGX=$S($P(DGBTVAR(0),U,7):"Carrier",$P(DGBTVAR(0) |		I $D(^DG(43,1,"BT")) I $P(^DG(43,1,"BT"),U,2)=1 W ?46
	. W $E($S((DGX["FLS"&$P(DGBTVAR(0),U,14)):$P(^DGBT(39 <
	I $D(^DG(43,1,"BT")) I $P(^DG(43,1,"BT"),U,2)=1 W ?46 <
	I DGBTACCT=4!(DGBTACCT=5) W ?46,"Total Mileage Amount |		I DGBTACCT=4!(DGBTACCT=5) W ?46,"Total Mileage Amount
DED	W ?48,"Applied Deductible: " S X=$P(DGBTVAR(0),U,9) N |	DED	W ?48,"Applied Deductible: " S X=$P(DGBTVAR(0),U,9) D
	W ?52,"Amount Payable: " S X=$P(DGBTVAR(0),U,10) N X3 |		W ?52,"Amount Payable: " S X=$P(DGBTVAR(0),U,10) D CO
diff -y --suppress-common-lines ./VADemo/r1/DGBTCE.m ./VADemo/r2/r/DGBTCE.m
	;;1.0;Beneficiary Travel;**2**;September 25, 2001     |		;;1.0;Beneficiary Travel;;September 25, 2001
	S DIE="^DGBT(392,",DA=DGBTDT			      |		S DIE="^DGBT(392,",DA=DGBTDT,DR="I DGBTACCT=4!(DGBTAC
	I 'DGBTCORE D					      <
	. S DR="I DGBTACCT=4!(DGBTACCT=5) S Y=""@1"";41;7;@1; <
	I DGBTCORE S DR="" D				      <
	. S DR(1,392,1)="I DGBTACCT=4!(DGBTACCT=5) S Y=""@1"" <
	. S DR(1,392,2)="@1;I DGBTMLFB=0 S Y=""@2"";34//;S DG <
diff -y --suppress-common-lines ./VADemo/r1/DGBTCR.m ./VADemo/r2/r/DGBTCR.m
	;;1.0;Beneficiary Travel;**7**;September 25, 2001     |		;;1.0;Beneficiary Travel;;September 25, 2001
	N X3						      <
Only in ./VADemo/r1/: DGBTCSL.m
diff -y --suppress-common-lines ./VADemo/r1/DGBTE1.m ./VADemo/r2/r/DGBTE1.m
DGBTE1	;ALB/SCK/EG - BENEFICIARY TRAVEL FIND OLD CLAIM DATES |	DGBTE1	;ALB/SCK - BENEFICIARY TRAVEL FIND OLD CLAIM DATES  ;
	;;1.0;Beneficiary Travel;**8,12**;September 25, 2001  |		;;1.0;Beneficiary Travel;;September 25, 2001
	S CHZFLG=0,%DT="EXR",DTSUB=$S(Y="N":"NOW",Y="P":"OLD" |		S CHZFLG=0,%DT="EXR",DTSUB=$S(Y="N":"NOW",Y="P":"OLD"
	N DGARRAY,CLIEN,APTDT S DGARRAY("FLDS")="2;3;10;18"   |		F I=0:0 S I=$O(^DPT(DFN,"S",I)) Q:'I!(I>(DGBTDTI+1)) 
	S DGARRAY(4)=DFN,I=$$SDAPI^SDAMA301(.DGARRAY)	      <
	;if dfn = 101, e.g., it's not clear if it is an error <
	;if an error, there will be no lower subscripts eg 01 <
	I $D(^TMP($J,"SDAMA301",101))=1 S I1=1,DGBTCL(101)="* <
	I $D(^TMP($J,"SDAMA301",101))'=1 D		      <
	.S CLIEN="" F  S CLIEN=$O(^TMP($J,"SDAMA301",DFN,CLIE <
	..S APTDT=DGBTDTI\1 F  S APTDT=$O(^TMP($J,"SDAMA301", <
	...S DGBTCL(APTDT)=$P($P(^TMP($J,"SDAMA301",DFN,CLIEN <
	K ^TMP($J,"SDAMA301"),DGARRAY,CLIEN,APTDT	      <
diff -y --suppress-common-lines ./VADemo/r1/DGBTEE.m ./VADemo/r2/r/DGBTEE.m
	;;1.0;Beneficiary Travel;**2**;September 25, 2001     |		;;1.0;Beneficiary Travel;;September 25, 2001
	I 'DGBTCORE D					      |		S DR="3////"_DGBTELIG_";4////"_DGBTSCP_";5///"_DGBTCD
	. S DR="3////"_DGBTELIG_";4////"_DGBTSCP_";5///"_DGBT <
	I DGBTCORE D					      <
	. S DR(1,392,1)="3////"_DGBTELIG_";4////"_DGBTSCP_";5 <
	. S DR(1,392,2)="@3;14;S DGBTCSL=$$AFTER^DGBTCSL(392, <
	D ^DIE K DR I X=""!(X="^") S DGBTTOUT=-1 Q	      |		D ^DIE I X=""!(X="^") S DGBTTOUT=-1 Q
diff -y --suppress-common-lines ./VADemo/r1/DGBTEF1.m ./VADemo/r2/r/DGBTEF1.m
	;;1.0;Beneficiary Travel;**2**;September 25, 2001     |		;;1.0;Beneficiary Travel;;September 25, 2001
	S DA=1,DR="720;723;721",DIE="^DG(43," D ^DIE G QUIT:X |		S DA=1,DR="720;721",DIE="^DG(43," D ^DIE G QUIT:X="^"
diff -y --suppress-common-lines ./VADemo/r1/DGBTEF.m ./VADemo/r2/r/DGBTEF.m
	;;1.0;Beneficiary Travel;**7**;September 25, 2001     |		;;1.0;Beneficiary Travel;;September 25, 2001
	N X3 ;Clean copy used by COMMA^%DTC		      <
diff -y --suppress-common-lines ./VADemo/r1/DGBTE.m ./VADemo/r2/r/DGBTE.m
	;;1.0;Beneficiary Travel;**2**;September 25, 2001     |		;;1.0;Beneficiary Travel;;September 25, 2001
COREFLS	;  coreFLS vendor interface active/inactive	      <
	S DGBTCORE=$P($G(^DG(43,1,"BT")),U,4)		      <
	;						      <
Only in ./VADemo/r1/: DGBTID.m
diff -y --suppress-common-lines ./VADemo/r1/DGBTOA1.m ./VADemo/r2/r/DGBTOA1.m
	;;1.0;Beneficiary Travel;**2**;September 25, 2001     |		;;1.0;Beneficiary Travel;;September 25, 2001
CAR	I '$P($G(^DG(43,1,"BT")),U,4) S VAUTVB="VAUTN",PRCABN |	CAR	S VAUTVB="VAUTN",PRCABN=0,DIC="^PRC(440,",VAUTSTR="ca
	I $P($G(^DG(43,1,"BT")),U,4) S VAUTVB="VAUTN",PRCABN= <
diff -y --suppress-common-lines ./VADemo/r1/DGBTOA2.m ./VADemo/r2/r/DGBTOA2.m
	;;1.0;Beneficiary Travel;**2,7**;September 25, 2001   |		;;1.0;Beneficiary Travel;;September 25, 2001
	S DGBTIX=$S(DGBTSL="ACCT":"AC",DGBTSL="CAR":"AS",DGBT |		S DGBTIX=$S(DGBTSL="ACCT":"AC",DGBTSL="CAR":"AS",DGBT
	I $P($G(^DG(43,1,"BT")),U,4) S DGBTIX=$S(DGBTSL="CAR" <
	D SORT G:DGBTU QUIT1 I $D(^UTILITY($J)) D TOTAL^DGBTO <
	I '$P($G(^DG(43,1,"BT")),U,4) S DGBTB=$S($P(DGBTK,U,7 |		S DGBTB=$S($P(DGBTK,U,7):$P(^PRC(440,$P(DGBTK,U,7),0)
	I $P($G(^DG(43,1,"BT")),U,4) S DGBTB=$S($P(DGBTK,U,14 <
	S DGBTK9=$P(DGBTK,U,9),DGBTK10=$P(DGBTK,U,10)	      <
ACCTU	S DGBTCW=$S(DGBTSL="CAR"&('$P($G(^DG(43,1,"BT")),U,4) |	ACCTU	S DGBTCW=$S(DGBTSL="CAR":$P(^PRC(440,DGBTBY,0),U,1),1
	S DGBTOTX(DGBTDN,DGBTCW)=$S('$D(DGBTOTX(DGBTDN,DGBTCW <
CM	N X3 D COMMA^%DTC Q				      |	CM	D COMMA^%DTC Q
diff -y --suppress-common-lines ./VADemo/r1/DGBTOA3.m ./VADemo/r2/r/DGBTOA3.m
	;;1.0;Beneficiary Travel;**7**;September 25, 2001     |		;;1.0;Beneficiary Travel;;September 25, 2001
CM	N X3 D COMMA^%DTC Q				      |	CM	D COMMA^%DTC Q
diff -y --suppress-common-lines ./VADemo/r1/DGBTOA4.m ./VADemo/r2/r/DGBTOA4.m
	;;1.0;Beneficiary Travel;**7**;September 25, 2001     |		;;1.0;Beneficiary Travel;;September 25, 2001
CM	N X3 D COMMA^%DTC Q				      |	CM	D COMMA^%DTC Q
diff -y --suppress-common-lines ./VADemo/r1/DGBTOA5.m ./VADemo/r2/r/DGBTOA5.m
	;;1.0;Beneficiary Travel;**5**;September 25, 2001     |		;;1.0;Beneficiary Travel;;September 25, 2001
	N X3 K DIR					      |		K DIR
Only in ./VADemo/r1/: DGBTPRE.m
Only in ./VADemo/r1/: DGBTVUP.m
diff -y --suppress-common-lines ./VADemo/r1/DGBUL.m ./VADemo/r2/r/DGBUL.m
	;;5.3;Registration;**31,244,545**;Aug 13, 1993	      |		;;5.3;Registration;**31**;Aug 13, 1993
	;						      <
	;Protect Fileman from Mailman call		      <
	N DICRREC,DIDATA,DIEFAR,DIEFCNOD,DIEFDAS,DIEFECNT,DIE <
	N DIEFFLD,DIEFFLST,DIEFFREF,DIEFFVAL,DIEFFXR,DIEFI,DI <
	N DIEFNODE,DIEFNVAL,DIEFOUT,DIEFOVAL,DIEFRFLD,DIEFRLS <
	N DIEFSPOT,DIEFTMP,DIEFTREF,DIFLD,DIFM,DIQUIET,DISYS, <
	;						      <
Only in ./VADemo/r1/: DGCV1.m
Only in ./VADemo/r1/: DGCVEXP.m
Only in ./VADemo/r1/: DGCV.m
Only in ./VADemo/r1/: DGCVRPT.m
diff -y --suppress-common-lines ./VADemo/r1/DGDDC.m ./VADemo/r2/r/DGDDC.m
	;;5.3;Registration;**489,244,527**;Aug 13, 1993	      |		;;5.3;Registration;;Aug 13, 1993
	Q:$D(DGNOFDEL)  ;Flag variable to prevent deletion ca |		Q:'$D(DGXRF)  S DGXRFX=X,DGXRF1=+$P(DGXRF,".",2),DGXR
	;						      <
	Q:'$D(DGXRF)  N DGXRFX,DGXRF1,DGXRF2,DGXRF3,DGXRF3,DG <
	S DGXRFX=X,DGXRF1=+$P(DGXRF,".",2),DGXRF2=$P($T(@DGXR <
	N DGFDA,DGERR					      |		F DGXRF3=1:1 S DGXRF4=$P(DGXRF2,"^",DGXRF3) Q:DGXRF4=
	;F DGXRF3=1:1 S DGXRF4=$P(DGXRF2,"^",DGXRF3) Q:DGXRF4 |	Q	S X=DGXRFX K DGXRF,DGXRF1,DGXRF2,DGXRF3,DGXRF3,DGXRF4
	F DGXRF3=1:1 S DGXRF4=$P(DGXRF2,"^",DGXRF3) Q:DGXRF4= <
	.S DGFDA(2,DA_",",DGXRF4)=""			      <
	I $D(DGFDA) D FILE^DIE("","DGFDA","DGERR")	      <
Q	S X=DGXRFX K DGXRF Q  ;,DGXRFX,DGXRF1,DGXRF2,DGXRF3,D <
14105	;;.1417^.1418					      <
1411	;;.1412^.1413					      <
1412	;;.1413						      <
diff -y --suppress-common-lines ./VADemo/r1/DGDEATH.m ./VADemo/r2/r/DGDEATH.m
DGDEATH	;ALB/MRL/PJR-PROCESS DECEASED PATIENTS ; 10/27/04 9:4 |	DGDEATH	;ALB/MRL-PROCESS DECEASED PATIENTS ;19 JUN 87
	;;5.3;Registration;**45,84,101,149,392,545,595,568,56 |		;;5.3;Registration;**45,84,101,149,392**;Aug 13, 1993
	S DGDOLD=$G(^DPT(DFN,.35))			      <
	D NOW^%DTC S DGNOW=%				      |		K A W ! S DIE=DIC,DR=".351" D ^DIE G GET
	S ^TMP("DEATH",$J)=1				      <
	K A W ! S DIE=DIC,DR=".351" D ^DIE		      <
	I '$D(^DPT(DFN,.35)) K ^TMP("DEATH",$J) G GET	      <
	S DGDNEW=^DPT(DFN,.35)				      <
	I $P(DGDNEW,"^",1)="",$P(DGDNEW,"^",2)'="" S DR=".352 <
	I $P(DGDNEW,"^",1)="" K ^TMP("DEATH",$J) G GET	      <
	I $P(DGDNEW,"^",1)'="" S DR=".353" D ^DIE	      <
	I DGDOLD'=DGDNEW D DISCHRGE			      <
	I $P(DGDOLD,"^",1)'=$P(DGDNEW,"^",1) D XFR	      <
	K ^TMP("DEATH",$J) G GET			      <
Q	K A,DA,DFN,DGDA,DIC,DIE,DR,DGXX,DGY,DGDTHEN,DGDOLD,DG |	Q	K A,DA,DFN,DGDA,DIC,DIE,DR,DGXX,DGY,DGDTHEN Q
	K DGTEXT D ^DGPATV S DGDEATH=$$GET1^DIQ(2,DFN,.351,"I |		K DGTEXT D ^DGPATV S DGDEATH=X,XMSUB="PATIENT HAS EXP
	S DGT=X-.0001,(Y,DGDDT)=X,DG1="" D:DGT]"" ^DGPMSTAT   |		S DGT=X-.0001,(Y,DGDDT)=X,DG1="" D:DGT]"" ^DGINPW
	S DGDONOT=0 D APTT3				      <
	D LINE("      Date/Time of Death: "_DEATHVAL_$S(DGDON |		D LINE("      Date/Time of Death: "_Y_$S('DG1:"",$D(D
F	N DGARRAY,SDCNT S DGFAPT=DGDEATH,DGFAPTI=""	      |	F	S DGFAPT=DGDEATH,DGFAPTI=""
	S DGARRAY("FLDS")=3,DGARRAY(4)=DFN,DGARRAY("SORT")="P |		F  S DGFAPT=$O(^DPT(DFN,"S",DGFAPT)) Q:'DGFAPT  S DGF
	S SDCNT=$$SDAPI^SDAMA301(.DGARRAY)		      |		.I $P(DGFAPT1,"^",2)'["C" D LINE("NOTE: Patient has f
	F  S DGFAPT=$O(^TMP($J,"SDAMA301",DFN,DGFAPT)) Q:'DGF <
	.I $P($P(DGFAPT1,U,3),";")'["C" D LINE("NOTE: Patient <
	N DGPCMM,DELBY,DELTM,DTHINFO			      |		N DGPCMM
	D LINE("")					      <
	D GETS^DIQ(2,DFN_",",".351;.353;.354;.355","E","DTHIN <
	S DEATHVAL=$G(DTHINFO(2,DFN_",",.351,"E"))	      <
	S DEATHVAL=$$FMTE^XLFDT(DEATHVAL),DEATHVAL=$S(DEATHVA <
	S SOURCE=$G(DTHINFO(2,DFN_",",.353,"E"))	      <
	S DELTM=$G(DTHINFO(2,DFN_",",.354,"E"))		      <
	S DELBY=$G(DTHINFO(2,DFN_",",.355,"E"))		      <
	D LINE("")					      <
	D LINE("             LAST EDITED BY: "_DELBY)	      <
	D LINE("    DATE/TIME LAST MODIFIED: "_DELTM)	      <
	D LINE("     SOURCE OF NOTIFICATION: "_$S(SOURCE="":" <
	;K DEATHVAL,SOURCE,DELTM,DELBY			      <
DSBULL	;						      <
	;						      <
	I $G(IVMDODUP)=1 Q				      <
	S DFN=DA					      <
	I $D(DGPMDA) D  Q				      <
	.S DISTYPE=$P($G(^DGPM(DGPMDA,0)),"^",18)	      <
	.I $G(^DG(405.2,DISTYPE,0))["DEATH" D		      <
	..S FDA(2,DFN_",",.353)=1 D FILE^DIE(,"FDA","BWFERR") <
	..D DISCHRGE,XFR				      <
	I $D(^TMP("DEATH",$J)) Q			      <
	D DISCHRGE,XFR					      <
	Q						      <
DKBULL	;						      <
	S DFN=DA					      <
	S FDA(2,DFN_",",.353)="@"			      <
	I $D(^TMP("DEATH",$J)) S FDA(2,DFN_",",.355)=DUZ      <
	D FILE^DIE(,"FDA",)				      <
	D DEL						      <
	Q						      <
DISCHRGE	;					      <
	; If the patient is being discharged, determine value <
	; Source of Notification and Date/Time last entered.  <
	;						      <
	I '$D(DGNOW) S DGNOW=$$HTFM^XLFDT($H)		      <
	I $G(DGDAUTO)'=1 S FDA(2,DFN_",",.354)=DGNOW	      <
	S FDA(2,DFN_",",.355)=DUZ			      <
	D FILE^DIE(,"FDA",)				      <
	Q						      <
APTT3	;Check to exclude "While an Inpatient" from DOD Bulle <
	; Input:  DFN  Output: DGDONOT			      <
	N DATE,XIEN,TYPE,XDOD,YES			      <
	S DGDONOT=0					      <
	S XDOD=$P($G(^DPT(DFN,.35)),"^",1) I 'XDOD Q	      <
	S XDOD=$P(XDOD,".",1),YES=0,TYPE=""		      <
	I '$D(^DGPM("APTT3",DFN)) Q			      <
	S DATE=$O(^DGPM("APTT3",DFN,XDOD)) I 'DATE Q	      <
	I $P(DATE,".",1)=XDOD S YES=1			      <
	I ($P(DATE,".",1)-1)=XDOD S YES=1		      <
	S XIEN=$O(^DGPM("APTT3",DFN,DATE,"")) I 'XIEN Q	      <
	S TYPE=$P($G(^DGPM(XIEN,0)),"^",4)		      <
	I YES,'((TYPE=27)!(TYPE=32)) S DGDONOT=1	      <
	Q						      <
diff -y --suppress-common-lines ./VADemo/r1/DGDIS1.m ./VADemo/r2/r/DGDIS1.m
DGDIS1	;ALB/XAK-MRL - DISPOSITION PROCESSING ; 02/15/2004    |	DGDIS1	;ALB/XAK-MRL - DISPOSITION PROCESSING ; 24 AUG 84  15
	;;5.3;Registration;**151,568**;Aug 13, 1993	      |		;;5.3;Registration;**151**;Aug 13, 1993
	W !,"APPOINTMENTS CAN NO LONGER BE MADE USING THIS OP |		S Y(0)=^DPT(DFN,0),Y=DFN,(SDMM,DIROUT,ORACTION)=0 K S
diff -y --suppress-common-lines ./VADemo/r1/DGDIS.m ./VADemo/r2/r/DGDIS.m
DGDIS	;ALB/JDS - DISPOSITION A REGISTRATION ; 8/6/04 3:17pm |	DGDIS	;ALB/JDS - DISPOSITION A REGISTRATION ; 26 AUG 84  14
	;;5.3;Registration;**108,121,161,151,459,604**;Aug 13 |		;;5.3;Registration;**108,121,161,151**;Aug 13, 1993
							      >		S SDISHDL=$$HANDLE^SDAMEVT(3) D BEFORE(DFN,9999999-DF
							      >		;
							      >		I "^0^1^"[("^"_$P($G(^DPT(DFN,"DIS",DFN1,0)),"^",2)_"
	W !!,"***** Registration dispositioned *****",!!,*7   |		D EVT(DFN,9999999-DFN1,8,SDISHDL) W !!,"***** Registr
	I $P($G(^DPT(DFN,"DIS",DFN1,0)),"^",18) D EN^SDCODEL( |		I $P($G(^DPT(DFN,"DIS",DFN1,0)),"^",18) D EN^SDCODEL(
							      >		D CLEAN^SDAMEVT(SDISHDL) ; clean up oe evt handle
	. ;						      |		.
diff -y --suppress-common-lines ./VADemo/r1/DGENA1A.m ./VADemo/r2/r/DGENA1A.m
DGENA1A	;ALB/CJM,ISA/KWP,Zoltan,LBD - Enrollment API - File D |	DGENA1A	;ALB/CJM,ISA/KWP,Zoltan - Enrollment API - File Data 
	;;5.3;Registration;**