Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC.m	(revision 623)
@@ -1,10 +1,9 @@
-A1CKC ; GENERATED FROM 'A1CK VARO/DHCP' INPUT TEMPLATE(#1505), FILE 2;12/13/08
+A1CKC ; GENERATED FROM 'A1CK VARO/DHCP' INPUT TEMPLATE(#1505), FILE 2;04/21/06
  D DE G BEGIN
 DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
- I $D(^(.3)) S %Z=^(.3) S %=$P(%Z,U,1) S:%]"" DE(4)=%,DE(11)=% S %=$P(%Z,U,2) S:%]"" DE(5)=%
+ I $D(^(.3)) S %Z=^(.3) S %=$P(%Z,U,1) S:%]"" DE(4)=% S %=$P(%Z,U,2) S:%]"" DE(5)=%
  I $D(^(.36)) S %Z=^(.36) S %=$P(%Z,U,1) S:%]"" DE(6)=%
- I $D(^(.362)) S %Z=^(.362) S %=$P(%Z,U,12) S:%]"" DE(13)=% S %=$P(%Z,U,14) S:%]"" DE(12)=%
  I $D(^("TYPE")) S %Z=^("TYPE") S %=$P(%Z,U,1) S:%]"" DE(7)=%
- I $D(^("VET")) S %Z=^("VET") S %=$P(%Z,U,1) S:%]"" DE(3)=%,DE(10)=%
+ I $D(^("VET")) S %Z=^("VET") S %=$P(%Z,U,1) S:%]"" DE(3)=%
  K %Z Q
  ;
@@ -61,5 +60,5 @@
  Q
 2 S DQ=3 ;@10
-3 S DW="VET;1",DV="SXa",DU="",DLB="VETERAN (Y/N)?",DIFLD=1901
+3 S DW="VET;1",DV="RSXa",DU="",DLB="VETERAN (Y/N)?",DIFLD=1901
  S DE(DW)="C3^A1CKC"
  S DU="Y:YES;N:NO;"
@@ -71,6 +70,4 @@
  S DFN=DA D EN^DGMTCOR K DGMTCOR
  S X=DE(3),DIC=DIE
- S DFN=DA D EN^DGRP7CC
- S X=DE(3),DIC=DIE
  ;
  S X=DE(3),DIC=DIE
@@ -84,6 +81,4 @@
  S X=DG(DQ),DIC=DIE
  S DFN=DA D EN^DGMTCOR K DGMTCOR
- S X=DG(DQ),DIC=DIE
- S DFN=DA D EN^DGRP7CC
  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(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X=DIV S X="N" X ^DD(2,1901,1,3,1.4)
@@ -99,5 +94,5 @@
  Q
  ;
-4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW=".3;1",DV="SXa",DU="",DLB="SERVICE CONNECTED?",DIFLD=.301
+4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW=".3;1",DV="RSXa",DU="",DLB="SERVICE CONNECTED?",DIFLD=.301
  S DE(DW)="C4^A1CKC"
  S DU="Y:YES;N:NO;"
@@ -187,20 +182,10 @@
  S X=DE(6),DIIX=2_U_DIFLD D AUDIT^DIET
 C6S S X="" G:DG(DQ)=X C6F1 K DB
- S X=DG(DQ),DIC=DIE
- X "S DFN=DA D EN^DGMTR K DGREQF"
- 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 Y(102)=$S($D(^DPT(D0,"E",D1,0)):^(0),1:"") S X=$S('$D(^DIC(8,+$P(Y(102),U,1),0)):"",1:$P(^(0),U,1)) S D0=I(0,0) S D1=I(1,0) S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(2,.361,1,2,1.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)
- I $D(DE(6))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+ D ^A1CKC1
 C6F1 Q
 X6 S DFN=DA D EV^DGLOCK I $D(X) D ECD^DGLOCK1
  Q
  ;
-7 D:$D(DG)>9 F^DIE17,DE S DQ=7,DW="TYPE;1",DV="P391'a",DU="",DLB="TYPE",DIFLD=391
+7 D:$D(DG)>9 F^DIE17,DE S DQ=7,DW="TYPE;1",DV="RP391'a",DU="",DLB="TYPE",DIFLD=391
  S DE(DW)="C7^A1CKC",DE(DW,"INDEX")=1
  S DU="DG(391,"
@@ -214,7 +199,5 @@
  S X=DE(7),DIIX=2_U_DIFLD D AUDIT^DIET
 C7S S X="" G:DG(DQ)=X C7F1 K DB
- S X=DG(DQ),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF="391;" D AVAFC^VAFCDD01(DA)
- I $D(DE(7))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+ D ^A1CKC2
 C7F1 N X,X1,X2 S DIXR=664 D C7X1(U) K X2 M X2=X D C7X1("O") K X1 M X1=X
  I $G(X(1))]"" D
@@ -233,61 +216,3 @@
  Q
 9 S DQ=10 ;@20
-10 D:$D(DG)>9 F^DIE17,DE S DQ=10,DW="VET;1",DV="SXa",DU="",DLB="VETERAN (Y/N)?",DIFLD=1901
- 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"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C10 G C10S:$D(DE(10))[0 K DB
- D ^A1CKC1
-C10S S X="" G:DG(DQ)=X C10F1 K DB
- D ^A1CKC2
-C10F1 Q
-X10 I $D(X) S:'$D(DPTX) DFN=DA D:'$D(^XUSEC("DG ELIGIBILITY",DUZ)) VAGE^DGLOCK:X="Y" I $D(X) D:$D(DFN) EV^DGLOCK
- Q
- ;
-11 D:$D(DG)>9 F^DIE17,DE S DQ=11,DW=".3;1",DV="SXa",DU="",DLB="SERVICE CONNECTED?",DIFLD=.301
- S DE(DW)="C11^A1CKC"
- 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"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C11 G C11S:$D(DE(11))[0 K DB
- D ^A1CKC3
-C11S S X="" G:DG(DQ)=X C11F1 K DB
- D ^A1CKC4
-C11F1 Q
-X11 S DFN=DA D EV^DGLOCK I $D(X),X="Y" D VET^DGLOCK
- Q
- ;
-12 D:$D(DG)>9 F^DIE17,DE S DQ=12,DW=".362;14",DV="SX",DU="",DLB="RECEIVING A VA PENSION?",DIFLD=.36235
- S DE(DW)="C12^A1CKC"
- 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"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C12 G C12S:$D(DE(12))[0 K DB
- D ^A1CKC5
-C12S S X="" G:DG(DQ)=X C12F1 K DB
- D ^A1CKC6
-C12F1 Q
-X12 S DFN=DA D MV^DGLOCK
- Q
- ;
-13 D:$D(DG)>9 F^DIE17,DE S DQ=13,DW=".362;12",DV="SX",DU="",DLB="RECEIVING A&A BENEFITS?",DIFLD=.36205
- S DE(DW)="C13^A1CKC"
- 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"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C13 G C13S:$D(DE(13))[0 K DB
- D ^A1CKC7
-C13S S X="" G:DG(DQ)=X C13F1 K DB
- D ^A1CKC8
-C13F1 Q
-X13 S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK
- Q
- ;
-14 D:$D(DG)>9 F^DIE17 G ^A1CKC9
+10 D:$D(DG)>9 F^DIE17 G ^A1CKC3
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC1.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC1.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC1.m	(revision 623)
@@ -1,14 +1,12 @@
-A1CKC1 ; ;12/13/08
- S X=DE(10),DIC=DIE
- S DFN=DA D EN^DGMTCOR K DGMTCOR
- S X=DE(10),DIC=DIE
- S DFN=DA D EN^DGRP7CC
- S X=DE(10),DIC=DIE
+A1CKC1 ; ;04/21/06
+ S X=DG(DQ),DIC=DIE
+ X "S DFN=DA D EN^DGMTR K DGREQF"
+ 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 Y(102)=$S($D(^DPT(D0,"E",D1,0)):^(0),1:"") S X=$S('$D(^DIC(8,+$P(Y(102),U,1),0)):"",1:$P(^(0),U,1)) S D0=I(0,0) S D1=I(1,0) S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(2,.361,1,2,1.4)
+ S X=DG(DQ),DIC=DIE
  ;
- S X=DE(10),DIC=DIE
+ S X=DG(DQ),DIC=DIE
+ S ^DPT("AEL",DA,+X)=""
+ S X=DG(DQ),DIC=DIE
  D AUTOUPD^DGENA2(DA)
- S X=DE(10),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF="1901;" D AVAFC^VAFCDD01(DA)
- S X=DE(10),DIC=DIE
- D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- S X=DE(10),DIIX=2_U_DIFLD D AUDIT^DIET
+ I $D(DE(6))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC10.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC10.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC10.m	(revision 623)
@@ -1,155 +1,4 @@
-A1CKC10 ; ;12/13/08
- D DE G BEGIN
-DE S DIE="^DPT(D0,.372,",DIC=DIE,DP=2.04,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$O(^DPT(D0,.372,DA,""))=""
- I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,1) S:%]"" DE(1)=% S %=$P(%Z,U,2) S:%]"" DE(2)=% S %=$P(%Z,U,3) S:%]"" DE(3)=%
- 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 "  (No Editing)" Q
-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 NKEY:$D(^DD("KEY","F",DP,DIFLD)),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=^(DLB) I DV'["D",DV'["S" W "  "_X
-T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
- K DDER G X
-P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) G:DV["*" AST^DIED D NOSCR^DIED S X=+Y,DIC=DIE G X:X<0
- 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,99)["+X'=X" S X=+X
-V D @("X"_DQ) K YS
-Z K DIC("S"),DLAYGO I $D(X),X'=U D:$G(DE(DW,"INDEX")) SAVEVALS G:'$$KEYCHK UNIQFERR^DIE17 S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A
-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))," ",2,99) Q
-Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
-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(^(Y,0)) S Y=$P(^(0),U),X=$P(^DD(X,.01,0),U,3),DG=$P(^(0),U,2) G R
- I DG["V",+Y,$P(Y,";",2)["(",$D(@(U_$P(Y,";",2)_"0)")) S X=+$P(^(0),U,2) G RP:'$D(^(+Y,0)) S Y=$P(^(0),U) I $D(^DD(+X,.01,0)) S DG=$P(^(0),U,2),X=$P(^(0),U,3) G R
- X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" 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")=1
- I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
- D ^DIR I 'DDER S %=Y(0),X=Y
- Q
-SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$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 QS
-KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
-BEGIN S DNM="A1CKC10",DQ=1+D G B
-1 S DW="0;1",DV="MP31'X",DU="",DLB="RATED DISABILITIES (VA)",DIFLD=.01
- S DE(DW)="C1^A1CKC10",DE(DW,"INDEX")=1
- 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"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C1 G C1S:$D(DE(1))[0 K DB
- S X=DE(1),DIC=DIE
- D EVENT^IVMPLOG($G(DA(1)))
-C1S S X="" G:DG(DQ)=X C1F1 K DB
+A1CKC10 ; ;04/21/06
  S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG($G(DA(1)))
-C1F1 N X,X1,X2 S DIXR=411 D C1X1(U) K X2 M X2=X D C1X1("O") K X1 M X1=X
- D
- . N DIEXARR M DIEXARR=X S DIEZCOND=1
- . I (X1(1)'=X2(1))!(X1(2)'=X2(2))!(X1(3)'=X2(3))
- . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
- . S DGRDCHG=1
- K X M X=X2 D
- . N DIEXARR M DIEXARR=X S DIEZCOND=1
- . I (X1(1)'=X2(1))!(X1(2)'=X2(2))!(X1(3)'=X2(3))
- . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
- . S DGRDCHG=1
- G C1F2
-C1X1(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2.04,DIIENS,.01,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,1))
- S X(2)=$G(@DIEZTMP@("V",2.04,DIIENS,2,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,2))
- S X(3)=$G(@DIEZTMP@("V",2.04,DIIENS,3,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,3))
- S X=$G(X(1))
- Q
-C1F2 Q
-X1 I $D(X) D EK^DGLOCK Q
- Q
- ;
-2 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW="0;2",DV="RNJ3,0X",DU="",DLB="DISABILITY %",DIFLD=2
- S DE(DW)="C2^A1CKC10",DE(DW,"INDEX")=1
- 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"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C2 G C2S:$D(DE(2))[0 K DB
- S X=DE(2),DIC=DIE
- D EVENT^IVMPLOG($G(DA(1)))
-C2S S X="" G:DG(DQ)=X C2F1 K DB
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG($G(DA(1)))
-C2F1 N X,X1,X2 S DIXR=411 D C2X1(U) K X2 M X2=X D C2X1("O") K X1 M X1=X
- D
- . N DIEXARR M DIEXARR=X S DIEZCOND=1
- . I (X1(1)'=X2(1))!(X1(2)'=X2(2))!(X1(3)'=X2(3))
- . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
- . S DGRDCHG=1
- K X M X=X2 D
- . N DIEXARR M DIEXARR=X S DIEZCOND=1
- . I (X1(1)'=X2(1))!(X1(2)'=X2(2))!(X1(3)'=X2(3))
- . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
- . S DGRDCHG=1
- G C2F2
-C2X1(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2.04,DIIENS,.01,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,1))
- S X(2)=$G(@DIEZTMP@("V",2.04,DIIENS,2,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,2))
- S X(3)=$G(@DIEZTMP@("V",2.04,DIIENS,3,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,3))
- S X=$G(X(1))
- Q
-C2F2 Q
-X2 K:+X'=X!(X>100)!(X<0)!(X?.E1"."1N.N) X I $D(X) D EK^DGLOCK
- Q
- ;
-3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW="0;3",DV="SX",DU="",DLB="SERVICE CONNECTED",DIFLD=3
- S DE(DW)="C3^A1CKC10",DE(DW,"INDEX")=1
- 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"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C3 G C3S:$D(DE(3))[0 K DB
- S X=DE(3),DIC=DIE
- D EVENT^IVMPLOG($G(DA(1)))
-C3S S X="" G:DG(DQ)=X C3F1 K DB
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG($G(DA(1)))
-C3F1 N X,X1,X2 S DIXR=411 D C3X1(U) K X2 M X2=X D C3X1("O") K X1 M X1=X
- D
- . N DIEXARR M DIEXARR=X S DIEZCOND=1
- . I (X1(1)'=X2(1))!(X1(2)'=X2(2))!(X1(3)'=X2(3))
- . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
- . S DGRDCHG=1
- K X M X=X2 D
- . N DIEXARR M DIEXARR=X S DIEZCOND=1
- . I (X1(1)'=X2(1))!(X1(2)'=X2(2))!(X1(3)'=X2(3))
- . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
- . S DGRDCHG=1
- G C3F2
-C3X1(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2.04,DIIENS,.01,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,1))
- S X(2)=$G(@DIEZTMP@("V",2.04,DIIENS,2,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,2))
- S X(3)=$G(@DIEZTMP@("V",2.04,DIIENS,3,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,3))
- S X=$G(X(1))
- Q
-C3F2 Q
-X3 S DFN=DA(1) D:X SC^DGLOCK1 I $D(X) D EK^DGLOCK 
- Q
- ;
-4 G 1^DIE17
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF="391;" D AVAFC^VAFCDD01(DA)
+ I $D(DE(7))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC11.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC11.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC11.m	(revision 623)
@@ -1,9 +1,177 @@
-A1CKC11 ; ;12/13/08
- S X=DE(19),DIC=DIE
+A1CKC11 ; ;04/21/06
+ D DE G BEGIN
+DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
+ I $D(^(.3)) S %Z=^(.3) S %=$P(%Z,U,11) S:%]"" DE(6)=%
+ I $D(^(.362)) S %Z=^(.362) S %=$P(%Z,U,12) S:%]"" DE(12)=% S %=$P(%Z,U,13) S:%]"" DE(15)=% S %=$P(%Z,U,14) S:%]"" DE(9)=%
+ 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 "  (No Editing)" Q
+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 NKEY:$D(^DD("KEY","F",DP,DIFLD)),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=^(DLB) I DV'["D",DV'["S" W "  "_X
+T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
+ K DDER G X
+P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) G:DV["*" AST^DIED D NOSCR^DIED S X=+Y,DIC=DIE G X:X<0
+ 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,99)["+X'=X" S X=+X
+V D @("X"_DQ) K YS
+Z K DIC("S"),DLAYGO I $D(X),X'=U D:$G(DE(DW,"INDEX")) SAVEVALS G:'$$KEYCHK UNIQFERR^DIE17 S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A
+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))," ",2,99) Q
+Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
+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(^(Y,0)) S Y=$P(^(0),U),X=$P(^DD(X,.01,0),U,3),DG=$P(^(0),U,2) G R
+ I DG["V",+Y,$P(Y,";",2)["(",$D(@(U_$P(Y,";",2)_"0)")) S X=+$P(^(0),U,2) G RP:'$D(^(+Y,0)) S Y=$P(^(0),U) I $D(^DD(+X,.01,0)) S DG=$P(^(0),U,2),X=$P(^(0),U,3) G R
+ X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" 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")=1
+ I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
+ D ^DIR I 'DDER S %=Y(0),X=Y
+ Q
+SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$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 QS
+KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
+BEGIN S DNM="A1CKC11",DQ=1
+1 D:$D(DG)>9 F^DIE17,DE S DQ=1,D=0 K DE(1) ;.3721
+ S DIFLD=.3721,DGO="^A1CKC12",DC="6^2.04P^.372^",DV="2.04MP31'X",DW="0;1",DOW="RATED DISABILITIES (VA)",DLB="Select "_DOW S:D DC=DC_D
+ S DU="DIC(31,"
+ G RE:D I $D(DSC(2.04))#2,$P(DSC(2.04),"I $D(^UTILITY(",1)="" X DSC(2.04) S D=$O(^(0)) S:D="" D=-1 G M1
+ S D=$S($D(^DPT(DA,.372,0)):$P(^(0),U,3,4),$O(^(0))'="":$O(^(0)),1:-1)
+M1 I D>0 S DC=DC_D I $D(^DPT(DA,.372,+D,0)) S DE(1)=$P(^(0),U,1)
+ S X="`"_ISC
+ S Y=X
+ S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+R1 D DE
+ G A
+ ;
+2 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=2 D X2 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X2 S Y="@31"
+ Q
+3 S DQ=4 ;@39
+4 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=4 D X4 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X4 S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
+ Q
+5 S DQ=6 ;@100
+6 S DW=".3;11",DV="SX",DU="",DLB="RECEIVING VA DISABILITY?",DIFLD=.3025
+ S DE(DW)="C6^A1CKC11"
+ 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"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C6 G C6S:$D(DE(6))[0 K DB
+ S X=DE(6),DIC=DIE
+ X ^DD(2,.3025,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(2,.3025,1,1,2.4)
+ S X=DE(6),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.3025,1,2,2.4)
+C6S S X="" G:DG(DQ)=X C6F1 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(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(2,.3025,1,1,1.4)
+ S X=DG(DQ),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.3025,1,2,1.4)
+C6F1 Q
+X6 S DFN=DA D MV^DGLOCK I $D(X),X="Y" D EC^DGLOCK1
+ Q
+ ;
+7 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=7 D X7 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X7 S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
+ Q
+8 S DQ=9 ;@200
+9 D:$D(DG)>9 F^DIE17,DE S DQ=9,DW=".362;14",DV="SX",DU="",DLB="RECEIVING A VA PENSION?",DIFLD=.36235
+ S DE(DW)="C9^A1CKC11"
+ 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"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C9 G C9S:$D(DE(9))[0 K DB
+ S X=DE(9),DIC=DIE
  X ^DD(2,.36235,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,1,2.4)
- S X=DE(19),DIC=DIE
+ S X=DE(9),DIC=DIE
  S DFN=DA D EN^DGMTCOR K DGMTCOR
- S X=DE(19),DIC=DIE
+ S X=DE(9),DIC=DIE
  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,3,2.4)
- S X=DE(19),DIC=DIE
+ S X=DE(9),DIC=DIE
  D AUTOUPD^DGENA2(DA)
+C9S S X="" G:DG(DQ)=X C9F1 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(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,1,1.4)
+ 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^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,3,1.4)
+ S X=DG(DQ),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+C9F1 Q
+X9 S DFN=DA D MV^DGLOCK
+ Q
+ ;
+10 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=10 D X10 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X10 S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
+ Q
+11 S DQ=12 ;@300
+12 D:$D(DG)>9 F^DIE17,DE S DQ=12,DW=".362;12",DV="SX",DU="",DLB="RECEIVING A&A BENEFITS?",DIFLD=.36205
+ S DE(DW)="C12^A1CKC11"
+ 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"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C12 G C12S:$D(DE(12))[0 K DB
+ S X=DE(12),DIC=DIE
+ X ^DD(2,.36205,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,1,2.4)
+ S X=DE(12),DIC=DIE
+ S DFN=DA D EN^DGMTCOR K DGMTCOR
+ S X=DE(12),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,3,2.4)
+ S X=DE(12),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+C12S S X="" G:DG(DQ)=X C12F1 K DB
+ D ^A1CKC13
+C12F1 Q
+X12 S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK
+ Q
+ ;
+13 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=13 D X13 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X13 S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
+ Q
+14 S DQ=15 ;@400
+15 D:$D(DG)>9 F^DIE17,DE S DQ=15,DW=".362;13",DV="SX",DU="",DLB="RECEIVING HOUSEBOUND BENEFITS?",DIFLD=.36215
+ S DE(DW)="C15^A1CKC11"
+ 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"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C15 G C15S:$D(DE(15))[0 K DB
+ D ^A1CKC14
+C15S S X="" G:DG(DQ)=X C15F1 K DB
+ D ^A1CKC15
+C15F1 Q
+X15 S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK
+ Q
+ ;
+16 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=16 D X16 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X16 S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
+ Q
+17 S DQ=18 ;@999
+18 G 0^DIE17
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC12.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC12.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC12.m	(revision 623)
@@ -1,9 +1,143 @@
-A1CKC12 ; ;12/13/08
- 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(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,1,1.4)
- 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^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,3,1.4)
- S X=DG(DQ),DIC=DIE
- D AUTOUPD^DGENA2(DA)
+A1CKC12 ; ;04/21/06
+ D DE G BEGIN
+DE S DIE="^DPT(D0,.372,",DIC=DIE,DP=2.04,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$O(^DPT(D0,.372,DA,""))=""
+ I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,1) S:%]"" DE(1)=% S %=$P(%Z,U,2) S:%]"" DE(2)=% S %=$P(%Z,U,3) S:%]"" DE(3)=%
+ 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 "  (No Editing)" Q
+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 NKEY:$D(^DD("KEY","F",DP,DIFLD)),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=^(DLB) I DV'["D",DV'["S" W "  "_X
+T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
+ K DDER G X
+P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) G:DV["*" AST^DIED D NOSCR^DIED S X=+Y,DIC=DIE G X:X<0
+ 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,99)["+X'=X" S X=+X
+V D @("X"_DQ) K YS
+Z K DIC("S"),DLAYGO I $D(X),X'=U D:$G(DE(DW,"INDEX")) SAVEVALS G:'$$KEYCHK UNIQFERR^DIE17 S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A
+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))," ",2,99) Q
+Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
+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(^(Y,0)) S Y=$P(^(0),U),X=$P(^DD(X,.01,0),U,3),DG=$P(^(0),U,2) G R
+ I DG["V",+Y,$P(Y,";",2)["(",$D(@(U_$P(Y,";",2)_"0)")) S X=+$P(^(0),U,2) G RP:'$D(^(+Y,0)) S Y=$P(^(0),U) I $D(^DD(+X,.01,0)) S DG=$P(^(0),U,2),X=$P(^(0),U,3) G R
+ X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" 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")=1
+ I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
+ D ^DIR I 'DDER S %=Y(0),X=Y
+ Q
+SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$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 QS
+KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
+BEGIN S DNM="A1CKC12",DQ=1+D G B
+1 S DW="0;1",DV="MP31'X",DU="",DLB="RATED DISABILITIES (VA)",DIFLD=.01
+ S DE(DW)="C1^A1CKC12",DE(DW,"INDEX")=1
+ 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"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C1 G C1S:$D(DE(1))[0 K DB
+C1S S X="" G:DG(DQ)=X C1F1 K DB
+C1F1 N X,X1,X2 S DIXR=411 D C1X1(U) K X2 M X2=X D C1X1("O") K X1 M X1=X
+ D
+ . N DIEXARR M DIEXARR=X S DIEZCOND=1
+ . I (X1(1)'=X2(1))!(X1(2)'=X2(2))!(X1(3)'=X2(3))
+ . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
+ . S DGRDCHG=1
+ K X M X=X2 D
+ . N DIEXARR M DIEXARR=X S DIEZCOND=1
+ . I (X1(1)'=X2(1))!(X1(2)'=X2(2))!(X1(3)'=X2(3))
+ . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
+ . S DGRDCHG=1
+ G C1F2
+C1X1(DION) K X
+ S X(1)=$G(@DIEZTMP@("V",2.04,DIIENS,.01,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,1))
+ S X(2)=$G(@DIEZTMP@("V",2.04,DIIENS,2,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,2))
+ S X(3)=$G(@DIEZTMP@("V",2.04,DIIENS,3,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,3))
+ S X=$G(X(1))
+ Q
+C1F2 Q
+X1 I $D(X) D EK^DGLOCK Q
+ Q
+ ;
+2 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW="0;2",DV="RNJ3,0X",DU="",DLB="DISABILITY %",DIFLD=2
+ S DE(DW)="C2^A1CKC12",DE(DW,"INDEX")=1
+ 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"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C2 G C2S:$D(DE(2))[0 K DB
+C2S S X="" G:DG(DQ)=X C2F1 K DB
+C2F1 N X,X1,X2 S DIXR=411 D C2X1(U) K X2 M X2=X D C2X1("O") K X1 M X1=X
+ D
+ . N DIEXARR M DIEXARR=X S DIEZCOND=1
+ . I (X1(1)'=X2(1))!(X1(2)'=X2(2))!(X1(3)'=X2(3))
+ . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
+ . S DGRDCHG=1
+ K X M X=X2 D
+ . N DIEXARR M DIEXARR=X S DIEZCOND=1
+ . I (X1(1)'=X2(1))!(X1(2)'=X2(2))!(X1(3)'=X2(3))
+ . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
+ . S DGRDCHG=1
+ G C2F2
+C2X1(DION) K X
+ S X(1)=$G(@DIEZTMP@("V",2.04,DIIENS,.01,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,1))
+ S X(2)=$G(@DIEZTMP@("V",2.04,DIIENS,2,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,2))
+ S X(3)=$G(@DIEZTMP@("V",2.04,DIIENS,3,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,3))
+ S X=$G(X(1))
+ Q
+C2F2 Q
+X2 K:+X'=X!(X>100)!(X<0)!(X?.E1"."1N.N) X I $D(X) D EK^DGLOCK
+ Q
+ ;
+3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW="0;3",DV="SX",DU="",DLB="SERVICE CONNECTED",DIFLD=3
+ S DE(DW)="C3^A1CKC12",DE(DW,"INDEX")=1
+ 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"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C3 G C3S:$D(DE(3))[0 K DB
+C3S S X="" G:DG(DQ)=X C3F1 K DB
+C3F1 N X,X1,X2 S DIXR=411 D C3X1(U) K X2 M X2=X D C3X1("O") K X1 M X1=X
+ D
+ . N DIEXARR M DIEXARR=X S DIEZCOND=1
+ . I (X1(1)'=X2(1))!(X1(2)'=X2(2))!(X1(3)'=X2(3))
+ . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
+ . S DGRDCHG=1
+ K X M X=X2 D
+ . N DIEXARR M DIEXARR=X S DIEZCOND=1
+ . I (X1(1)'=X2(1))!(X1(2)'=X2(2))!(X1(3)'=X2(3))
+ . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
+ . S DGRDCHG=1
+ G C3F2
+C3X1(DION) K X
+ S X(1)=$G(@DIEZTMP@("V",2.04,DIIENS,.01,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,1))
+ S X(2)=$G(@DIEZTMP@("V",2.04,DIIENS,2,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,2))
+ S X(3)=$G(@DIEZTMP@("V",2.04,DIIENS,3,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,3))
+ S X=$G(X(1))
+ Q
+C3F2 Q
+X3 S DFN=DA(1) D:X SC^DGLOCK1 I $D(X) D EK^DGLOCK 
+ Q
+ ;
+4 G 1^DIE17
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC13.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC13.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC13.m	(revision 623)
@@ -1,9 +1,9 @@
-A1CKC13 ; ;12/13/08
- S X=DE(22),DIC=DIE
- X ^DD(2,.36205,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,1,2.4)
- S X=DE(22),DIC=DIE
+A1CKC13 ; ;04/21/06
+ 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(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,1,1.4)
+ S X=DG(DQ),DIC=DIE
  S DFN=DA D EN^DGMTCOR K DGMTCOR
- S X=DE(22),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,3,2.4)
- S X=DE(22),DIC=DIE
+ S X=DG(DQ),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,3,1.4)
+ S X=DG(DQ),DIC=DIE
  D AUTOUPD^DGENA2(DA)
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC14.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC14.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC14.m	(revision 623)
@@ -1,9 +1,9 @@
-A1CKC14 ; ;12/13/08
- 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(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,1,1.4)
- S X=DG(DQ),DIC=DIE
+A1CKC14 ; ;04/21/06
+ S X=DE(15),DIC=DIE
+ X ^DD(2,.36215,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,1,2.4)
+ S X=DE(15),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^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,3,1.4)
- S X=DG(DQ),DIC=DIE
+ S X=DE(15),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,3,2.4)
+ S X=DE(15),DIC=DIE
  D AUTOUPD^DGENA2(DA)
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC15.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC15.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC15.m	(revision 623)
@@ -1,70 +1,3 @@
-A1CKC15 ; ;12/13/08
- D DE G BEGIN
-DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
- I $D(^(.362)) S %Z=^(.362) S %=$P(%Z,U,13) S:%]"" DE(1)=%
- 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 "  (No Editing)" Q
-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 NKEY:$D(^DD("KEY","F",DP,DIFLD)),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=^(DLB) I DV'["D",DV'["S" W "  "_X
-T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
- K DDER G X
-P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) G:DV["*" AST^DIED D NOSCR^DIED S X=+Y,DIC=DIE G X:X<0
- 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,99)["+X'=X" S X=+X
-V D @("X"_DQ) K YS
-Z K DIC("S"),DLAYGO I $D(X),X'=U D:$G(DE(DW,"INDEX")) SAVEVALS G:'$$KEYCHK UNIQFERR^DIE17 S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A
-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))," ",2,99) Q
-Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
-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(^(Y,0)) S Y=$P(^(0),U),X=$P(^DD(X,.01,0),U,3),DG=$P(^(0),U,2) G R
- I DG["V",+Y,$P(Y,";",2)["(",$D(@(U_$P(Y,";",2)_"0)")) S X=+$P(^(0),U,2) G RP:'$D(^(+Y,0)) S Y=$P(^(0),U) I $D(^DD(+X,.01,0)) S DG=$P(^(0),U,2),X=$P(^(0),U,3) G R
- X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" 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")=1
- I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
- D ^DIR I 'DDER S %=Y(0),X=Y
- Q
-SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$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 QS
-KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
-BEGIN S DNM="A1CKC15",DQ=1
-1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".362;13",DV="SX",DU="",DLB="RECEIVING HOUSEBOUND BENEFITS?",DIFLD=.36215
- S DE(DW)="C1^A1CKC15"
- 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"!(DV["#") D E^DIE0 G A:'$D(X)
- 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(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,1,2.4)
- 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^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,3,2.4)
- S X=DE(1),DIC=DIE
- D AUTOUPD^DGENA2(DA)
-C1S S X="" G:DG(DQ)=X C1F1 K DB
+A1CKC15 ; ;04/21/06
  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(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,1,1.4)
@@ -75,11 +8,2 @@
  S X=DG(DQ),DIC=DIE
  D AUTOUPD^DGENA2(DA)
-C1F1 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 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X2 S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
- Q
-3 S DQ=4 ;@999
-4 G 0^DIE17
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC2.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC2.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC2.m	(revision 623)
@@ -1,14 +1,4 @@
-A1CKC2 ; ;12/13/08
+A1CKC2 ; ;04/21/06
  S X=DG(DQ),DIC=DIE
- S DFN=DA D EN^DGMTCOR K DGMTCOR
- S X=DG(DQ),DIC=DIE
- S DFN=DA D EN^DGRP7CC
- 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(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X=DIV S X="N" X ^DD(2,1901,1,3,1.4)
- 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^VAFCDD01(DA)
- S X=DG(DQ),DIC=DIE
- D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- I $D(DE(10))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF="391;" D AVAFC^VAFCDD01(DA)
+ I $D(DE(7))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC3.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC3.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC3.m	(revision 623)
@@ -1,12 +1,245 @@
-A1CKC3 ; ;12/13/08
- S X=DE(11),DIC=DIE
- ;
- S X=DE(11),DIC=DIE
- ;
- S X=DE(11),DIC=DIE
- D AUTOUPD^DGENA2(DA)
- S X=DE(11),DIC=DIE
+A1CKC3 ; ;04/21/06
+ D DE G BEGIN
+DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
+ I $D(^(.3)) S %Z=^(.3) S %=$P(%Z,U,1) S:%]"" DE(2)=%
+ I $D(^(.36)) S %Z=^(.36) S %=$P(%Z,U,1) S:%]"" DE(6)=%
+ I $D(^(.362)) S %Z=^(.362) S %=$P(%Z,U,12) S:%]"" DE(4)=% S %=$P(%Z,U,13) S:%]"" DE(5)=% S %=$P(%Z,U,14) S:%]"" DE(3)=%
+ I $D(^("TYPE")) S %Z=^("TYPE") S %=$P(%Z,U,1) S:%]"" DE(7)=%
+ I $D(^("VET")) S %Z=^("VET") S %=$P(%Z,U,1) S:%]"" DE(1)=%
+ 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 "  (No Editing)" Q
+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 NKEY:$D(^DD("KEY","F",DP,DIFLD)),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=^(DLB) I DV'["D",DV'["S" W "  "_X
+T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
+ K DDER G X
+P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) G:DV["*" AST^DIED D NOSCR^DIED S X=+Y,DIC=DIE G X:X<0
+ 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,99)["+X'=X" S X=+X
+V D @("X"_DQ) K YS
+Z K DIC("S"),DLAYGO I $D(X),X'=U D:$G(DE(DW,"INDEX")) SAVEVALS G:'$$KEYCHK UNIQFERR^DIE17 S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A
+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))," ",2,99) Q
+Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
+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(^(Y,0)) S Y=$P(^(0),U),X=$P(^DD(X,.01,0),U,3),DG=$P(^(0),U,2) G R
+ I DG["V",+Y,$P(Y,";",2)["(",$D(@(U_$P(Y,";",2)_"0)")) S X=+$P(^(0),U,2) G RP:'$D(^(+Y,0)) S Y=$P(^(0),U) I $D(^DD(+X,.01,0)) S DG=$P(^(0),U,2),X=$P(^(0),U,3) G R
+ X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" 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")=1
+ I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
+ D ^DIR I 'DDER S %=Y(0),X=Y
+ Q
+SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$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 QS
+KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
+BEGIN S DNM="A1CKC3",DQ=1
+1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW="VET;1",DV="RSXa",DU="",DLB="VETERAN (Y/N)?",DIFLD=1901
+ S DE(DW)="C1^A1CKC3"
+ 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"!(DV["#") D E^DIE0 G A:'$D(X)
+ 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^VAFCDD01(DA)
+ 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
+ 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(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X=DIV S X="N" X ^DD(2,1901,1,3,1.4)
+ 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^VAFCDD01(DA)
+ 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),DIIX=3_U_DIFLD D AUDIT^DIET
+C1F1 Q
+X1 I $D(X) S:'$D(DPTX) DFN=DA D:'$D(^XUSEC("DG ELIGIBILITY",DUZ)) VAGE^DGLOCK:X="Y" I $D(X) D:$D(DFN) EV^DGLOCK
+ Q
+ ;
+2 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW=".3;1",DV="RSXa",DU="",DLB="SERVICE CONNECTED?",DIFLD=.301
+ S DE(DW)="C2^A1CKC3"
+ 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"!(DV["#") D E^DIE0 G A:'$D(X)
+ 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^VAFCDD01(DA)
- S X=DE(11),DIC=DIE
- D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- S X=DE(11),DIIX=2_U_DIFLD D AUDIT^DIET
+ S X=DE(2),DIC=DIE
+ D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
+ S X=DE(2),DIIX=2_U_DIFLD D AUDIT^DIET
+C2S S X="" G:DG(DQ)=X C2F1 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(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(2,.301,1,1,1.4)
+ 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(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y S X="" X ^DD(2,.301,1,2,1.4)
+ 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^VAFCDD01(DA)
+ S X=DG(DQ),DIC=DIE
+ D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
+ I $D(DE(2))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+C2F1 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="",DLB="RECEIVING A VA PENSION?",DIFLD=.36235
+ S DE(DW)="C3^A1CKC3"
+ 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"!(DV["#") D E^DIE0 G A:'$D(X)
+ 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(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,1,2.4)
+ 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^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,3,2.4)
+ 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,.36235,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,1,1.4)
+ 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^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,3,1.4)
+ S X=DG(DQ),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+C3F1 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="",DLB="RECEIVING A&A BENEFITS?",DIFLD=.36205
+ S DE(DW)="C4^A1CKC3"
+ 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"!(DV["#") D E^DIE0 G A:'$D(X)
+ 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(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,1,2.4)
+ 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^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,3,2.4)
+ S X=DE(4),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+C4S S X="" G:DG(DQ)=X C4F1 K DB
+ D ^A1CKC4
+C4F1 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="",DLB="RECEIVING HOUSEBOUND BENEFITS?",DIFLD=.36215
+ S DE(DW)="C5^A1CKC3"
+ 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"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C5 G C5S:$D(DE(5))[0 K DB
+ D ^A1CKC5
+C5S S X="" G:DG(DQ)=X C5F1 K DB
+ D ^A1CKC6
+C5F1 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,DE S DQ=6,DW=".36;1",DV="*P8'Xa",DU="",DLB="PRIMARY ELIGIBILITY CODE",DIFLD=.361
+ S DE(DW)="C6^A1CKC3"
+ 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"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C6 G C6S:$D(DE(6))[0 K DB
+ D ^A1CKC7
+C6S S X="" G:DG(DQ)=X C6F1 K DB
+ D ^A1CKC8
+C6F1 Q
+X6 S DFN=DA D EV^DGLOCK I $D(X) D ECD^DGLOCK1
+ Q
+ ;
+7 D:$D(DG)>9 F^DIE17,DE S DQ=7,DW="TYPE;1",DV="RP391'a",DU="",DLB="TYPE",DIFLD=391
+ S DE(DW)="C7^A1CKC3",DE(DW,"INDEX")=1
+ 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"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C7 G C7S:$D(DE(7))[0 K DB
+ D ^A1CKC9
+C7S S X="" G:DG(DQ)=X C7F1 K DB
+ D ^A1CKC10
+C7F1 N X,X1,X2 S DIXR=664 D C7X1(U) K X2 M X2=X D C7X1("O") K X1 M X1=X
+ I $G(X(1))]"" D
+ . K ^DPT("APTYPE",X,DA)
+ K X M X=X2 I $G(X(1))]"" D
+ . S ^DPT("APTYPE",X,DA)=""
+ G C7F2
+C7X1(DION) K X
+ S X(1)=$G(@DIEZTMP@("V",2,DIIENS,391,DION),$P($G(^DPT(DA,"TYPE")),U,1))
+ S X=$G(X(1))
+ Q
+C7F2 Q
+X7 Q
+8 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=8 D X8 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X8 S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
+ Q
+9 S DQ=10 ;@30
+10 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=10 D X10 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X10 I 'SCI S Y="@39"
+ Q
+11 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=11 D X11 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X11 S ISC=0
+ Q
+12 S DQ=13 ;@31
+13 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=13 D X13 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X13 S ISC=$O(SCI(ISC))
+ Q
+14 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=14 D X14 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X14 I 'ISC S Y="@39"
+ Q
+15 D:$D(DG)>9 F^DIE17 G ^A1CKC11
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC4.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC4.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC4.m	(revision 623)
@@ -1,12 +1,9 @@
-A1CKC4 ; ;12/13/08
+A1CKC4 ; ;04/21/06
  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(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(2,.301,1,1,1.4)
+ X ^DD(2,.36205,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,1,1.4)
  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(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y S X="" X ^DD(2,.301,1,2,1.4)
+ 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^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,3,1.4)
  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^VAFCDD01(DA)
- S X=DG(DQ),DIC=DIE
- D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- I $D(DE(11))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC5.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC5.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC5.m	(revision 623)
@@ -1,9 +1,9 @@
-A1CKC5 ; ;12/13/08
- S X=DE(12),DIC=DIE
- X ^DD(2,.36235,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,1,2.4)
- S X=DE(12),DIC=DIE
+A1CKC5 ; ;04/21/06
+ 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(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,1,2.4)
+ S X=DE(5),DIC=DIE
  S DFN=DA D EN^DGMTCOR K DGMTCOR
- S X=DE(12),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,3,2.4)
- S X=DE(12),DIC=DIE
+ S X=DE(5),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,3,2.4)
+ S X=DE(5),DIC=DIE
  D AUTOUPD^DGENA2(DA)
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC6.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC6.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC6.m	(revision 623)
@@ -1,9 +1,9 @@
-A1CKC6 ; ;12/13/08
+A1CKC6 ; ;04/21/06
  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(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,1,1.4)
+ X ^DD(2,.36215,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,1,1.4)
  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^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,3,1.4)
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,3,1.4)
  S X=DG(DQ),DIC=DIE
  D AUTOUPD^DGENA2(DA)
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC7.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC7.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC7.m	(revision 623)
@@ -1,9 +1,12 @@
-A1CKC7 ; ;12/13/08
- S X=DE(13),DIC=DIE
- X ^DD(2,.36205,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,1,2.4)
- S X=DE(13),DIC=DIE
- S DFN=DA D EN^DGMTCOR K DGMTCOR
- S X=DE(13),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,3,2.4)
- S X=DE(13),DIC=DIE
+A1CKC7 ; ;04/21/06
+ S X=DE(6),DIC=DIE
+ ;
+ S X=DE(6),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(2,.361,1,2,2.2) I DIV(1)>0 S DIK(0)=DA,DIK="^DPT(DIV(0),""E"",",DA(1)=DIV(0),DA=DIV(1) D ^DIK S DA=DIK(0) K DIK
+ S X=DE(6),DIC=DIE
+ X "I $S('$D(^DIC(8,+X,0)):0,$P(^(0),""^"",1)[""DOM"":0,'$D(^DPT(DA,.36)):1,'$D(^DIC(8,+^(.36),0)):1,$P(^(0),""^"",1)'[""DOM"":1,1:0) S DGXRF=.361 D ^DGDDC Q"
+ S X=DE(6),DIC=DIE
+ K ^DPT("AEL",DA,+X)
+ S X=DE(6),DIC=DIE
  D AUTOUPD^DGENA2(DA)
+ S X=DE(6),DIIX=2_U_DIFLD D AUDIT^DIET
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC8.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC8.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC8.m	(revision 623)
@@ -1,9 +1,12 @@
-A1CKC8 ; ;12/13/08
+A1CKC8 ; ;04/21/06
  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(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,1,1.4)
+ X "S DFN=DA D EN^DGMTR K DGREQF"
  S X=DG(DQ),DIC=DIE
- S DFN=DA D EN^DGMTCOR K DGMTCOR
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(2,.361,1,2,89.4) S Y(102)=$S($D(^DPT(D0,"E",D1,0)):^(0),1:"") S X=$S('$D(^DIC(8,+$P(Y(102),U,1),0)):"",1:$P(^(0),U,1)) S D0=I(0,0) S D1=I(1,0) S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(2,.361,1,2,1.4)
  S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,3,1.4)
+ ;
+ S X=DG(DQ),DIC=DIE
+ S ^DPT("AEL",DA,+X)=""
  S X=DG(DQ),DIC=DIE
  D AUTOUPD^DGENA2(DA)
+ I $D(DE(6))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC9.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC9.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/A1CKC9.m	(revision 623)
@@ -1,251 +1,4 @@
-A1CKC9 ; ;12/13/08
- D DE G BEGIN
-DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
- I $D(^(.3)) S %Z=^(.3) S %=$P(%Z,U,11) S:%]"" DE(16)=%
- I $D(^(.36)) S %Z=^(.36) S %=$P(%Z,U,1) S:%]"" DE(2)=%
- I $D(^(.362)) S %Z=^(.362) S %=$P(%Z,U,12) S:%]"" DE(22)=% S %=$P(%Z,U,13) S:%]"" DE(1)=% S %=$P(%Z,U,14) S:%]"" DE(19)=%
- I $D(^("TYPE")) S %Z=^("TYPE") S %=$P(%Z,U,1) S:%]"" DE(3)=%
- 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 "  (No Editing)" Q
-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 NKEY:$D(^DD("KEY","F",DP,DIFLD)),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=^(DLB) I DV'["D",DV'["S" W "  "_X
-T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
- K DDER G X
-P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) G:DV["*" AST^DIED D NOSCR^DIED S X=+Y,DIC=DIE G X:X<0
- 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,99)["+X'=X" S X=+X
-V D @("X"_DQ) K YS
-Z K DIC("S"),DLAYGO I $D(X),X'=U D:$G(DE(DW,"INDEX")) SAVEVALS G:'$$KEYCHK UNIQFERR^DIE17 S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A
-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))," ",2,99) Q
-Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
-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(^(Y,0)) S Y=$P(^(0),U),X=$P(^DD(X,.01,0),U,3),DG=$P(^(0),U,2) G R
- I DG["V",+Y,$P(Y,";",2)["(",$D(@(U_$P(Y,";",2)_"0)")) S X=+$P(^(0),U,2) G RP:'$D(^(+Y,0)) S Y=$P(^(0),U) I $D(^DD(+X,.01,0)) S DG=$P(^(0),U,2),X=$P(^(0),U,3) G R
- X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" 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")=1
- I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
- D ^DIR I 'DDER S %=Y(0),X=Y
- Q
-SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$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 QS
-KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
-BEGIN S DNM="A1CKC9",DQ=1
-1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".362;13",DV="SX",DU="",DLB="RECEIVING HOUSEBOUND BENEFITS?",DIFLD=.36215
- S DE(DW)="C1^A1CKC9"
- 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"!(DV["#") D E^DIE0 G A:'$D(X)
- 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(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,1,2.4)
- 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^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,3,2.4)
- S X=DE(1),DIC=DIE
- D AUTOUPD^DGENA2(DA)
-C1S S X="" G:DG(DQ)=X C1F1 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(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,1,1.4)
- 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^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,3,1.4)
- S X=DG(DQ),DIC=DIE
- D AUTOUPD^DGENA2(DA)
-C1F1 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 DQ=2,DW=".36;1",DV="*P8'Xa",DU="",DLB="PRIMARY ELIGIBILITY CODE",DIFLD=.361
- S DE(DW)="C2^A1CKC9"
- 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"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C2 G C2S:$D(DE(2))[0 K DB
- S X=DE(2),DIC=DIE
- ;
- S X=DE(2),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(2,.361,1,2,2.2) I DIV(1)>0 S DIK(0)=DA,DIK="^DPT(DIV(0),""E"",",DA(1)=DIV(0),DA=DIV(1) D ^DIK S DA=DIK(0) K DIK
- S X=DE(2),DIC=DIE
- X "I $S('$D(^DIC(8,+X,0)):0,$P(^(0),""^"",1)[""DOM"":0,'$D(^DPT(DA,.36)):1,'$D(^DIC(8,+^(.36),0)):1,$P(^(0),""^"",1)'[""DOM"":1,1:0) S DGXRF=.361 D ^DGDDC Q"
- S X=DE(2),DIC=DIE
- K ^DPT("AEL",DA,+X)
- S X=DE(2),DIC=DIE
- D AUTOUPD^DGENA2(DA)
- S X=DE(2),DIIX=2_U_DIFLD D AUDIT^DIET
-C2S S X="" G:DG(DQ)=X C2F1 K DB
- S X=DG(DQ),DIC=DIE
- X "S DFN=DA D EN^DGMTR K DGREQF"
- 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 Y(102)=$S($D(^DPT(D0,"E",D1,0)):^(0),1:"") S X=$S('$D(^DIC(8,+$P(Y(102),U,1),0)):"",1:$P(^(0),U,1)) S D0=I(0,0) S D1=I(1,0) S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(2,.361,1,2,1.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)
- I $D(DE(2))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
-C2F1 Q
-X2 S DFN=DA D EV^DGLOCK I $D(X) D ECD^DGLOCK1
- Q
- ;
-3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW="TYPE;1",DV="P391'a",DU="",DLB="TYPE",DIFLD=391
- S DE(DW)="C3^A1CKC9",DE(DW,"INDEX")=1
- 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"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C3 G C3S:$D(DE(3))[0 K DB
- S X=DE(3),DIC=DIE
+A1CKC9 ; ;04/21/06
+ S X=DE(7),DIC=DIE
  I ($T(AVAFC^VAFCDD01)'="") S VAFCF="391;" D AVAFC^VAFCDD01(DA)
- S X=DE(3),DIIX=2_U_DIFLD D AUDIT^DIET
-C3S S X="" G:DG(DQ)=X C3F1 K DB
- S X=DG(DQ),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF="391;" D AVAFC^VAFCDD01(DA)
- I $D(DE(3))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
-C3F1 N X,X1,X2 S DIXR=664 D C3X1(U) K X2 M X2=X D C3X1("O") K X1 M X1=X
- I $G(X(1))]"" D
- . K ^DPT("APTYPE",X,DA)
- K X M X=X2 I $G(X(1))]"" D
- . S ^DPT("APTYPE",X,DA)=""
- G C3F2
-C3X1(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2,DIIENS,391,DION),$P($G(^DPT(DA,"TYPE")),U,1))
- S X=$G(X(1))
- Q
-C3F2 Q
-X3 Q
-4 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=4 D X4 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X4 S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
- Q
-5 S DQ=6 ;@30
-6 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=6 D X6 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X6 I 'SCI S Y="@39"
- Q
-7 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=7 D X7 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X7 S ISC=0
- Q
-8 S DQ=9 ;@31
-9 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=9 D X9 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X9 S ISC=$O(SCI(ISC))
- Q
-10 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=10 D X10 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X10 I 'ISC S Y="@39"
- Q
-11 D:$D(DG)>9 F^DIE17,DE S DQ=11,D=0 K DE(1) ;.3721
- S DIFLD=.3721,DGO="^A1CKC10",DC="6^2.04P^.372^",DV="2.04MP31'X",DW="0;1",DOW="RATED DISABILITIES (VA)",DLB="Select "_DOW S:D DC=DC_D
- S DU="DIC(31,"
- G RE:D I $D(DSC(2.04))#2,$P(DSC(2.04),"I $D(^UTILITY(",1)="" X DSC(2.04) S D=$O(^(0)) S:D="" D=-1 G M11
- S D=$S($D(^DPT(DA,.372,0)):$P(^(0),U,3,4),$O(^(0))'="":$O(^(0)),1:-1)
-M11 I D>0 S DC=DC_D I $D(^DPT(DA,.372,+D,0)) S DE(11)=$P(^(0),U,1)
- S X="`"_ISC
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-R11 D DE
- G A
- ;
-12 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=12 D X12 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X12 S Y="@31"
- Q
-13 S DQ=14 ;@39
-14 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=14 D X14 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X14 S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
- Q
-15 S DQ=16 ;@100
-16 S DW=".3;11",DV="SX",DU="",DLB="RECEIVING VA DISABILITY?",DIFLD=.3025
- S DE(DW)="C16^A1CKC9"
- 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"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C16 G C16S:$D(DE(16))[0 K DB
- S X=DE(16),DIC=DIE
- X ^DD(2,.3025,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(2,.3025,1,1,2.4)
- S X=DE(16),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.3025,1,2,2.4)
- S X=DE(16),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C16S S X="" G:DG(DQ)=X C16F1 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(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(2,.3025,1,1,1.4)
- S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.3025,1,2,1.4)
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C16F1 Q
-X16 S DFN=DA D MV^DGLOCK I $D(X),X="Y" D EC^DGLOCK1
- Q
- ;
-17 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=17 D X17 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X17 S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
- Q
-18 S DQ=19 ;@200
-19 D:$D(DG)>9 F^DIE17,DE S DQ=19,DW=".362;14",DV="SX",DU="",DLB="RECEIVING A VA PENSION?",DIFLD=.36235
- S DE(DW)="C19^A1CKC9"
- 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"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C19 G C19S:$D(DE(19))[0 K DB
- D ^A1CKC11
-C19S S X="" G:DG(DQ)=X C19F1 K DB
- D ^A1CKC12
-C19F1 Q
-X19 S DFN=DA D MV^DGLOCK
- Q
- ;
-20 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=20 D X20 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X20 S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
- Q
-21 S DQ=22 ;@300
-22 D:$D(DG)>9 F^DIE17,DE S DQ=22,DW=".362;12",DV="SX",DU="",DLB="RECEIVING A&A BENEFITS?",DIFLD=.36205
- S DE(DW)="C22^A1CKC9"
- 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"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C22 G C22S:$D(DE(22))[0 K DB
- D ^A1CKC13
-C22S S X="" G:DG(DQ)=X C22F1 K DB
- D ^A1CKC14
-C22F1 Q
-X22 S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK
- Q
- ;
-23 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=23 D X23 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X23 S Y=$P(STR,"^"),STR=$P(STR,"^",2,99)
- Q
-24 S DQ=25 ;@400
-25 D:$D(DG)>9 F^DIE17 G ^A1CKC15
+ S X=DE(7),DIIX=2_U_DIFLD D AUDIT^DIET
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGADTP2.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGADTP2.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGADTP2.m	(revision 623)
@@ -1,116 +1,115 @@
-RGADTP2	;BIR/DLR-ADT PROCESSOR TO RETRIGGER A08 or A04 MESSAGES WITH AL/AL (COMMIT/APPLICATION) ACKNOWLEDGEMENTS - CONTINUED ;10/30/02  10:04
-	;;1.0;CLINICAL INFO RESOURCE NETWORK;**27,20,45,44,47,48,49,52**;30 Apr 99;Build 2
-DBIA	;
-	;Reference to $$ADD^VAFCEHU1 supported by IA #2753
-	;Reference to EDIT^VAFCPTED supported by IA #2784
-	Q
-PROCIN(ARRAY,RGLOCAL,RGER,DFN,HL)	;
-	N RGRSDFN,OTHSITE,NODE,ICN,CMORIEN,CMOR,CMORDISP,SENSTVTY,RMTDOD,LOCDOD,VAFCA,VAFCA08,HERE,BOGUS,ARAY,REP
-	S REP=$E(HL("ECH"),2)
-	S HERE=$P($$SITE^VASITE,"^",3)
-	;if sending site is your site quit
-	Q:$G(ARRAY("MPISSITE"))=$G(HERE)
-	S ARRAY(.097)=$P($$NOW^XLFDT,".")
-	I $G(ARRAY("ICN"))'="" D
-	.S RGRSDFN=$$GETDFN^MPIF001(+ARRAY("ICN")) I +RGRSDFN<1 S RGER=RGRSDFN_" ICN#"_$G(ARRAY("ICN")) Q  ;quit and return error msg
-	.S OTHSITE=ARRAY("SENDING SITE") ;**40 REMOVED THE PLUS TO KEEP SUFFIX ON STATION# & CHANGED THE SITE TO BE SENDING SITE INSTEAD OF AUTHORITATIVE SOURCE
-	I $G(RGRSDFN)="" S RGRSDFN=$G(DFN)
-	I $G(RGRSDFN)="" S RGER="-1^DFN not defined"
-	Q:$G(RGER)
-	I $G(OTHSITE)="" S OTHSITE=""
-	S NODE=$$MPINODE^MPIFAPI(RGRSDFN)
-	S ICN=$P(NODE,"^")
-	S CMORIEN=$P(NODE,"^",3)
-	S CMOR=$$NS^XUAF4(CMORIEN)
-	S CMORDISP=$P(CMOR,"^",1)
-	S CMOR=$P(CMOR,"^",2)
-	;
-	;If patient is Sensitive at other site but not here send bulletin
-	I $G(ARRAY("SENSITIVITY"))'="" S SENSTVTY=$G(ARRAY("SENSITIVITY")) D
-	.N NAME S NAME=ARRAY("NAME")
-	.I '$$SENSTIVE^RGRSENS(RGRSDFN),SENSTVTY D
-	..S ARAY("SSN")=ARRAY("SSN"),ARAY("SENDING SITE")=ARRAY("SENDING SITE")
-	..S ARAY("SENSITIVITY USER")=ARRAY("SENSITIVITY USER"),ARAY("SENSITIVITY DATE")=ARRAY("SENSITIVITY DATE")
-	..D SENSTIVE^RGRSBUL1(RGRSDFN,"ARAY",NAME)
-	;
-	;MPIC_772 - **52; Commented out Remote Date of Death Indicated section.
-	;If patient has DATE OF DEATH (DOD) at remote site send bulletin
-	;Ignore time if present with date.
-	;S RMTDOD=$G(ARRAY("MPIDOD")),RMTDOD=$P(RMTDOD,".")
-	;S DFN=RGRSDFN D DEM^VADPT
-	;S LOCDOD=$P($P(VADM(6),"^"),".")
-	;If there is a remote DOD but no local DOD  OR if remote DOD is different from local DOD, send bulletin
-	;I RMTDOD D
-	;.N NAME S NAME=ARRAY("NAME"),ARAY("SSN")=ARRAY("SSN"),ARAY("SENDING SITE")=ARRAY("SENDING SITE")
-	;.D RMTDOD^RGRSBUL1(RGRSDFN,"ARAY",NAME,RMTDOD,LOCDOD)
-	;K VADM
-	;
-NOTLOC	I 'RGLOCAL D
-	.;if sending site is not the CMOR AND NOT THE MPI - log update into PDR if differences exist **45 ADDED MPI
-	.I (OTHSITE)'=(CMOR)&(OTHSITE'="200M") D  Q
-	..S VAFCA=$P($$NOW^XLFDT,".")_"^"_$$NOW^XLFDT_"^"_$G(ARRAY("SENDING SITE"))_"^"_RGRSDFN
-	..S ARRAY(.01)=$$FREE^RGRSPARS(ARRAY("NAME")),ARRAY(.03)=$$FREE^RGRSPARS($G(ARRAY("MPIDOB")))
-	..S ARRAY(.09)=$$FREE^RGRSPARS($G(ARRAY("SSN"))),ARRAY(.02)=$$SEX^RGRSPARS($G(ARRAY("SEX")))
-	..S ARRAY(.2403)=$$FREE^RGRSPARS($G(ARRAY("MMN"))),ARRAY(991.01)=$P($G(ARRAY("ICN")),"V")
-	..N ARAY M ARAY(2)=ARRAY
-	..S VAFCA08=1  ;S BOGUS=$$ADD^VAFCEHU1(VAFCA,"ARAY") comment out by RG*1*49
-	.;if sending site is the CMOR OR MPI - synchronize data **45 ADDED MPI AND SSNV TO UPDATED FIELDS
-	.I (OTHSITE)=(CMOR)!(OTHSITE="200M") D
-	..;**44 is there an outstanding edit in the ADT/HL7 PIVOT file for this patient for an identity element
-	..S RGER=$$CHKPVT^RGADTP3(.ARRAY) Q:+RGER<0
-	..N DR,ARAY2 S RGER=""
-	..D DIFF^RGADTP3(.ARRAY,RGRSDFN,.DR,.ARRAY) ;**47
-	..I DR'="" D
-	...S VAFCA08=1,ARAY(2,.01)=ARRAY("NAME"),ARAY(2,.03)=$G(ARRAY("MPIDOB"))
-	...I ARRAY("SSN")'="" S ARAY(2,.09)=$G(ARRAY("SSN")) ;**45 only set SSN to update if it isn't null
-	...S ARAY(2,.02)=$G(ARRAY("SEX")),ARAY(2,.2403)=$G(ARRAY("MMN")),ARAY(2,994)=$G(ARRAY("MBI"))
-	...;**48 ONLY SET SSN VERIFICATION STATUS AND PSEUDO SSN REASON IF SSN UPDATE WAS SUCCESSFUL
-	...I $D(ARRAY("ALIAS")) M ARAY(2,1)=ARRAY("ALIAS") ;**48 ADD ALIAS TO MIX
-	...D EDIT^VAFCPTED(RGRSDFN,"ARAY(2)",DR)
-	...;check to see if edits were successful, if not set RGER="why it failed"
-	...N NAME,SSN,PDOB,SEX,MMN,OLDNAME,OLDHLNAM,OLDMMN,OLDHLMMN,HLNAME,HLMMN,SSNV,MBI
-	...S NAME=$$GET1^DIQ(2,+RGRSDFN_",",.01,"I"),PDOB=$$GET1^DIQ(2,+RGRSDFN_",",.03,"I")
-	...S SSN=$$GET1^DIQ(2,+RGRSDFN_",",.09,"I"),SEX=$$GET1^DIQ(2,+RGRSDFN_",",.02,"I")
-	...S MMN=$$GET1^DIQ(2,+RGRSDFN_",",.2403,"I"),MBI=$$GET1^DIQ(2,+RGRSDFN_",",994,"I")
-	...D STDNAME^XLFNAME(.NAME,"F",.OLDNAME) S HLNAME=ARRAY("NAME") D STDNAME^XLFNAME(.HLNAME,"F",.OLDHLNAM)
-	...I NAME'=$G(HLNAME) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Name field failure"
-	...I PDOB'=$G(ARRAY("MPIDOB")) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"DOB field failure"
-	...;**48
-	...I SSN["P" D
-	....;if pseudo SSN reason field has been added to the DD then attempt to set it
-	....N PS,ERROR,LABEL D FIELD^DID(2,.0906,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
-	.....S ARAY2(2,.0906)=$G(ARRAY(.0906)),DR=".0906;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
-	.....S PS=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
-	.....I PS=""&(ARAY2(2,.0906)="@") Q
-	.....I PS'=ARAY2(2,.0906) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Pseudo SSN Reason field failure"
-	.....I PS=ARAY2(2,.0906) D
-	......K ARAY2 N ERROR,LABEL D FIELD^DID(2,.0907,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
-	......S ARAY2(2,.0907)=$G(ARRAY(.0907)),DR=".0907;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
-	......S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
-	......S:$G(ARRAY(.0907))="@" ARRAY(.0907)="" I SSNV'=$G(ARRAY(.0907)) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN VERIFICATION field failure"
-	...I $G(ARRAY("SSN"))'="",SSN'=$G(ARRAY("SSN")) D
-	....I $G(ARRAY("SSN"))="P",SSN["P" Q  ;**47 NEEDED TO CREATE PSEUDO AND DID
-	....S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN field failure" ;**45 only check if SSN is sent isn't null
-	...I SSN=$G(ARRAY("SSN")) D
-	....;if SSN VERIFICATION STATUS field has been added to the DD then attempt to set it
-	....K ARAY2 N ERROR,LABEL D FIELD^DID(2,.0907,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
-	.....S ARAY2(2,.0907)=$G(ARRAY(.0907)) S DR=".0907;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
-	.....S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
-	.....S:$G(ARRAY(.0907))="@" ARRAY(.0907)="" I SSNV'=$G(ARRAY(.0907)) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN VERIFICATION field failure"
-	.....I SSNV'="" D
-	......N PS,ERROR,LABEL D FIELD^DID(2,.0906,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
-	......S ARAY2(2,.0906)=$G(ARRAY(.0906)) S DR=".0906;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
-	......S PS=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
-	......I PS=""&(ARAY2(2,.0906)="@") Q
-	......S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Pseudo SSN Reason field failure"
-	...I SEX'=$G(ARRAY("SEX")) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SEX field failure"
-	...D STDNAME^XLFNAME(.MMN,"F",.OLDMMN) S HLMMN=ARRAY("MMN") D STDNAME^XLFNAME(.HLMMN,"F",.OLDHLMMN)
-	...I MMN'=$G(HLMMN) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"MOTHER'S MAIDEN NAME field failure"
-	...;**REMOVED MBI FROM PATCH 45 PUT BACK IN **47
-	...I MBI'=$G(ARRAY("MBI")) D
-	....Q:MBI=""&($G(ARRAY("MBI"))="@")  ;**47 "" AND @ ARE THE SAME
-	....S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"MULTIPLE BIRTH INDICATOR field failure"
-	...;send the updated fields to the MPI to synch site with MPI
-	...I HL("ETN")'="A31" S ZTSAVE("DFN")="",ZTRTN="MPISYN^RGADTPC",ZTDESC="Sending Synchronized Patient Data to MPI...",ZTIO="RG QUEUE",ZTDTH=$H D ^%ZTLOAD
-	...;**45 ^ don't trigger A31 sync message if A31 was being processed-- ack to a31 will sync id elements on MPI
-	Q
+RGADTP2 ;BIR/DLR-ADT PROCESSOR TO RETRIGGER A08 or A04 MESSAGES WITH AL/AL (COMMIT/APPLICATION) ACKNOWLEDGEMENTS - CONTINUED ;10/30/02  10:04
+ ;;1.0;CLINICAL INFO RESOURCE NETWORK;**27,20,45,44,47,48**;30 Apr 99;Build 3
+DBIA ;
+ ;Reference to $$ADD^VAFCEHU1 supported by IA #2753
+ ;Reference to EDIT^VAFCPTED supported by IA #2784
+ Q
+PROCIN(ARRAY,RGLOCAL,RGER,DFN,HL) ;
+ N RGRSDFN,OTHSITE,NODE,ICN,CMORIEN,CMOR,CMORDISP,SENSTVTY,RMTDOD,LOCDOD,VAFCA,VAFCA08,HERE,BOGUS,ARAY,REP
+ S REP=$E(HL("ECH"),2)
+ S HERE=$P($$SITE^VASITE,"^",3)
+ ;if sending site is your site quit
+ Q:$G(ARRAY("MPISSITE"))=$G(HERE)
+ S ARRAY(.097)=$P($$NOW^XLFDT,".")
+ I $G(ARRAY("ICN"))'="" D
+ .S RGRSDFN=$$GETDFN^MPIF001(+ARRAY("ICN")) I +RGRSDFN<1 S RGER=RGRSDFN_" ICN#"_$G(ARRAY("ICN")) Q  ;quit and return error msg
+ .S OTHSITE=ARRAY("SENDING SITE") ;**40 REMOVED THE PLUS TO KEEP SUFFIX ON STATION# & CHANGED THE SITE TO BE SENDING SITE INSTEAD OF AUTHORITATIVE SOURCE
+ I $G(RGRSDFN)="" S RGRSDFN=$G(DFN)
+ I $G(RGRSDFN)="" S RGER="-1^DFN not defined"
+ Q:$G(RGER)
+ I $G(OTHSITE)="" S OTHSITE=""
+ S NODE=$$MPINODE^MPIFAPI(RGRSDFN)
+ S ICN=$P(NODE,"^")
+ S CMORIEN=$P(NODE,"^",3)
+ S CMOR=$$NS^XUAF4(CMORIEN)
+ S CMORDISP=$P(CMOR,"^",1)
+ S CMOR=$P(CMOR,"^",2)
+ ;
+ ;If patient is Sensitive at other site but not here send bulletin
+ I $G(ARRAY("SENSITIVITY"))'="" S SENSTVTY=$G(ARRAY("SENSITIVITY")) D
+ .N NAME S NAME=ARRAY("NAME")
+ .I '$$SENSTIVE^RGRSENS(RGRSDFN),SENSTVTY D
+ ..S ARAY("SSN")=ARRAY("SSN"),ARAY("SENDING SITE")=ARRAY("SENDING SITE")
+ ..S ARAY("SENSITIVITY USER")=ARRAY("SENSITIVITY USER"),ARAY("SENSITIVITY DATE")=ARRAY("SENSITIVITY DATE")
+ ..D SENSTIVE^RGRSBUL1(RGRSDFN,"ARAY",NAME)
+ ;
+ ;If patient has DATE OF DEATH (DOD) at remote site send bulletin
+ ;Ignore time if present with date.
+ S RMTDOD=$G(ARRAY("MPIDOD")),RMTDOD=$P(RMTDOD,".")
+ S DFN=RGRSDFN D DEM^VADPT
+ S LOCDOD=$P($P(VADM(6),"^"),".")
+ ;If there is a remote DOD but no local DOD  OR if remote DOD is different from local DOD, send bulletin
+ I RMTDOD D
+ .N NAME S NAME=ARRAY("NAME"),ARAY("SSN")=ARRAY("SSN"),ARAY("SENDING SITE")=ARRAY("SENDING SITE")
+ .D RMTDOD^RGRSBUL1(RGRSDFN,"ARAY",NAME,RMTDOD,LOCDOD)
+ K VADM
+ ;
+NOTLOC I 'RGLOCAL D
+ .;if sending site is not the CMOR AND NOT THE MPI - log update into PDR if differences exist **45 ADDED MPI
+ .I (OTHSITE)'=(CMOR)&(OTHSITE'="200M") D  Q
+ ..S VAFCA=$P($$NOW^XLFDT,".")_"^"_$$NOW^XLFDT_"^"_$G(ARRAY("SENDING SITE"))_"^"_RGRSDFN
+ ..S ARRAY(.01)=$$FREE^RGRSPARS(ARRAY("NAME")),ARRAY(.03)=$$FREE^RGRSPARS($G(ARRAY("MPIDOB")))
+ ..S ARRAY(.09)=$$FREE^RGRSPARS($G(ARRAY("SSN"))),ARRAY(.02)=$$SEX^RGRSPARS($G(ARRAY("SEX")))
+ ..S ARRAY(.2403)=$$FREE^RGRSPARS($G(ARRAY("MMN"))),ARRAY(991.01)=$P($G(ARRAY("ICN")),"V")
+ ..N ARAY M ARAY(2)=ARRAY
+ ..S VAFCA08=1 S BOGUS=$$ADD^VAFCEHU1(VAFCA,"ARAY")
+ .;if sending site is the CMOR OR MPI - synchronize data **45 ADDED MPI AND SSNV TO UPDATED FIELDS
+ .I (OTHSITE)=(CMOR)!(OTHSITE="200M") D
+ ..;**44 is there an outstanding edit in the ADT/HL7 PIVOT file for this patient for an identity element
+ ..S RGER=$$CHKPVT^RGADTP3(.ARRAY) Q:+RGER<0
+ ..N DR,ARAY2 S RGER=""
+ ..D DIFF^RGADTP3(.ARRAY,RGRSDFN,.DR,.ARRAY) ;**47
+ ..I DR'="" D
+ ...S VAFCA08=1,ARAY(2,.01)=ARRAY("NAME"),ARAY(2,.03)=$G(ARRAY("MPIDOB"))
+ ...I ARRAY("SSN")'="" S ARAY(2,.09)=$G(ARRAY("SSN")) ;**45 only set SSN to update if it isn't null
+ ...S ARAY(2,.02)=$G(ARRAY("SEX")),ARAY(2,.2403)=$G(ARRAY("MMN")),ARAY(2,994)=$G(ARRAY("MBI"))
+ ...;**48 ONLY SET SSN VERIFICATION STATUS AND PSEUDO SSN REASON IF SSN UPDATE WAS SUCCESSFUL
+ ...I $D(ARRAY("ALIAS")) M ARAY(2,1)=ARRAY("ALIAS") ;**48 ADD ALIAS TO MIX
+ ...D EDIT^VAFCPTED(RGRSDFN,"ARAY(2)",DR)
+ ...;check to see if edits were successful, if not set RGER="why it failed"
+ ...N NAME,SSN,PDOB,SEX,MMN,OLDNAME,OLDHLNAM,OLDMMN,OLDHLMMN,HLNAME,HLMMN,SSNV,MBI
+ ...S NAME=$$GET1^DIQ(2,+RGRSDFN_",",.01,"I"),PDOB=$$GET1^DIQ(2,+RGRSDFN_",",.03,"I")
+ ...S SSN=$$GET1^DIQ(2,+RGRSDFN_",",.09,"I"),SEX=$$GET1^DIQ(2,+RGRSDFN_",",.02,"I")
+ ...S MMN=$$GET1^DIQ(2,+RGRSDFN_",",.2403,"I"),MBI=$$GET1^DIQ(2,+RGRSDFN_",",994,"I")
+ ...D STDNAME^XLFNAME(.NAME,"F",.OLDNAME) S HLNAME=ARRAY("NAME") D STDNAME^XLFNAME(.HLNAME,"F",.OLDHLNAM)
+ ...I NAME'=$G(HLNAME) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Name field failure"
+ ...I PDOB'=$G(ARRAY("MPIDOB")) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"DOB field failure"
+ ...;**48
+ ...I SSN["P" D
+ ....;if pseudo SSN reason field has been added to the DD then attempt to set it
+ ....N PS,ERROR,LABEL D FIELD^DID(2,.0906,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
+ .....S ARAY2(2,.0906)=$G(ARRAY(.0906)),DR=".0906;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
+ .....S PS=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
+ .....I PS=""&(ARAY2(2,.0906)="@") Q
+ .....I PS'=ARAY2(2,.0906) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Pseudo SSN Reason field failure"
+ .....I PS=ARAY2(2,.0906) D
+ ......K ARAY2 N ERROR,LABEL D FIELD^DID(2,.0907,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
+ ......S ARAY2(2,.0907)=$G(ARRAY(.0907)),DR=".0907;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
+ ......S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
+ ......S:$G(ARRAY(.0907))="@" ARRAY(.0907)="" I SSNV'=$G(ARRAY(.0907)) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN VERIFICATION field failure"
+ ...I $G(ARRAY("SSN"))'="",SSN'=$G(ARRAY("SSN")) D
+ ....I $G(ARRAY("SSN"))="P",SSN["P" Q  ;**47 NEEDED TO CREATE PSEUDO AND DID
+ ....S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN field failure" ;**45 only check if SSN is sent isn't null
+ ...I SSN=$G(ARRAY("SSN")) D
+ ....;if SSN VERIFICATION STATUS field has been added to the DD then attempt to set it
+ ....K ARAY2 N ERROR,LABEL D FIELD^DID(2,.0907,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
+ .....S ARAY2(2,.0907)=$G(ARRAY(.0907)) S DR=".0907;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
+ .....S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
+ .....S:$G(ARRAY(.0907))="@" ARRAY(.0907)="" I SSNV'=$G(ARRAY(.0907)) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN VERIFICATION field failure"
+ .....I SSNV'="" D
+ ......N PS,ERROR,LABEL D FIELD^DID(2,.0906,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
+ ......S ARAY2(2,.0906)=$G(ARRAY(.0906)) S DR=".0906;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
+ ......S PS=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
+ ......I PS=""&(ARAY2(2,.0906)="@") Q
+ ......S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Pseudo SSN Reason field failure"
+ ...I SEX'=$G(ARRAY("SEX")) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SEX field failure"
+ ...D STDNAME^XLFNAME(.MMN,"F",.OLDMMN) S HLMMN=ARRAY("MMN") D STDNAME^XLFNAME(.HLMMN,"F",.OLDHLMMN)
+ ...I MMN'=$G(HLMMN) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"MOTHER'S MAIDEN NAME field failure"
+ ...;**REMOVED MBI FROM PATCH 45 PUT BACK IN **47
+ ...I MBI'=$G(ARRAY("MBI")) D
+ ....Q:MBI=""&($G(ARRAY("MBI"))="@")  ;**47 "" AND @ ARE THE SAME
+ ....S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"MULTIPLE BIRTH INDICATOR field failure"
+ ...;send the updated fields to the MPI to synch site with MPI
+ ...I HL("ETN")'="A31" S ZTSAVE("DFN")="",ZTRTN="MPISYN^RGADTPC",ZTDESC="Sending Synchronized Patient Data to MPI...",ZTIO="RG QUEUE",ZTDTH=$H D ^%ZTLOAD
+ ...;**45 ^ don't trigger A31 sync message if A31 was being processed-- ack to a31 will sync id elements on MPI
+ Q
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGHLLOG.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGHLLOG.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGHLLOG.m	(revision 623)
@@ -1,152 +1,150 @@
-RGHLLOG	;CAIRO/DKM-LOG MESSAGE PROCESSING INFO ;09/04/98
-	;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,11,13,18,19,25,45,52**;30 Apr 99;Build 2
-	;
-	;Reference to ^HLMA("C" supported by IA #3244
-	;=================================================================
-	; Log information about message processing and exceptions
-	; in CIRN HL7 Exception Log file.
-	;=================================================================
-	; Start time for run log
-START(RGMSG,RGDC,RGPARAM)	;
-	;This entry point starts the log process in the CIRN HL7 EXCEPTION LOG
-	;file (#991.1), if the (#6) MINIMAL EXCEPTION LOGGING? field in
-	;File #990.8 is set to 0.
-	; Input: Required
-	;   RGMSG - IEN of message entry in File #773, usually HLMTIEN
-	;        Optional
-	;   RGDC - Event Class, associated with an entry in File #
-	;   RGPARAM - reprocessing routine
-	S U="^"
-	K RGLOG
-	S RGLOG(3)=$G(RGMSG),RGLOG(5)=$G(RGDC),RGLOG(4)=$G(RGPARAM),RGLOG(1)=$$NOW^XLFDT
-	I '$P(^RGSITE("COR",1,0),U,8) S RGLOG=$$CREATE
-	Q
-	; Create a log entry
-CREATE()	Q:$G(RGLOG) RGLOG
-	L +^RGHL7(991.1,0):10
-	S RGLOG=$O(^RGHL7(991.1,$C(32)),-1)+1
-	S:$G(RGLOG(1))="" RGLOG(1)=$$NOW^XLFDT
-	S RGLOG(3)=$S($G(RGLOG(3))=0:0,$G(HL("MID"))="":"",1:$$IEN773($G(HL("MID"))))
-	S (DA,X)=RGLOG,DIC="^RGHL7(991.1,",DIC(0)="L",DLAYGO=991.1,DIC("DR")="1///"_$G(RGLOG(1))_";3////"_$G(RGLOG(3))_";5///"_$G(RGLOG(5))_";4////"_$G(RGLOG(4)) K DD,DO D FILE^DICN K DIC,DA,X,DLAYGO
-	L -^RGHL7(991.1,0)
-	Q RGLOG
-	; Log time run completed
-STOP(RGQUIT)	;
-	;This entry point completes the logging process
-	; Input: required
-	;    RGQUIT - 0 for success and 1 for failure
-	;
-	Q:'$G(RGLOG)
-	L +^RGHL7(991.1,RGLOG):10
-	S DIE="^RGHL7(991.1,",DR="1.5///NOW;1.6///^S X=$G(RGQUIT)",DA=RGLOG D ^DIE K DIE,DA,DR
-	L -^RGHL7(991.1,RGLOG)
-	K RGLOG,RGQUIT,X,Y,DIC,DIE
-	Q
-	; Log unclassified exception (old entry point)
-ERR(RGERR,RGSEV)	;
-	D EXC(18,RGERR)
-	S RGQUIT=$G(RGQUIT)!$G(RGSEV)
-	Q
-	; Log an exception
-EXC(RGEXC,RGERR,RGDFN,MSGID,STATNUM)	;
-	;This entry point logs exceptions in the CIRN HL7 EXCEPTION LOG
-	;file (#991.1)
-	; Input: Required
-	;   RGEXC - Exception type in File #991.11
-	;   RGERR - Supplemental text
-	;        Optional
-	;   RGDFN - IEN in the PATIENT file (#2)
-	;   MSGID - message id of the HL7 message where the exception was encountered (optional)
-	;   STATNUM - station # of site that encountered the error (optional) - if not defined then the local site is assumed, using $$SITE^VASITE
-	;
-	I (RGEXC=215)!(RGEXC=216)!(RGEXC=217) Q  ;**52 until MPIFBT3 call eliminates these exception types
-	I $L($G(HL("MID"))) Q:$$INVEXC(HL("MID"))  ; is the exception valid?
-	N RGI,RGZ
-	S U="^"
-	S:RGEXC[U RGERR=$P(RGEXC,U,2,999),RGEXC=+RGEXC
-	S:RGEXC'=+RGEXC RGERR=RGEXC,RGEXC=18
-	S:'$D(^RGHL7(991.11,RGEXC)) RGEXC=18
-	L +^RGHL7(991.11,RGEXC):10
-	S RGZ=$G(^RGHL7(991.11,RGEXC,0))
-	S:$L(RGZ) $P(^RGHL7(991.11,RGEXC,0),U,5)=$P(RGZ,U,5)+1
-	S:$P(RGZ,U,2)>1 RGQUIT=1
-	L -^RGHL7(991.11,RGEXC)
-	S RGLOG=$$CREATE
-	L +^RGHL7(991.1,RGLOG):10
-	S RGI=$O(^RGHL7(991.1,RGLOG,1,$C(32)),-1)+1
-	S RGERR=$E($G(RGERR),1,250)
-	S DIC="^RGHL7(991.1,"_RGLOG_",1,"
-	S X=RGI,DA(1)=RGLOG,DIC(0)="FL",DLAYGO=991.12,DIC("P")=$P(^DD(991.1,2,0),"^",2)
-	D ^DIC
-	S DIE=DIC
-	K DIC,DA,DR,DLAYGO
-	S STAT=0
-	S DIC="3.8",DIC(0)="Z",X="MPIF EXCEPTIONS" D ^DIC K DIC
-	S RGMG=$P($G(Y),"^",1)
-	I $P(^RGHL7(991.11,RGEXC,0),U,4)=RGMG S STAT=1
-	S DA(1)=RGLOG,DA=RGI,DR="2///"_$G(RGEXC)_";3///"_$S($G(RGDFN):"`"_RGDFN,1:"")_";6///"_$G(STAT)_";10///"_$G(RGERR)
-	D ^DIE K DIE,DA,DR
-	L -^RGHL7(991.1,RGLOG)
-	S RGI=$P(RGZ,U,3),RGZ=$P(RGZ,U,4)
-	;
-	;If the action type is for the MPI Exception Handler, send exception to the handler and quit
-	I (RGI=3) D SENDMPI^RGHLLOG1($G(RGEXC),$G(RGERR),$G(RGDFN),$G(MSGID),$G(STATNUM)) Q
-	;
-	Q:'RGI!'RGZ
-	;quit and don't send messages for exception types that are now being
-	;handled through the MPI/PD Exception Handling option.
-	Q:RGEXC=234!(RGEXC=218)  ;MPIC_772; **52 remove 215, 216, and 217
-	S DIC="^XMB(3.8,",DIC(0)="NZ",X="`"_RGZ D ^DIC K DIC Q:+Y<1  S RGZ=$P(Y,U,2) K Y
-	Q:RGZ=""!$P($G(^RGSITE("COR",1,0)),U,7)
-	S RGERR=$$SHORT(RGEXC,RGERR),RGZ="G."_RGZ
-	I RGI=2 D ALERT^RGRSUTL2(RGERR,RGZ) Q
-	D MAIL^RGRSUTL2(RGERR,RGZ,"MPI/PD Exception: "_$$SHORT(RGEXC),"MPI/PD exception notification")
-	Q
-	;
-INVEXC(RGMID)	; determine if this exception needs to be sent to MPI/PD
-	; personnel via FORUM. Return 1 to avoid messaging to FORUM, else 0.
-	; IA#:3244 is applied in this functionality
-	N RGFLG,RGIEN S RGFLG=1
-	S RGIEN=$$IEN773(RGMID) Q:'RGIEN RGFLG
-	S RGIEN("SND")=$$GET1^DIQ(773,RGIEN_",",13)
-	S RGIEN("REC")=$$GET1^DIQ(773,RGIEN_",",14)
-	; check the sending application (fld:13, 0;11) & the receiving
-	; application (fld:14, 0;12) to see if they are related to the MPI/PD
-	; project.
-	I RGIEN("SND")]""!(RGIEN("REC")]"") D  Q RGFLG
-	.S RGFLG=$$APP(RGIEN("SND")) Q:'RGFLG
-	.S RGFLG=$$APP(RGIEN("REC"))
-	.Q
-	; Only if the sending/receiving applications cannot be determined from
-	; the data in their respective fields, do I check the MSH multiple for
-	; the MSH segment. I identify the sending/receiving application from
-	; this segment. 
-	E  D
-	.N RG,RG1,RGMSH,RGFS
-	.D GETS^DIQ(773,RGIEN_",",200,,"RGMSH") ;check MSH mult for snd/rec app
-	.Q:'($D(RGMSH)\10)  ; no data in "MSH" multiple for file 773
-	.S RGIEN=RGIEN_",",RG="RGMSH(773,"""_RGIEN_""","_200_")"
-	.S RG1=0 F  S RG1=$O(@RG@(RG1)) Q:RG1'>0  D  Q:$E($G(@RG@(RG1)),1,3)="MSH"
-	..I $E($G(@RG@(RG1)),1,3)="MSH" D
-	...S RG(0)=$G(@RG@(RG1)),RGFS=$E(RG(0),4)
-	...S:$P(RG(0),RGFS,3)]"" RGFLG=$$APP($P(RG(0),RGFS,3)) Q:'RGFLG
-	...S:$P(RG(0),RGFS,5)]"" RGFLG=$$APP($P(RG(0),RGFS,5))
-	...Q
-	..Q
-	.Q
-	Q RGFLG
-APP(X)	; check if the sending/receiving application is relevant to the
-	; MPI/PD team.  Returns 1 if a non-relevant namespace, else 0
-	I $E(X,1,2)="RG"!($E(X,1,2)="VA")!($E(X,1,3)="MPI") Q 0
-	Q 1
-	;
-IEN773(RGMID)	; find the ien of the record in the HL7 MESSAGE ADMINISTRATION
-	; (#773) file based on the Message ID.  Input: Message ID
-	; Output: null, no record in 773, else 773 record ien.  IA#: 3244
-	Q:$G(RGMID)="" ""
-	Q $O(^HLMA("C",RGMID,0))
-	;
-SHORT(RGEXC,RGTXT)	;
-	; Retrieve short text description of exception
-	Q $G(^RGHL7(991.11,+RGEXC,10))_$S($G(RGTXT)="":"",1:": "_RGTXT)
-	;
+RGHLLOG ;CAIRO/DKM-LOG MESSAGE PROCESSING INFO ;09/04/98
+ ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,11,13,18,19,25,45**;30 Apr 99;Build 9
+ ;Reference to ^HLMA("C" supported by IA #3244
+ ;=================================================================
+ ; Log information about message processing and exceptions
+ ; in CIRN HL7 Exception Log file.
+ ;=================================================================
+ ; Start time for run log
+START(RGMSG,RGDC,RGPARAM) ;
+ ;This entry point starts the log process in the CIRN HL7 EXCEPTION LOG
+ ;file (#991.1), if the (#6) MINIMAL EXCEPTION LOGGING? field in
+ ;File #990.8 is set to 0.
+ ; Input: Required
+ ;   RGMSG - IEN of message entry in File #773, usually HLMTIEN
+ ;        Optional
+ ;   RGDC - Event Class, associated with an entry in File #
+ ;   RGPARAM - reprocessing routine
+ S U="^"
+ K RGLOG
+ S RGLOG(3)=$G(RGMSG),RGLOG(5)=$G(RGDC),RGLOG(4)=$G(RGPARAM),RGLOG(1)=$$NOW^XLFDT
+ I '$P(^RGSITE("COR",1,0),U,8) S RGLOG=$$CREATE
+ Q
+ ; Create a log entry
+CREATE() Q:$G(RGLOG) RGLOG
+ L +^RGHL7(991.1,0):10
+ S RGLOG=$O(^RGHL7(991.1,$C(32)),-1)+1
+ S:$G(RGLOG(1))="" RGLOG(1)=$$NOW^XLFDT
+ S RGLOG(3)=$S($G(RGLOG(3))=0:0,$G(HL("MID"))="":"",1:$$IEN773($G(HL("MID"))))
+ S (DA,X)=RGLOG,DIC="^RGHL7(991.1,",DIC(0)="L",DLAYGO=991.1,DIC("DR")="1///"_$G(RGLOG(1))_";3////"_$G(RGLOG(3))_";5///"_$G(RGLOG(5))_";4////"_$G(RGLOG(4)) K DD,DO D FILE^DICN K DIC,DA,X,DLAYGO
+ L -^RGHL7(991.1,0)
+ Q RGLOG
+ ; Log time run completed
+STOP(RGQUIT) ;
+ ;This entry point completes the logging process
+ ; Input: required
+ ;    RGQUIT - 0 for success and 1 for failure
+ ;
+ Q:'$G(RGLOG)
+ L +^RGHL7(991.1,RGLOG):10
+ S DIE="^RGHL7(991.1,",DR="1.5///NOW;1.6///^S X=$G(RGQUIT)",DA=RGLOG D ^DIE K DIE,DA,DR
+ L -^RGHL7(991.1,RGLOG)
+ K RGLOG,RGQUIT,X,Y,DIC,DIE
+ Q
+ ; Log unclassified exception (old entry point)
+ERR(RGERR,RGSEV) ;
+ D EXC(18,RGERR)
+ S RGQUIT=$G(RGQUIT)!$G(RGSEV)
+ Q
+ ; Log an exception
+EXC(RGEXC,RGERR,RGDFN,MSGID,STATNUM) ;
+ ;This entry point logs exceptions in the CIRN HL7 EXCEPTION LOG
+ ;file (#991.1)
+ ; Input: Required
+ ;   RGEXC - Exception type in File #991.11
+ ;   RGERR - Supplemental text
+ ;        Optional
+ ;   RGDFN - IEN in the PATIENT file (#2)
+ ;   MSGID - message id of the HL7 message where the exception was encountered (optional)
+ ;   STATNUM - station # of site that encountered the error (optional) - if not defined then the local site is assumed, using $$SITE^VASITE
+ ;
+ I $L($G(HL("MID"))) Q:$$INVEXC(HL("MID"))  ; is the exception valid?
+ N RGI,RGZ
+ S U="^"
+ S:RGEXC[U RGERR=$P(RGEXC,U,2,999),RGEXC=+RGEXC
+ S:RGEXC'=+RGEXC RGERR=RGEXC,RGEXC=18
+ S:'$D(^RGHL7(991.11,RGEXC)) RGEXC=18
+ L +^RGHL7(991.11,RGEXC):10
+ S RGZ=$G(^RGHL7(991.11,RGEXC,0))
+ S:$L(RGZ) $P(^RGHL7(991.11,RGEXC,0),U,5)=$P(RGZ,U,5)+1
+ S:$P(RGZ,U,2)>1 RGQUIT=1
+ L -^RGHL7(991.11,RGEXC)
+ S RGLOG=$$CREATE
+ L +^RGHL7(991.1,RGLOG):10
+ S RGI=$O(^RGHL7(991.1,RGLOG,1,$C(32)),-1)+1
+ S RGERR=$E($G(RGERR),1,250)
+ S DIC="^RGHL7(991.1,"_RGLOG_",1,"
+ S X=RGI,DA(1)=RGLOG,DIC(0)="FL",DLAYGO=991.12,DIC("P")=$P(^DD(991.1,2,0),"^",2)
+ D ^DIC
+ S DIE=DIC
+ K DIC,DA,DR,DLAYGO
+ S STAT=0
+ S DIC="3.8",DIC(0)="Z",X="MPIF EXCEPTIONS" D ^DIC K DIC
+ S RGMG=$P($G(Y),"^",1)
+ I $P(^RGHL7(991.11,RGEXC,0),U,4)=RGMG S STAT=1
+ S DA(1)=RGLOG,DA=RGI,DR="2///"_$G(RGEXC)_";3///"_$S($G(RGDFN):"`"_RGDFN,1:"")_";6///"_$G(STAT)_";10///"_$G(RGERR)
+ D ^DIE K DIE,DA,DR
+ L -^RGHL7(991.1,RGLOG)
+ S RGI=$P(RGZ,U,3),RGZ=$P(RGZ,U,4)
+ ;
+ ;If the action type is for the MPI Exception Handler, send exception to the handler and quit
+ I (RGI=3) D SENDMPI^RGHLLOG1($G(RGEXC),$G(RGERR),$G(RGDFN),$G(MSGID),$G(STATNUM)) Q
+ ;
+ Q:'RGI!'RGZ
+ ;quit and don't send messages for exception types that are now being
+ ;handled through the MPI/PD Exception Handling option.
+ Q:RGEXC=234!((RGEXC>214)&(RGEXC<219))
+ S DIC="^XMB(3.8,",DIC(0)="NZ",X="`"_RGZ D ^DIC K DIC Q:+Y<1  S RGZ=$P(Y,U,2) K Y
+ Q:RGZ=""!$P($G(^RGSITE("COR",1,0)),U,7)
+ S RGERR=$$SHORT(RGEXC,RGERR),RGZ="G."_RGZ
+ I RGI=2 D ALERT^RGRSUTL2(RGERR,RGZ) Q
+ D MAIL^RGRSUTL2(RGERR,RGZ,"MPI/PD Exception: "_$$SHORT(RGEXC),"MPI/PD exception notification")
+ Q
+ ;
+INVEXC(RGMID) ; determine if this exception needs to be sent to MPI/PD
+ ; personnel via FORUM. Return 1 to avoid messaging to FORUM, else 0.
+ ; IA#:3244 is applied in this functionality
+ N RGFLG,RGIEN S RGFLG=1
+ S RGIEN=$$IEN773(RGMID) Q:'RGIEN RGFLG
+ S RGIEN("SND")=$$GET1^DIQ(773,RGIEN_",",13)
+ S RGIEN("REC")=$$GET1^DIQ(773,RGIEN_",",14)
+ ; check the sending application (fld:13, 0;11) & the receiving
+ ; application (fld:14, 0;12) to see if they are related to the MPI/PD
+ ; project.
+ I RGIEN("SND")]""!(RGIEN("REC")]"") D  Q RGFLG
+ .S RGFLG=$$APP(RGIEN("SND")) Q:'RGFLG
+ .S RGFLG=$$APP(RGIEN("REC"))
+ .Q
+ ; Only if the sending/receiving applications cannot be determined from
+ ; the data in their respective fields, do I check the MSH multiple for
+ ; the MSH segment. I identify the sending/receiving application from
+ ; this segment. 
+ E  D
+ .N RG,RG1,RGMSH,RGFS
+ .D GETS^DIQ(773,RGIEN_",",200,,"RGMSH") ;check MSH mult for snd/rec app
+ .Q:'($D(RGMSH)\10)  ; no data in "MSH" multiple for file 773
+ .S RGIEN=RGIEN_",",RG="RGMSH(773,"""_RGIEN_""","_200_")"
+ .S RG1=0 F  S RG1=$O(@RG@(RG1)) Q:RG1'>0  D  Q:$E($G(@RG@(RG1)),1,3)="MSH"
+ ..I $E($G(@RG@(RG1)),1,3)="MSH" D
+ ...S RG(0)=$G(@RG@(RG1)),RGFS=$E(RG(0),4)
+ ...S:$P(RG(0),RGFS,3)]"" RGFLG=$$APP($P(RG(0),RGFS,3)) Q:'RGFLG
+ ...S:$P(RG(0),RGFS,5)]"" RGFLG=$$APP($P(RG(0),RGFS,5))
+ ...Q
+ ..Q
+ .Q
+ Q RGFLG
+APP(X) ; check if the sending/receiving application is relevant to the
+ ; MPI/PD team.  Returns 1 if a non-relevant namespace, else 0
+ I $E(X,1,2)="RG"!($E(X,1,2)="VA")!($E(X,1,3)="MPI") Q 0
+ Q 1
+ ;
+IEN773(RGMID) ; find the ien of the record in the HL7 MESSAGE ADMINISTRATION
+ ; (#773) file based on the Message ID.  Input: Message ID
+ ; Output: null, no record in 773, else 773 record ien.  IA#: 3244
+ Q:$G(RGMID)="" ""
+ Q $O(^HLMA("C",RGMID,0))
+ ;
+SHORT(RGEXC,RGTXT) ;
+ ; Retrieve short text description of exception
+ Q $G(^RGHL7(991.11,+RGEXC,10))_$S($G(RGTXT)="":"",1:": "_RGTXT)
+ ;
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGMTETOT.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGMTETOT.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGMTETOT.m	(revision 623)
@@ -1,135 +1,139 @@
-RGMTETOT	;BIR/CML-Compile Totals for Site Exceptions ;11/15/01
-	;;1.0;CLINICAL INFO RESOURCE NETWORK;**20,30,43,45,52**;30 Apr 99;Build 2
-	;
-	;Reference to ^DPT("AICNL" supported by IA #2070
-	;
-	;Variable RGHLMQ cannot be killed in this routine, it is needed for the remote query
-	;
-	;Use this routine to compile totals of a site's exceptions in file #991.1
-	S DUMP=0 G START
-	;
-DUMP1	;Use this call to dump all data in ascii format for table
-	S DUMP=1 G START
-	;
-DUMP2	;Use this call to dump data in ascii format for table - just for exceptions sites have to deal with
-	S DUMP=2
-	;
-START	;
-	;do purge of any dups for POTENTIAL MATCH Exceptions
-	K TYPEARR,^XTMP("RGMT","HLMQETOT")
-	S ^XTMP("RGMT",0)=$$FMADD^XLFDT(DT,30)_"^"_$$NOW^XLFDT_"^MPI/PD Maintenance Data"
-	D PURGE
-	;create type array from file 991.11
-	S TYPE=233 F  S TYPE=$O(^RGHL7(991.11,TYPE)) Q:'TYPE  I TYPE'=218 S TYPEARR(TYPE)=0 ;MPIC_772; **52 remove 215, 216, and 217
-	;
-	;start loop
-	S TYPE=233 F  S TYPE=$O(^RGHL7(991.1,"AC",TYPE)) Q:'TYPE  D  ;MPIC_772; **52 remove 215, 216, and 217
-	.Q:TYPE=218
-	.S IEN1=0 F  S IEN1=$O(^RGHL7(991.1,"AC",TYPE,IEN1)) Q:'IEN1  D
-	..S IEN2=0 F  S IEN2=$O(^RGHL7(991.1,"AC",TYPE,IEN1,IEN2)) Q:'IEN2  D
-	...I '$D(^RGHL7(991.1,IEN1,1,IEN2,0)) Q
-	...S STAT=$P(^RGHL7(991.1,IEN1,1,IEN2,0),"^",5) I STAT<1 S TYPEARR(TYPE)=TYPEARR(TYPE)+1
-	;
-PRT	;
-	S GRAND=0
-	S SITENM=$P($$SITE^VASITE(),"^",2),$P(LN,"-",81)=""
-	D NOW^%DTC S RUNDT=$$FMTE^XLFDT($E(%,1,12))
-	;
-PRT0	I 'DUMP D
-	.W !!,"Exception Totals for ",SITENM
-	.W !,"Printed ",RUNDT,!,LN
-	.S TYPE=0 F  S TYPE=$O(TYPEARR(TYPE)) Q:'TYPE  I +TYPEARR(TYPE) D
-	..S GRAND=GRAND+TYPEARR(TYPE)
-	..W !!,"TYPE: ",TYPE,?12,$P($T(@TYPE),";;",2),?67,"TOTAL = ",$J(TYPEARR(TYPE),4)
-	..W !,"DESCRIPTION:"
-	..S TXT=0 F  S TXT=$O(^RGHL7(991.11,TYPE,99,TXT)) Q:'TXT  W !,^RGHL7(991.11,TYPE,99,TXT,0)
-	.W !!?56,"TOTAL EXCEPTIONS: ",$J(GRAND,5)
-	;
-PRT1	I DUMP=1 D
-	.W !!,"At this point it is necessary for you to increase the right margin."
-	.W !,"At the DEVICE prompt enter=> ;255"
-	.W ! D ^%ZIS I POP W !,"DOWNLOAD ABORTED!" Q
-	.W !!,"Data string=Site;Run Date;Date CIRN Installed;Exceptions 218 & 234" ;MPIC_772; **52 remove 215, 216, and 217
-	.S STR=SITENM_";"_RUNDT_";"
-	.S TYPE=0 F  S TYPE=$O(TYPEARR(TYPE)) Q:'TYPE  D
-	..S STR=STR_";"_TYPEARR(TYPE)
-	.W !!,STR
-	;
-PRT2	I DUMP=2 D
-	.S ICN=0,LOCCNT=0 F  S ICN=$O(^DPT("AICNL",1,ICN)) Q:'ICN  S LOCCNT=LOCCNT+1
-	.S SITEIEN=+$$SITE^VASITE(),STANUM=$P($$SITE^VASITE(),"^",3)
-	.I '$D(RGHLMQ) W !!,"Data string:"
-	.I '$D(RGHLMQ) W !,"Site;Sta#;;;LocICNs,218,234" ;MPIC_772; **52 remove 215, 216, and 217
-	.S STR=SITENM_";"_STANUM_";;;"_LOCCNT
-	.F TYPE=218,234 S STR=STR_";"_TYPEARR(TYPE) ;MPIC_772; **52 remove 215, 216, and 217
-	.I '$D(RGHLMQ) W !!,STR
-	.I $D(RGHLMQ) S ^XTMP("RGMT","HLMQETOT",STANUM,1)=STR
-	;
-QUIT	;
-	K %,CIRNIEN,CNT,DA,DIK,DUMP,DUPCNT,EXCDT,GRAND,ICN,IEN,IEN1,IEN2,LN,LOCCNT,OLDDT,OLDNODE,PTNM
-	K RGDFN,RUNDT,SITEIEN,SITENM,STANUM,STAT,STR,TXT,TYPE,XCNT,HOME,DFN,RCNT,VADM
-	K ^XTMP("RGMT","ETOT")
-	Q
-	;
-PURGE	;
-	I '$D(RGHLMQ) W !!,"...purging duplicate Potential Match Exceptions",!
-	K ^XTMP("RGMT","ETOT")
-	S (RGDFN,CNT,XCNT,DUPCNT)=0,HOME=$$SITE^VASITE()
-	F  S RGDFN=$O(^RGHL7(991.1,"ADFN",218,RGDFN)) Q:'RGDFN  D
-	.S IEN=0
-	.F  S IEN=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN)) Q:'IEN  D
-	..S IEN2=0
-	..F  S IEN2=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN,IEN2)) Q:'IEN2  D
-	...I '$D(^RGHL7(991.1,IEN,0)) Q
-	...S CNT=CNT+1
-	...S EXCDT=$P(^RGHL7(991.1,IEN,0),"^",3)
-	...I '$D(^XTMP("RGMT","ETOT",RGDFN)) D  Q
-	....S XCNT=XCNT+1
-	....D SETTMP
-	...I $D(^XTMP("RGMT","ETOT",RGDFN))  D
-	....S OLDNODE=^XTMP("RGMT","ETOT",RGDFN)
-	....S OLDDT=$P(OLDNODE,"^")
-	....I EXCDT>OLDDT D  Q
-	.....S DA(1)=$P(OLDNODE,"^",2),DA=$P(OLDNODE,"^",3)
-	.....D DELDUP
-	.....D SETTMP
-	....I OLDDT>EXCDT!(OLDDT=EXCDT) D
-	.....S DA(1)=IEN,DA=IEN2
-	.....D DELDUP
-	I '$D(RGHLMQ) W !,DUPCNT," duplicate patient entries for POTENTIAL MATCH exceptions were identified"
-	I '$D(RGHLMQ) W !,"and deleted from the CIRN HL7 EXCEPTION LOG file (#991.1)."
-	;
-	K ^XTMP("RGMT","ETOT")
-	S (RCNT,RGDFN)=0 N IEN,SUB
-	F  S RGDFN=$O(^RGHL7(991.1,"ADFN",218,RGDFN)) Q:'RGDFN  D
-	.;S ICN=+$$GETICN^MPIF001(RGDFN)
-	.;I $E(ICN,1,3)=$P(HOME,"^",3)!(ICN<0) D
-	.;**43 shouldn't check for locals or no ICN, check for processed/not processed
-	.S IEN=0  F  S IEN=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN)) Q:IEN=""  D
-	..S SUB=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN,""))
-	..I $P($G(^RGHL7(991.1,IEN,1,SUB,0)),"^",5)=0 D
-	...S DFN=RGDFN D DEM^VADPT
-	...I VADM(1)=""!(VADM(2)="") Q
-	...S RCNT=RCNT+1
-	...S ^XTMP("RGMT","ETOT",VADM(1),RGDFN)=$P(VADM(2),"^")_"^"_$P(VADM(3),"^",2)
-	;
-	;count the number of patients who need to be resolved
-	S PTNM="",CNT=0
-	F  S PTNM=$O(^XTMP("RGMT","ETOT",PTNM)) Q:PTNM=""  D
-	.S RGDFN=0
-	.F  S RGDFN=$O(^XTMP("RGMT","ETOT",PTNM,RGDFN)) Q:'RGDFN  S CNT=CNT+1
-	S TYPEARR(218)=CNT
-	Q
-	;
-SETTMP	;set TMP global for patient check
-	S ^XTMP("RGMT","ETOT",RGDFN)=EXCDT_"^"_IEN_"^"_IEN2
-	Q
-	;
-DELDUP	;delete patient dups from file
-	S DUPCNT=DUPCNT+1
-	S DIK="^RGHL7(991.1,"_DA(1)_",1,"
-	D ^DIK K DIK,DA
-	Q
-	;
-218	;;(Potential Matches Returned)
-234	;;(Primary View Reject)
+RGMTETOT ;BIR/CML-Compile Totals for Site Exceptions ;11/15/01
+ ;;1.0;CLINICAL INFO RESOURCE NETWORK;**20,30,43,45**;30 Apr 99;Build 9
+ ;
+ ;Reference to ^DPT("AICNL" supported by IA #2070
+ ;
+ ;Variable RGHLMQ cannot be killed in this routine, it is needed for the remote query
+ ;
+ ;Use this routine to compile totals of a site's exceptions in file #991.1
+ S DUMP=0 G START
+ ;
+DUMP1 ;Use this call to dump all data in ascii format for table
+ S DUMP=1 G START
+ ;
+DUMP2 ;Use this call to dump data in ascii format for table - just for exceptions sites have to deal with
+ S DUMP=2
+ ;
+START ;
+ ;do purge of any dups for POTENTIAL MATCH Exceptions
+ K TYPEARR,^XTMP("RGMT","HLMQETOT")
+ S ^XTMP("RGMT",0)=$$FMADD^XLFDT(DT,30)_"^"_$$NOW^XLFDT_"^MPI/PD Maintenance Data"
+ D PURGE
+ ;create type array from file 991.11
+ S TYPE=214 F  S TYPE=$O(^RGHL7(991.11,TYPE)) Q:'TYPE  I TYPE'=218 S TYPEARR(TYPE)=0
+ ;
+ ;start loop
+ S TYPE=214 F  S TYPE=$O(^RGHL7(991.1,"AC",TYPE)) Q:'TYPE  D
+ .Q:TYPE=218
+ .S IEN1=0 F  S IEN1=$O(^RGHL7(991.1,"AC",TYPE,IEN1)) Q:'IEN1  D
+ ..S IEN2=0 F  S IEN2=$O(^RGHL7(991.1,"AC",TYPE,IEN1,IEN2)) Q:'IEN2  D
+ ...I '$D(^RGHL7(991.1,IEN1,1,IEN2,0)) Q
+ ...S STAT=$P(^RGHL7(991.1,IEN1,1,IEN2,0),"^",5) I STAT<1 S TYPEARR(TYPE)=TYPEARR(TYPE)+1
+ ;
+PRT ;
+ S GRAND=0
+ S SITENM=$P($$SITE^VASITE(),"^",2),$P(LN,"-",81)=""
+ D NOW^%DTC S RUNDT=$$FMTE^XLFDT($E(%,1,12))
+ ;
+PRT0 I 'DUMP D
+ .W !!,"Exception Totals for ",SITENM
+ .W !,"Printed ",RUNDT,!,LN
+ .S TYPE=0 F  S TYPE=$O(TYPEARR(TYPE)) Q:'TYPE  I +TYPEARR(TYPE) D
+ ..S GRAND=GRAND+TYPEARR(TYPE)
+ ..W !!,"TYPE: ",TYPE,?12,$P($T(@TYPE),";;",2),?67,"TOTAL = ",$J(TYPEARR(TYPE),4)
+ ..W !,"DESCRIPTION:"
+ ..S TXT=0 F  S TXT=$O(^RGHL7(991.11,TYPE,99,TXT)) Q:'TXT  W !,^RGHL7(991.11,TYPE,99,TXT,0)
+ .W !!?56,"TOTAL EXCEPTIONS: ",$J(GRAND,5)
+ ;
+PRT1 I DUMP=1 D
+ .W !!,"At this point it is necessary for you to increase the right margin."
+ .W !,"At the DEVICE prompt enter=> ;255"
+ .W ! D ^%ZIS I POP W !,"DOWNLOAD ABORTED!" Q
+ .W !!,"Data string=Site;Run Date;Date CIRN Installed;Exceptions 215-234"
+ .S STR=SITENM_";"_RUNDT_";"
+ .S TYPE=0 F  S TYPE=$O(TYPEARR(TYPE)) Q:'TYPE  D
+ ..S STR=STR_";"_TYPEARR(TYPE)
+ .W !!,STR
+ ;
+PRT2 I DUMP=2 D
+ .S ICN=0,LOCCNT=0 F  S ICN=$O(^DPT("AICNL",1,ICN)) Q:'ICN  S LOCCNT=LOCCNT+1
+ .S SITEIEN=+$$SITE^VASITE(),STANUM=$P($$SITE^VASITE(),"^",3)
+ .I '$D(RGHLMQ) W !!,"Data string:"
+ .I '$D(RGHLMQ) W !,"Site;Sta#;;;LocICNs,215,216,217,218,227,234"
+ .S STR=SITENM_";"_STANUM_";;;"_LOCCNT
+ .F TYPE=215,216,217,218,227,234 S STR=STR_";"_TYPEARR(TYPE)
+ .I '$D(RGHLMQ) W !!,STR
+ .I $D(RGHLMQ) S ^XTMP("RGMT","HLMQETOT",STANUM,1)=STR
+ ;
+QUIT ;
+ K %,CIRNIEN,CNT,DA,DIK,DUMP,DUPCNT,EXCDT,GRAND,ICN,IEN,IEN1,IEN2,LN,LOCCNT,OLDDT,OLDNODE,PTNM
+ K RGDFN,RUNDT,SITEIEN,SITENM,STANUM,STAT,STR,TXT,TYPE,XCNT,HOME,DFN,RCNT,VADM
+ K ^XTMP("RGMT","ETOT")
+ Q
+ ;
+PURGE ;
+ I '$D(RGHLMQ) W !!,"...purging duplicate Potential Match Exceptions",!
+ K ^XTMP("RGMT","ETOT")
+ S (RGDFN,CNT,XCNT,DUPCNT)=0,HOME=$$SITE^VASITE()
+ F  S RGDFN=$O(^RGHL7(991.1,"ADFN",218,RGDFN)) Q:'RGDFN  D
+ .S IEN=0
+ .F  S IEN=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN)) Q:'IEN  D
+ ..S IEN2=0
+ ..F  S IEN2=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN,IEN2)) Q:'IEN2  D
+ ...I '$D(^RGHL7(991.1,IEN,0)) Q
+ ...S CNT=CNT+1
+ ...S EXCDT=$P(^RGHL7(991.1,IEN,0),"^",3)
+ ...I '$D(^XTMP("RGMT","ETOT",RGDFN)) D  Q
+ ....S XCNT=XCNT+1
+ ....D SETTMP
+ ...I $D(^XTMP("RGMT","ETOT",RGDFN))  D
+ ....S OLDNODE=^XTMP("RGMT","ETOT",RGDFN)
+ ....S OLDDT=$P(OLDNODE,"^")
+ ....I EXCDT>OLDDT D  Q
+ .....S DA(1)=$P(OLDNODE,"^",2),DA=$P(OLDNODE,"^",3)
+ .....D DELDUP
+ .....D SETTMP
+ ....I OLDDT>EXCDT!(OLDDT=EXCDT) D
+ .....S DA(1)=IEN,DA=IEN2
+ .....D DELDUP
+ I '$D(RGHLMQ) W !,DUPCNT," duplicate patient entries for POTENTIAL MATCH exceptions were identified"
+ I '$D(RGHLMQ) W !,"and deleted from the CIRN HL7 EXCEPTION LOG file (#991.1)."
+ ;
+ K ^XTMP("RGMT","ETOT")
+ S (RCNT,RGDFN)=0 N IEN,SUB
+ F  S RGDFN=$O(^RGHL7(991.1,"ADFN",218,RGDFN)) Q:'RGDFN  D
+ .;S ICN=+$$GETICN^MPIF001(RGDFN)
+ .;I $E(ICN,1,3)=$P(HOME,"^",3)!(ICN<0) D
+ .;**43 shouldn't check for locals or no ICN, check for processed/not processed
+ .S IEN=0  F  S IEN=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN)) Q:IEN=""  D
+ ..S SUB=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN,""))
+ ..I $P($G(^RGHL7(991.1,IEN,1,SUB,0)),"^",5)=0 D
+ ...S DFN=RGDFN D DEM^VADPT
+ ...I VADM(1)=""!(VADM(2)="") Q
+ ...S RCNT=RCNT+1
+ ...S ^XTMP("RGMT","ETOT",VADM(1),RGDFN)=$P(VADM(2),"^")_"^"_$P(VADM(3),"^",2)
+ ;
+ ;count the number of patients who need to be resolved
+ S PTNM="",CNT=0
+ F  S PTNM=$O(^XTMP("RGMT","ETOT",PTNM)) Q:PTNM=""  D
+ .S RGDFN=0
+ .F  S RGDFN=$O(^XTMP("RGMT","ETOT",PTNM,RGDFN)) Q:'RGDFN  S CNT=CNT+1
+ S TYPEARR(218)=CNT
+ Q
+ ;
+SETTMP ;set TMP global for patient check
+ S ^XTMP("RGMT","ETOT",RGDFN)=EXCDT_"^"_IEN_"^"_IEN2
+ Q
+ ;
+DELDUP ;delete patient dups from file
+ S DUPCNT=DUPCNT+1
+ S DIK="^RGHL7(991.1,"_DA(1)_",1,"
+ D ^DIK K DIK,DA
+ Q
+ ;
+215 ;;(Death Entry on MPI not in VISTA)
+216 ;;(Death Entry on Vista not in MPI)
+217 ;;(Death Entries Mismatch)
+218 ;;(Potential Matches Returned)
+227 ;;(Multiple ICNs)
+234 ;;(Primary View Reject)
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGPVMPI.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGPVMPI.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGPVMPI.m	(revision 623)
@@ -1,90 +1,85 @@
-RGPVMPI	;BIR/PTD-REMOTE PRIMARY VIEW DISPLAY FROM MPI ;5/17/07
-	;;1.0;CLINICAL INFO RESOURCE NETWORK;**48,53**;30 Apr 99;Build 2
-	;
-	;Reference to EN1^XWB2HL7 supported by IA #3144
-	;Reference to RPCCHK^XWB2HL7 supported by IA #3144
-	;
-INTRO	;Display purpose of option
-	W @IOF S SAPV=1 ;from stand alone option, not EH
-	W !,"This option sends a remote request for data to the Master Patient"
-	W !,"Index, using a Remote Procedure Call (RPC).  When the RPC returns"
-	W !,"the information, you can review Primary View data as it currently"
-	W !,"exists on the MPI Patient Data Inquiry (PDAT) report."
-	;
-	W !!,"Choose the patient for whom Primary View data is to be requested."
-	W !,"The selected patient must have an Integration Control Number (ICN)."
-	W !,"You can select by Patient Name, Social Security Number, or ICN.",!
-	;
-ASK	;Ask For Patient
-	S DFN="",RGICN="" K DTOUT,DUOUT
-	S DIC="^DPT(",DIC(0)="QEAM",DIC("A")="Select PATIENT: ",D="SSN^AICN^B^BS^BS5"
-	D MIX^DIC1 K DIC,D
-	I Y<0 G EXIT
-	S DFN=+Y
-	S RGICN=+$$GETICN^MPIF001(DFN) I RGICN<1 W !,"There is no Integration Control Number for this patient." G ASK
-	;
-SEND	;Send a remote query to the MPI for Primary View PDAT
-	;Entry point from Exception Handler; DATA should be defined.
-	S (QFLG,QUIT)=0 N RETURN,RESULT,SNTDT
-	I SAPV=0 D  I QUIT=1 G EXIT
-	.I DATA="" W !,"No Exception Data available." S QUIT=1 Q
-	.S RGICN=$P(DATA,"^",6) I RGICN="" W !,"No ICN defined." S QUIT=1 Q
-	.S VALMBCK=""
-	.D FULL^VALM1
-NOQ	;No previous query exists for this ICN
-	I '$D(^XTMP("RGPVMPI"_RGICN)) D RPC G DISP
-	;
-OLDQ	;Query previously sent for this ICN
-	I $D(^XTMP("RGPVMPI"_RGICN)) D
-	.S SNTDT=$$FMTE^XLFDT($P(^XTMP("RGPVMPI"_RGICN,"DATA"),"^",2))
-	.W !,"A query was last sent for this ICN on "_SNTDT
-	.;Has data returned for query?
-	.S RETURN(0)=$P(^XTMP("RGPVMPI"_RGICN,"DATA"),"^")
-	.D RPCCHK^XWB2HL7(.RESULT,RETURN(0))
-	.;Data has NOT returned
-	.I +RESULT(0)'=1 D FAIL  Q  ;**53
-	.I +RESULT(0)=1 D  ;Data has returned
-	..S DIR("A")="Do you wish to view the existing query data now? ",DIR(0)="YA"
-	..S DIR("?")="Enter YES to review the existing data; enter NO to send a new query"
-	..S DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S QUIT=1 Q  ;up-arrowed out
-	..I Y>0 K DIR Q  ;yes, use existing query
-	..I Y=0 D  Q  ;no, don't use existing, send new query
-	...K ^XTMP("RGPVMPI"_RGICN)
-	...D RPC
-	...K DIR
-	;
-DISP	;Display Primary View Data
-	I QUIT'=1 D  I QFLG G EXIT
-	.I SAPV=1 D  Q:QFLG  ;Stand alone PV display
-	..W !,"(Be sure HISTORY is enabled to capture data!)"
-	..S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
-	..W !,@IOF D SAPV^RGEX06(RGICN)
-	.I SAPV=0 D EN^RGEX06(RGICN) ;Exception Handler PV display
-	;
-EXIT	;Kill variables and quit
-	K CNT,D,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,QFLG,QUIT,RGICN,SAPV,X,Y
-	Q
-	;
-RPC	;Send the Remote Query
-	W !!,"Sending a Remote Query to the Master Patient Index."
-	W !,"This will take some time; please be patient."
-	D EN1^XWB2HL7(.RETURN,"200M","RG PRIMARY VIEW FROM MPI",1,RGICN) I RETURN(0)'="" D  Q
-	.S ^XTMP("RGPVMPI"_RGICN,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"PRIMARY VIEW MPI PDAT"
-	.S ^XTMP("RGPVMPI"_RGICN,"DATA")=RETURN(0)_"^"_$$NOW^XLFDT
-	.;Has data returned for this query?
-	.S CNT=0 F  S CNT=CNT+1 D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) Q:RESULT(0)  H 2 I CNT>15 Q  ;result(0)=status of handle
-	.I +RESULT(0)=1 W !,"Query data has returned from the MPI and is available for review."
-	.I +RESULT(0)'=1 D FAIL  ;**53
-	W !!,"Problem with Query: ",RETURN(0)_"^"_$G(RETURN(1))
-	S QUIT=1
-	I SAPV=0 D PAUSE^VALM1
-	Q
-	;
-FAIL	;Status of RPC call - unsuccessful after 30 seconds ;**53
-	W !,"Your query request has NOT returned data from the MPI after trying for"
-	W !,"30 seconds. This could be due to network issues. Please try again later."
-	K ^XTMP("RGPVMPI"_RGICN)
-	S QUIT=1
-	I SAPV=0 D PAUSE^VALM1
-	Q
-	;
+RGPVMPI ;BIR/PTD-REMOTE PRIMARY VIEW DISPLAY FROM MPI ;5/17/07
+ ;;1.0;CLINICAL INFO RESOURCE NETWORK;**48**;30 Apr 99;Build 3
+ ;
+ ;Reference to EN1^XWB2HL7 supported by IA #3144
+ ;Reference to RPCCHK^XWB2HL7 supported by IA #3144
+ ;
+INTRO ;Display purpose of option
+ W @IOF S SAPV=1 ;from stand alone option, not EH
+ W !,"This option sends a remote request for data to the Master Patient"
+ W !,"Index, using a Remote Procedure Call (RPC).  When the RPC returns"
+ W !,"the information, you can review Primary View data as it currently"
+ W !,"exists on the MPI Patient Data Inquiry (PDAT) report."
+ ;
+ W !!,"Choose the patient for whom Primary View data is to be requested."
+ W !,"The selected patient must have an Integration Control Number (ICN)."
+ W !,"You can select by Patient Name, Social Security Number, or ICN.",!
+ ;
+ASK ;Ask For Patient
+ S DFN="",RGICN="" K DTOUT,DUOUT
+ S DIC="^DPT(",DIC(0)="QEAM",DIC("A")="Select PATIENT: ",D="SSN^AICN^B^BS^BS5"
+ D MIX^DIC1 K DIC,D
+ I Y<0 G EXIT
+ S DFN=+Y
+ S RGICN=+$$GETICN^MPIF001(DFN) I RGICN<1 W !,"There is no Integration Control Number for this patient." G ASK
+ ;
+SEND ;Send a remote query to the MPI for Primary View PDAT
+ ;Entry point from Exception Handler; DATA should be defined.
+ S (QFLG,QUIT)=0 N RETURN,RESULT,SNTDT
+ I SAPV=0 D  I QUIT=1 G EXIT
+ .I DATA="" W !,"No Exception Data available." S QUIT=1 Q
+ .S RGICN=$P(DATA,"^",6) I RGICN="" W !,"No ICN defined." S QUIT=1 Q
+ .S VALMBCK=""
+ .D FULL^VALM1
+NOQ ;No previous query exists for this ICN
+ I '$D(^XTMP("RGPVMPI",RGICN)) D RPC G DISP
+ ;
+OLDQ ;Query previously sent for this ICN
+ I $D(^XTMP("RGPVMPI",RGICN)) D
+ .S SNTDT=$$FMTE^XLFDT($P(^XTMP("RGPVMPI",RGICN),"^",2))
+ .W !,"A query was last sent for this ICN on "_SNTDT
+ .;Has data returned for query?
+ .S RETURN(0)=$P(^XTMP("RGPVMPI",RGICN),"^")
+ .D RPCCHK^XWB2HL7(.RESULT,RETURN(0))
+ .;Data has NOT returned
+ .I +RESULT(0)'=1 S QUIT=1 W !,"Query data has NOT returned from the MPI; please check back later." Q
+ .I +RESULT(0)=1 D  ;Data has returned
+ ..S DIR("A")="Do you wish to view the existing query data now? ",DIR(0)="YA"
+ ..S DIR("?")="Enter YES to review the existing data; enter NO to send a new query"
+ ..S DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S QUIT=1 Q  ;up-arrowed out
+ ..I Y>0 K DIR Q  ;yes, use existing query
+ ..I Y=0 D  Q  ;no, don't use existing, send new query
+ ...K ^XTMP("RGPVMPI",RGICN)
+ ...D RPC
+ ...K DIR
+ ;
+DISP ;Display Primary View Data
+ I QUIT'=1 D  I QFLG G EXIT
+ .I SAPV=1 D  Q:QFLG  ;Stand alone PV display
+ ..W !,"(Be sure HISTORY is enabled to capture data!)"
+ ..S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
+ ..W !,@IOF D SAPV^RGEX06(RGICN)
+ .I SAPV=0 D EN^RGEX06(RGICN) ;Exception Handler PV display
+ ;
+EXIT ;Kill variables and quit
+ K CNT,D,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,QFLG,QUIT,RGICN,SAPV,X,Y
+ Q
+ ;
+RPC ;Send the Remote Query
+ W !!,"Sending a Remote Query to the Master Patient Index."
+ W !,"This will take some time; please be patient."
+ D EN1^XWB2HL7(.RETURN,"200M","RG PRIMARY VIEW FROM MPI",1,RGICN) I RETURN(0)'="" D  Q
+ .S ^XTMP("RGPVMPI",0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"PRIMARY VIEW MPI PDAT"
+ .S ^XTMP("RGPVMPI",RGICN)=RETURN(0)_"^"_$$NOW^XLFDT
+ .;Has data returned for this query?
+ .S CNT=0 F  S CNT=CNT+1 D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) Q:RESULT(0)  H 2 I CNT>15 Q  ;result(0)=status of handle
+ .I +RESULT(0)=1 W !,"Query data has returned from the MPI and is available for review."
+ .I +RESULT(0)'=1 D  ;quit, info not back after 30 seconds
+ ..W !,"Query data has NOT returned from the MPI; please check back later."
+ ..S QUIT=1
+ ..I SAPV=0 D PAUSE^VALM1
+ W !!,"Problem with Query: ",RETURN(0)_"^"_$G(RETURN(1))
+ S QUIT=1
+ I SAPV=0 D PAUSE^VALM1
+ Q
+ ;
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGPVREJ.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGPVREJ.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGPVREJ.m	(revision 623)
@@ -1,81 +1,76 @@
-RGPVREJ	;BIR/PTD-REMOTE PRIMARY VIEW REJECT (PATIENT) ;10/8/06
-	;;1.0;CLINICAL INFO RESOURCE NETWORK;**44,47,53**;30 Apr 99;Build 2
-	;
-	;Reference to ^XWB2HL7 supported by IA #3144
-	;Reference to ^XWBDRPC supported by IA #3149
-	;
-REJ	;Option only available for Primary View Reject exceptions
-	;From within the Exception Handler, for selection, DATA should be defined.
-	N RGBDT,RGICN,RGSITE,PTEN,PELV
-	I DATA="" W !,"No Exception Data available." Q
-	S PTEN=$P(DATA,"^",10) ;IEN IN 991.1
-	S PELV=$P(DATA,"^",11) ;IEN IN 991.12
-	I $P($G(^RGHL7(991.1,PTEN,1,PELV,0)),"^",3)'=234 S VALMSG="Action is ONLY for PRIMARY VIEW REJECT exceptions!" Q
-	I $P($G(^RGHL7(991.1,PTEN,1,PELV,0)),"^",5)=1 S VALMSG="Exception has been PROCESSED; no longer active." Q
-	S RGSITE=$P($$SITE^VASITE(),"^",3) I RGSITE="" W !,"No Site Data defined." Q
-	S RGICN=$P(DATA,"^",6) I RGICN="" W !,"No ICN defined." Q
-	S RGBDT=$P(DATA,"^",3) I RGBDT="" W !,"No Exception Date defined." Q
-	S X=RGBDT D ^%DT S RGBDT=Y ;convert Exception Date from external format to internal
-	;
-	S VALMBCK="",QUIT=0
-	D FULL^VALM1
-SEND	;Send a remote query to the MPI for Primary View Reject report
-	N RETURN,RESULT,RGEDT,SNTDT
-	S RGEDT=$$DT^XLFDT ;End date for report internal format
-NOQ	;No previous query exists for this ICN/exception date
-	I '$D(^XTMP("RGPVREJ"_RGICN,RGBDT)) D RPC G DISP
-	;
-OLDQ	;Query already sent for this ICN/ exception date
-	I $D(^XTMP("RGPVREJ"_RGICN,RGBDT)) D
-	.S SNTDT=$$FMTE^XLFDT($P(^XTMP("RGPVREJ"_RGICN,RGBDT),"^",2))
-	.W !?3,"A query was last sent for this ICN/Exception Date on "_SNTDT
-	.S X=$P(SNTDT,"@") D ^%DT S SNTDT=Y ;convert to internal, strip time
-	.;Has data returned for existing query?
-	.S RETURN(0)=$P(^XTMP("RGPVREJ"_RGICN,RGBDT),"^")
-	.D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) I +RESULT(0)=1 D  Q  ;Data has returned
-	..I RGEDT=SNTDT D  ;query was sent 'today', want to use that one?
-	...S DIR("A")="   Do you wish to review that existing query data now? ",DIR(0)="YA"
-	...S DIR("?")="     Enter YES to review the existing query; NO to send a new query"
-	...S DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S QUIT=1 Q  ;up-arrowed out
-	...I Y>0 K DIR Q  ;yes, use existing query
-	...I Y=0 D  Q  ;no, don't use existing, send new query
-	....K ^XTMP("RGPVREJ"_RGICN,RGBDT)
-	....D RPC
-	....K DIR
-	....;
-	..I RGEDT'=SNTDT D  ;query was NOT sent 'today', data may be old, send new query
-	...W !?3,"Previous Query data may be obsolete."
-	...K ^XTMP("RGPVREJ"_RGICN,RGBDT)
-	...D RPC
-	.;Data for existing query has NOT returned  **47
-	.I +RESULT(0)'=1 D FAIL  ;**53
-	;
-DISP	;Display Primary View Reject Data
-	I QUIT'=1 D EN^RGEX07(RGICN,RGBDT)
-EXIT	;Kill variables and quit
-	K CNT,DIR,DIRUT,QUIT,X,Y
-	Q
-	;
-RPC	;Send the Remote Query
-	W !?3,"Sending a Remote Query to the Master Patient Index."
-	W !?3,"This will take some time; please be patient."
-	D EN1^XWB2HL7(.RETURN,"200M","RG PRIMARY VIEW REJECT",1,RGSITE,RGICN,RGBDT,RGEDT) I RETURN(0)'="" D  Q
-	.S ^XTMP("RGPVREJ"_RGICN,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"PRIMARY VIEW REJECT"
-	.S ^XTMP("RGPVREJ"_RGICN,RGBDT)=RETURN(0)_"^"_$$NOW^XLFDT
-	.;Has data returned for this query?
-	.S CNT=0 F  S CNT=CNT+1 D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) Q:RESULT(0)  H 2 I CNT>15 Q  ;result(0)=status of handle
-	.I +RESULT(0)=1 W !?3,"Query data has returned from the MPI and is available for review."
-	.I +RESULT(0)'=1 D FAIL  ;**53
-	W !!?3,"Problem with Query: ",RETURN(0)_"^"_$G(RETURN(1))
-	S QUIT=1
-	D PAUSE^VALM1
-	Q
-	;
-FAIL	;Status of RPC call - unsuccessful after 30 seconds ;**53
-	W !?3,"Your query request has NOT returned data from the MPI after trying for"
-	W !?3,"30 seconds. This could be due to network issues. Please try again later."
-	K ^XTMP("RGPVREJ"_RGICN,RGBDT)
-	S QUIT=1
-	D PAUSE^VALM1
-	Q
-	;
+RGPVREJ ;BIR/PTD-REMOTE PRIMARY VIEW REJECT (PATIENT) ;10/8/06
+ ;;1.0;CLINICAL INFO RESOURCE NETWORK;**44,47**;30 Apr 99;Build 10
+ ;
+ ;Reference to ^XWB2HL7 supported by IA #3144
+ ;Reference to ^XWBDRPC supported by IA #3149
+ ;
+REJ ;Option only available for Primary View Reject exceptions
+ ;From within the Exception Handler, for selection, DATA should be defined.
+ N RGBDT,RGICN,RGSITE,PTEN,PELV
+ I DATA="" W !,"No Exception Data available." Q
+ S PTEN=$P(DATA,"^",10) ;IEN IN 991.1
+ S PELV=$P(DATA,"^",11) ;IEN IN 991.12
+ I $P($G(^RGHL7(991.1,PTEN,1,PELV,0)),"^",3)'=234 S VALMSG="Action is ONLY for PRIMARY VIEW REJECT exceptions!" Q
+ I $P($G(^RGHL7(991.1,PTEN,1,PELV,0)),"^",5)=1 S VALMSG="Exception has been PROCESSED; no longer active." Q
+ S RGSITE=$P($$SITE^VASITE(),"^",3) I RGSITE="" W !,"No Site Data defined." Q
+ S RGICN=$P(DATA,"^",6) I RGICN="" W !,"No ICN defined." Q
+ S RGBDT=$P(DATA,"^",3) I RGBDT="" W !,"No Exception Date defined." Q
+ S X=RGBDT D ^%DT S RGBDT=Y ;convert Exception Date from external format to internal
+ ;
+ S VALMBCK="",QUIT=0
+ D FULL^VALM1
+SEND ;Send a remote query to the MPI for Primary View Reject report
+ N RETURN,RESULT,RGEDT,SNTDT
+ S RGEDT=$$DT^XLFDT ;End date for report internal format
+NOQ ;No previous query exists for this ICN/exception date
+ I '$D(^XTMP("RGPVREJ",RGICN,RGBDT)) D RPC G DISP
+ ;
+OLDQ ;Query already sent for this ICN/ exception date
+ I $D(^XTMP("RGPVREJ",RGICN,RGBDT)) D
+ .S SNTDT=$$FMTE^XLFDT($P(^XTMP("RGPVREJ",RGICN,RGBDT),"^",2))
+ .W !?3,"A query was last sent for this ICN/Exception Date on "_SNTDT
+ .S X=$P(SNTDT,"@") D ^%DT S SNTDT=Y ;convert to internal, strip time
+ .;Has data returned for existing query?
+ .S RETURN(0)=$P(^XTMP("RGPVREJ",RGICN,RGBDT),"^")
+ .D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) I +RESULT(0)=1 D  Q  ;Data has returned
+ ..I RGEDT=SNTDT D  ;query was sent 'today', want to use that one?
+ ...S DIR("A")="   Do you wish to review that existing query data now? ",DIR(0)="YA"
+ ...S DIR("?")="     Enter YES to review the existing query; NO to send a new query"
+ ...S DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S QUIT=1 Q  ;up-arrowed out
+ ...I Y>0 K DIR Q  ;yes, use existing query
+ ...I Y=0 D  Q  ;no, don't use existing, send new query
+ ....K ^XTMP("RGPVREJ",RGICN,RGBDT)
+ ....D RPC
+ ....K DIR
+ ....;
+ ..I RGEDT'=SNTDT D  ;query was NOT sent 'today', data may be old, send new query
+ ...W !?3,"Previous Query data may be obsolete."
+ ...K ^XTMP("RGPVREJ",RGICN,RGBDT)
+ ...D RPC
+ .;Data for existing query has NOT returned  **47
+ .I +RESULT(0)'=1 S QUIT=1 W !?3,"Query data has NOT returned from the MPI; please check back later." D PAUSE^VALM1
+ ;
+DISP ;Display Primary View Reject Data
+ I QUIT'=1 D EN^RGEX07(RGICN,RGBDT)
+EXIT ;Kill variables and quit
+ K CNT,DIR,DIRUT,QUIT,X,Y
+ Q
+ ;
+RPC ;Send the Remote Query
+ W !?3,"Sending a Remote Query to the Master Patient Index."
+ W !?3,"This will take some time; please be patient."
+ D EN1^XWB2HL7(.RETURN,"200M","RG PRIMARY VIEW REJECT",1,RGSITE,RGICN,RGBDT,RGEDT) I RETURN(0)'="" D  Q
+ .S ^XTMP("RGPVREJ",0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"PRIMARY VIEW REJECT"
+ .S ^XTMP("RGPVREJ",RGICN,RGBDT)=RETURN(0)_"^"_$$NOW^XLFDT
+ .;Has data returned for this query?
+ .S CNT=0 F  S CNT=CNT+1 D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) Q:RESULT(0)  H 2 I CNT>15 Q  ;result(0)=status of handle
+ .I +RESULT(0)=1 W !?3,"Query data has returned from the MPI and is available for review."
+ .I +RESULT(0)'=1 D  ;quit, info not back after 30 seconds
+ ..W !?3,"Query data has NOT returned from the MPI; please check back later."
+ ..S QUIT=1
+ ..D PAUSE^VALM1
+ W !!?3,"Problem with Query: ",RETURN(0)_"^"_$G(RETURN(1))
+ S QUIT=1
+ D PAUSE^VALM1
+ Q
+ ;
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGRSBUL1.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGRSBUL1.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGRSBUL1.m	(revision 623)
@@ -1,153 +1,150 @@
-RGRSBUL1	;ALB/RJS,CML-RGRSTEXT BULLETIN ROUTINE (PART 2) ;07/24/98
-	;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,19,52**;30 Apr 99;Build 2
-	;
-SSNBULL(DFN,ARRAY,NAME,SSN,ICN,CMOR)	;
-	;Entry point generates a bulletin to the RG CIRN DEMOGRAPHIC
-	;ISSUES mail group about an SSN change for a given patient.
-	;
-	;Input:  Required Variables
-	;
-	;   DFN   - IEN in the PATIENT file (#2)
-	;  ARRAY  - Array of data containing sending sites station number
-	;   NAME  - Patient's Name
-	;   SSN   - Patient's SSN
-	;   ICN   - Patient's ICN (Integration Control Number) 
-	;   CMOR  - Patient's CMOR (Coordinating Master of Record)
-	;
-	Q:$G(DFN)=""!($G(ARRAY)="")
-	N LOCDATA,RGRSTEXT,INDEX,COUNTER
-	S RGRSTEXT(1)="The MPI/PD Package has received an SSN change from:"
-	S RGRSTEXT(2)=$$INST(@ARRAY@("SENDING SITE"))
-	S RGRSTEXT(3)="           "
-	S RGRSTEXT(4)="This change has been made in your local data base for:"
-	S RGRSTEXT(5)=NAME
-	S RGRSTEXT(6)="           "
-	S RGRSTEXT(7)="=> Local "_$P($$SITE^VASITE(),"^",2)_" data PRIOR to update:"
-	S RGRSTEXT(8)="NAME: "_NAME
-	S RGRSTEXT(9)="SSN: "_SSN
-	S RGRSTEXT(10)="ICN: "_ICN
-	S RGRSTEXT(11)="CMOR: "_CMOR
-	S RGRSTEXT(12)="--------------------------------------------------------"
-	S RGRSTEXT(13)="=> Update received from "_$P($$INST(@ARRAY@("SENDING SITE"))," -->")_":"
-	S RGRSTEXT(14)="SSN: "_@ARRAY@("SSN")
-	D BULL2^RGRSBULL("MPI/PD SSN CHANGE - "_NAME,"RGRSTEXT(")
-	Q
-	;
-NOT2(ARRAY)	;
-	;Entry point generates a bulletin to the RG CIRN DEMOGRAPHIC
-	;ISSUES mail group about invalid subscription information for a given
-	;patient.
-	;
-	;Input:  Required Variables
-	;
-	;  ARRAY  - Array of information regarding the invalid subscription
-	;
-	Q:($G(ARRAY)="")
-	N RGRSTEXT,INDEX,COUNTER
-	S RGRSTEXT(1)="The MPI/PD Package has received a message from:"
-	S RGRSTEXT(2)=$$INST(@ARRAY@("SENDING SITE"))
-	S RGRSTEXT(3)="This patient has your station as a subscriber, however"
-	S RGRSTEXT(4)="the patient was not found in your database."
-	S RGRSTEXT(5)="--------------------------------------------------------"
-	S RGRSTEXT(6)="Remote Data"
-	S RGRSTEXT(7)="           "
-	S INDEX=0,COUNTER=8
-	F  S INDEX=$O(@ARRAY@("MESSAGE",INDEX)) Q:INDEX']""  D
-	. S RGRSTEXT(COUNTER)=@ARRAY@("MESSAGE",INDEX)
-	. S COUNTER=COUNTER+1
-	D BULL2^RGRSBULL("MPI/PD - PATIENT NOT FOUND","RGRSTEXT(")
-	Q
-	;
-SENSTIVE(DFN,ARRAY,NAME)	;FIRES WHEN PT. IS FLAGGED AS SENSITIVE AT ANOTHER SITE
-	;Entry point generates a bulletin to the RG CIRN DEMOGRAPHIC
-	;ISSUES mail group when a given patient is flagged as sensitive at
-	;another site.
-	;
-	;Input:  Required Variables
-	;
-	;   DFN  - IEN in the PATIENT file (#2)
-	;  ARRAY - Array of data containing sending sites station number and SSN
-	;  NAME  - Patient's name
-	;  CMOR  - Coordinating Master of Record
-	;
-	Q:($G(ARRAY)="")!($G(DFN)="")
-	N RGRSTEXT,INDEX,COUNTER,CMOR
-	S CMOR=$$CMOR2^MPIF001(DFN) I $P(CMOR,"^")<0 S CMOR="not assigned"
-	S RGRSTEXT(1)="The MPI/PD Package has received a message from:"
-	S RGRSTEXT(2)=$$INST(@ARRAY@("SENDING SITE"))
-	S RGRSTEXT(3)="   "
-	S RGRSTEXT(4)="This message indicates that patient "_NAME_" is flagged"
-	S RGRSTEXT(5)="as Sensitive at the other facility but is not flagged as"
-	S RGRSTEXT(6)="Sensitive at your facility."
-	S RGRSTEXT(7)="  "
-	S RGRSTEXT(8)="Remote Patient SSN: "_$S(@ARRAY@("SSN")="":"Not Available",1:@ARRAY@("SSN"))
-	S RGRSTEXT(9)="Remote User who Flagged the Patient as Sensitive: "_@ARRAY@("SENSITIVITY USER")
-	S RGRSTEXT(10)="Date/Time Remote User Flagged Patient Sensitive:  "_$$FMTE^XLFDT(@ARRAY@("SENSITIVITY DATE"))
-	S RGRSTEXT(11)="  "
-	S RGRSTEXT(12)="CMOR Site: "_CMOR
-	D BULL2^RGRSBULL("Remote Sensitivity Indicated","RGRSTEXT(")
-	Q
-	;
-	;MPIC_772 - **52; Commented out Remote Date of Death Indicated module.
-	;Only RGADTP2 and RGRSPT called this module; and both have been commented out.
-RMTDOD(DFN,ARRAY,NAME,RDOD,LDOD)	;Fires when patient has a Date of Death at another site
-	;Entry point generates a bulletin to the RG CIRN DEMOGRAPHIC
-	;ISSUES mail group when a given patient has a Date of Death at
-	;another site.
-	;
-	;Input:  Required Variables
-	;
-	;  DFN   - IEN in the PATIENT file (#2)
-	;  ARRAY - Array of data containing sending sites station number and SSN
-	;  NAME  - Patient's name
-	;  RDOD  - Date of Death at remote site
-	;  LDOD  - Date of Death at local site
-	;  CMOR  - Coordinating Master of Record
-	;
-	;Q:($G(ARRAY)="")!($G(DFN)="")
-	;Q:(RDOD=LDOD)  ;If remote DOD and local DOD same, QUIT
-	;N CMOR
-	;S CMOR=$$CMOR2^MPIF001(DFN) I $P(CMOR,"^")<0 S CMOR="not assigned"
-	;N RGRSTEXT
-	;S RGRSTEXT(1)="The MPI/PD Package has received a message from:"
-	;S RGRSTEXT(2)=$$INST(@ARRAY@("SENDING SITE"))
-	;S RGRSTEXT(3)="   "
-	;S RGRSTEXT(4)="This message indicates that patient "_NAME
-	;I 'LDOD S RGRSTEXT(5)="has a date of death at the other facility but not at your facility." G RMTMSG
-	;I LDOD,(LDOD'=RDOD) S RGRSTEXT(5)="has a different date of death at the other facility than at your facility."
-RMTMSG	;S RGRSTEXT(6)="  "
-	;S RGRSTEXT(7)="Remote Patient SSN: "_$S(@ARRAY@("SSN")="":"Not Available",1:@ARRAY@("SSN"))
-	;S RGRSTEXT(8)="Date of Death from other facility:  "_$$FMTE^XLFDT(RDOD)
-	;I LDOD,(LDOD'=RDOD) S RGRSTEXT(9)="Date of Death at your facility:  "_$$FMTE^XLFDT(LDOD)
-	;S RGRSTEXT(10)="  "
-	;S RGRSTEXT(11)="CMOR site: "_CMOR
-	;D BULL2^RGRSBULL("Remote Date of Death Indicated","RGRSTEXT(")
-	Q
-	;
-INST(SITENUM)	;
-	N RETURN,IEN,DATA,NAME,NUMBER
-	S RETURN=""
-	Q:$G(SITENUM)="" RETURN
-	S IEN=$$LKUP^XUAF4(SITENUM)
-	I IEN>0 S DATA=$$NS^XUAF4(IEN)
-	I $G(DATA)]"" D 
-	. S NAME=$P(DATA,"^",1),NUMBER=$P(DATA,"^",2)
-	. S RETURN=NAME_" --> Site Number: "_NUMBER
-	Q RETURN
-	;
-FORMAT(DATA1,DATA2)	;
-	N SPACES,SPACENUM,LENGTH1,LENGTH2,RETURN
-	S SPACES="                       "
-	S LENGTH1=$L(DATA1),LENGTH2=$L(DATA2)
-	I LENGTH1>23 S DATA1=$E(DATA1,1,23) S LENGTH1=23
-	I LENGTH2>22 S DATA2=$E(DATA2,1,22)
-	S SPACENUM=23-LENGTH1
-	S SPACES=$E(SPACES,1,SPACENUM)
-	S RETURN=DATA1_SPACES_" "_DATA2
-	Q $G(RETURN)
-	;
-FREE(DATA)	;
-	Q:$G(DATA)="" ""
-	Q:$G(DATA)["@" ""
-	Q:$G(DATA)=HL("Q") ""
-	Q $G(DATA)
+RGRSBUL1 ;ALB/RJS,CML-RGRSTEXT BULLETIN ROUTINE (PART 2) ;07/24/98
+ ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,19**;30 Apr 99
+SSNBULL(DFN,ARRAY,NAME,SSN,ICN,CMOR) ;
+ ;Entry point generates a bulletin to the RG CIRN DEMOGRAPHIC
+ ;ISSUES mail group about an SSN change for a given patient.
+ ;
+ ;Input:  Required Variables
+ ;
+ ;   DFN   - IEN in the PATIENT file (#2)
+ ;  ARRAY  - Array of data containing sending sites station number
+ ;   NAME  - Patient's Name
+ ;   SSN   - Patient's SSN
+ ;   ICN   - Patient's ICN (Integration Control Number) 
+ ;   CMOR  - Patient's CMOR (Coordinating Master of Record)
+ ;
+ Q:$G(DFN)=""!($G(ARRAY)="")
+ N LOCDATA,RGRSTEXT,INDEX,COUNTER
+ S RGRSTEXT(1)="The MPI/PD Package has received an SSN change from:"
+ S RGRSTEXT(2)=$$INST(@ARRAY@("SENDING SITE"))
+ S RGRSTEXT(3)="           "
+ S RGRSTEXT(4)="This change has been made in your local data base for:"
+ S RGRSTEXT(5)=NAME
+ S RGRSTEXT(6)="           "
+ S RGRSTEXT(7)="=> Local "_$P($$SITE^VASITE(),"^",2)_" data PRIOR to update:"
+ S RGRSTEXT(8)="NAME: "_NAME
+ S RGRSTEXT(9)="SSN: "_SSN
+ S RGRSTEXT(10)="ICN: "_ICN
+ S RGRSTEXT(11)="CMOR: "_CMOR
+ S RGRSTEXT(12)="--------------------------------------------------------"
+ S RGRSTEXT(13)="=> Update received from "_$P($$INST(@ARRAY@("SENDING SITE"))," -->")_":"
+ S RGRSTEXT(14)="SSN: "_@ARRAY@("SSN")
+ D BULL2^RGRSBULL("MPI/PD SSN CHANGE - "_NAME,"RGRSTEXT(")
+ Q
+ ;
+NOT2(ARRAY) ;
+ ;Entry point generates a bulletin to the RG CIRN DEMOGRAPHIC
+ ;ISSUES mail group about invalid subscription information for a given
+ ;patient.
+ ;
+ ;Input:  Required Variables
+ ;
+ ;  ARRAY  - Array of information regarding the invalid subscription
+ ;
+ Q:($G(ARRAY)="")
+ N RGRSTEXT,INDEX,COUNTER
+ S RGRSTEXT(1)="The MPI/PD Package has received a message from:"
+ S RGRSTEXT(2)=$$INST(@ARRAY@("SENDING SITE"))
+ S RGRSTEXT(3)="This patient has your station as a subscriber, however"
+ S RGRSTEXT(4)="the patient was not found in your database."
+ S RGRSTEXT(5)="--------------------------------------------------------"
+ S RGRSTEXT(6)="Remote Data"
+ S RGRSTEXT(7)="           "
+ S INDEX=0,COUNTER=8
+ F  S INDEX=$O(@ARRAY@("MESSAGE",INDEX)) Q:INDEX']""  D
+ . S RGRSTEXT(COUNTER)=@ARRAY@("MESSAGE",INDEX)
+ . S COUNTER=COUNTER+1
+ D BULL2^RGRSBULL("MPI/PD - PATIENT NOT FOUND","RGRSTEXT(")
+ Q
+ ;
+SENSTIVE(DFN,ARRAY,NAME) ;FIRES WHEN PT. IS FLAGGED AS SENSITIVE AT ANOTHER SITE
+ ;Entry point generates a bulletin to the RG CIRN DEMOGRAPHIC
+ ;ISSUES mail group when a given patient is flagged as sensitive at
+ ;another site.
+ ;
+ ;Input:  Required Variables
+ ;
+ ;   DFN  - IEN in the PATIENT file (#2)
+ ;  ARRAY - Array of data containing sending sites station number and SSN
+ ;  NAME  - Patient's name
+ ;  CMOR  - Coordinating Master of Record
+ ;
+ Q:($G(ARRAY)="")!($G(DFN)="")
+ N RGRSTEXT,INDEX,COUNTER,CMOR
+ S CMOR=$$CMOR2^MPIF001(DFN) I $P(CMOR,"^")<0 S CMOR="not assigned"
+ S RGRSTEXT(1)="The MPI/PD Package has received a message from:"
+ S RGRSTEXT(2)=$$INST(@ARRAY@("SENDING SITE"))
+ S RGRSTEXT(3)="   "
+ S RGRSTEXT(4)="This message indicates that patient "_NAME_" is flagged"
+ S RGRSTEXT(5)="as Sensitive at the other facility but is not flagged as"
+ S RGRSTEXT(6)="Sensitive at your facility."
+ S RGRSTEXT(7)="  "
+ S RGRSTEXT(8)="Remote Patient SSN: "_$S(@ARRAY@("SSN")="":"Not Available",1:@ARRAY@("SSN"))
+ S RGRSTEXT(9)="Remote User who Flagged the Patient as Sensitive: "_@ARRAY@("SENSITIVITY USER")
+ S RGRSTEXT(10)="Date/Time Remote User Flagged Patient Sensitive:  "_$$FMTE^XLFDT(@ARRAY@("SENSITIVITY DATE"))
+ S RGRSTEXT(11)="  "
+ S RGRSTEXT(12)="CMOR Site: "_CMOR
+ D BULL2^RGRSBULL("Remote Sensitivity Indicated","RGRSTEXT(")
+ Q
+ ;
+RMTDOD(DFN,ARRAY,NAME,RDOD,LDOD) ;Fires when patient has a Date of Death at another site
+ ;Entry point generates a bulletin to the RG CIRN DEMOGRAPHIC
+ ;ISSUES mail group when a given patient has a Date of Death at
+ ;another site.
+ ;
+ ;Input:  Required Variables
+ ;
+ ;  DFN   - IEN in the PATIENT file (#2)
+ ;  ARRAY - Array of data containing sending sites station number and SSN
+ ;  NAME  - Patient's name
+ ;  RDOD  - Date of Death at remote site
+ ;  LDOD  - Date of Death at local site
+ ;  CMOR  - Coordinating Master of Record
+ ;
+ Q:($G(ARRAY)="")!($G(DFN)="")
+ Q:(RDOD=LDOD)  ;If remote DOD and local DOD same, QUIT
+ N CMOR
+ S CMOR=$$CMOR2^MPIF001(DFN) I $P(CMOR,"^")<0 S CMOR="not assigned"
+ N RGRSTEXT
+ S RGRSTEXT(1)="The MPI/PD Package has received a message from:"
+ S RGRSTEXT(2)=$$INST(@ARRAY@("SENDING SITE"))
+ S RGRSTEXT(3)="   "
+ S RGRSTEXT(4)="This message indicates that patient "_NAME
+ I 'LDOD S RGRSTEXT(5)="has a date of death at the other facility but not at your facility." G RMTMSG
+ I LDOD,(LDOD'=RDOD) S RGRSTEXT(5)="has a different date of death at the other facility than at your facility."
+RMTMSG S RGRSTEXT(6)="  "
+ S RGRSTEXT(7)="Remote Patient SSN: "_$S(@ARRAY@("SSN")="":"Not Available",1:@ARRAY@("SSN"))
+ S RGRSTEXT(8)="Date of Death from other facility:  "_$$FMTE^XLFDT(RDOD)
+ I LDOD,(LDOD'=RDOD) S RGRSTEXT(9)="Date of Death at your facility:  "_$$FMTE^XLFDT(LDOD)
+ S RGRSTEXT(10)="  "
+ S RGRSTEXT(11)="CMOR site: "_CMOR
+ D BULL2^RGRSBULL("Remote Date of Death Indicated","RGRSTEXT(")
+ Q
+ ;
+INST(SITENUM) ;
+ N RETURN,IEN,DATA,NAME,NUMBER
+ S RETURN=""
+ Q:$G(SITENUM)="" RETURN
+ S IEN=$$LKUP^XUAF4(SITENUM)
+ I IEN>0 S DATA=$$NS^XUAF4(IEN)
+ I $G(DATA)]"" D 
+ . S NAME=$P(DATA,"^",1),NUMBER=$P(DATA,"^",2)
+ . S RETURN=NAME_" --> Site Number: "_NUMBER
+ Q RETURN
+ ;
+FORMAT(DATA1,DATA2) ;
+ N SPACES,SPACENUM,LENGTH1,LENGTH2,RETURN
+ S SPACES="                       "
+ S LENGTH1=$L(DATA1),LENGTH2=$L(DATA2)
+ I LENGTH1>23 S DATA1=$E(DATA1,1,23) S LENGTH1=23
+ I LENGTH2>22 S DATA2=$E(DATA2,1,22)
+ S SPACENUM=23-LENGTH1
+ S SPACES=$E(SPACES,1,SPACENUM)
+ S RETURN=DATA1_SPACES_" "_DATA2
+ Q $G(RETURN)
+ ;
+FREE(DATA) ;
+ Q:$G(DATA)="" ""
+ Q:$G(DATA)["@" ""
+ Q:$G(DATA)=HL("Q") ""
+ Q $G(DATA)
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGRSPT.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGRSPT.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGRSPT.m	(revision 623)
@@ -1,99 +1,98 @@
-RGRSPT	;ALB/RJS,CML-HIGH LEVEL ROUTINE FOR PARSING AND FILING ;06/25/98
-	;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,7,8,52**;30 Apr 99;Build 2
-	;
-	;Parse Incoming Message, and file.
-	;
-	;
-	Q:($G(HL("MTN"))'="ADT")
-	N RGRSDFN,VAFCA,RGRS,VAFCA08,RGRSARAY,BOGUS,RGDC,SENSTVTY,CMORDISP
-	N NAME,LASTNAME,SSN,ICN,CMOR,CMORIEN,OTHSITE,RGRSDATA,HERE,BULSUB,NODE
-	S RGRSARAY="RGRS(2)"
-	D INITIZE^RGRSUTIL ;copy HL7 message into local RGDC array
-	S VAFCA=$$EN^RGRSMSH() ;parse MSH for filer
-	D EN^RGRSPARS(RGRSARAY) ;parse HL7 message into local array RGRS
-	I $$SKIP^RGRSZZPT(1,RGRSARAY) D  G EXIT ;skip if certain data is not there
-	. D SKIPBULL^RGRSBULL(RGRSARAY)
-	S RGRSDFN=$$GETDFN^MPIF001(@RGRSARAY@(991.01)) ;Get DFN from ICN
-	Q:+$$SEND2^VAFCUTL1(RGRSDFN,"T")  ;safeguard to prevent the processing of test patients
-	S OTHSITE=@RGRSARAY@("SITENUM")\1
-	S HERE=$P($$SITE^VASITE,"^",3)\1
-	;
-	;If patient not known in site, send bulletin, go exit
-	;
-	I +RGRSDFN=-1 D EXC^RGHLLOG(210,"Msg#"_$G(HL("MID"))_" Bad DFN#"_$G(RGRSDFN)_" for "_$G(@RGRSARAY@(.01))_" (ICN#"_$G(@RGRSARAY@(991.01))_")") D STOP^RGHLLOG(1) Q
-	;
-	S NAME=$$GET1^DIQ(2,+RGRSDFN_",",.01)
-	S LASTNAME=$P(NAME,",",1)
-	S SSN=$$GET1^DIQ(2,+RGRSDFN_",",.09)
-	S NODE=$$MPINODE^MPIFAPI(RGRSDFN)
-	S ICN=$P(NODE,"^")
-	S CMORIEN=$P(NODE,"^",3)
-	S CMOR=$$NS^XUAF4(CMORIEN)
-	S CMORDISP=$P(CMOR,"^",1)
-	S CMOR=$P(CMOR,"^",2)
-	;
-	S @RGRSARAY@("NAME")=@RGRSARAY@(.01)
-	S @RGRSARAY@("SSN")=@RGRSARAY@(.09)
-	S @RGRSARAY@("ICN")=@RGRSARAY@(991.01)
-	S @RGRSARAY@("CMOR")=$P($$NS^XUAF4($$LKUP^XUAF4(OTHSITE)),"^")
-	;
-	;If ICN or CMOR don't match, send bulletin and go exit
-	I '$$MATCH(RGRSDFN,RGRSARAY,,,ICN,CMOR,.BULSUB) D  G EXIT
-	. D MTCHBULL^RGRSBULL(RGRSDFN,RGRSARAY,NAME,SSN,ICN,CMORDISP,BULSUB)
-	;
-	;if ICN and CMOR match, check for SSN edit from CMOR
-	I @RGRSARAY@("SENDING SITE")=CMOR,(SSN'=@RGRSARAY@(.09)) D
-	.D SSNBULL^RGRSBUL1(RGRSDFN,RGRSARAY,NAME,SSN,ICN,CMORDISP)
-	;
-	;If patient is Sensitive at other site but not here send bulletin
-	S SENSTVTY=$G(@RGRSARAY@("SENSITIVITY"))
-	I '$$SENSTIVE^RGRSENS(RGRSDFN),SENSTVTY D SENSTIVE^RGRSBUL1(RGRSDFN,RGRSARAY,NAME)
-	;
-	;MPIC_772 - **52; Commented out Remote Date of Death Indicated section.
-	;If patient has DATE OF DEATH (DOD) at remote site send bulletin
-	;Ignore time if present with date.
-	;S RMTDOD=@RGRSARAY@(.351),RMTDOD=$P(RMTDOD,".")
-	;S DFN=RGRSDFN D DEM^VADPT
-	;S LOCDOD=$P($P(VADM(6),"^"),".")
-	;If there is a remote DOD but no local DOD  OR
-	;if remote DOD is different from local DOD, send bulletin
-	;I RMTDOD D RMTDOD^RGRSBUL1(RGRSDFN,RGRSARAY,NAME,RMTDOD,LOCDOD)
-	;K LOCDOD,RMTDOD,VADM
-	;
-	D  G EXIT ;**7
-	. ;
-	. ;IF it's the CMOR - review file
-	. ;
-	. I (OTHSITE)=(HERE) D  Q
-	. . S VAFCA=VAFCA_"^"_RGRSDFN
-	. . S VAFCA08=1 S BOGUS=$$ADD^VAFCEHU1(VAFCA,"RGRS")
-	. ;
-	. ;IF it's not the CMOR - Don't Rebroadcast
-	. ;
-	. I (OTHSITE)'=(HERE) D  Q
-	. . S VAFCA08=1
-	. . D EDIT^VAFCPTED(RGRSDFN,RGRSARAY,".01;.03;.09;.02;.2403") ;**7 broadcasted fields - removed .05,.08,.111;.112;.113;.114;.115;.1112;.117;.131;.132;.211;.219;.31115
-EXIT	;
-	Q
-	;
-MATCH(DFN,RGRSARAY,LASTNAME,SSN,ICN,CMOR,BULSUB)	;
-	Q:$G(DFN)=""!($G(RGRSARAY)="") 0
-	N COUNT,TRUE S (COUNT,TRUE)=0
-	S BULSUB=""
-	I $D(LASTNAME) D
-	. S COUNT=COUNT+1
-	. I (LASTNAME'=""),(LASTNAME=$P(@RGRSARAY@(.01),",",1)) S TRUE=TRUE+1
-	I $D(SSN) D
-	. S COUNT=COUNT+1
-	. I (SSN'=""),(SSN=$G(@RGRSARAY@(.09))) S TRUE=TRUE+1
-	I $D(ICN) D
-	. S COUNT=COUNT+1
-	. I (ICN'=""),(ICN=$G(@RGRSARAY@(991.01))) S TRUE=TRUE+1 Q
-	. S BULSUB=BULSUB_"ICN"
-	I $D(CMOR) D
-	. S COUNT=COUNT+1
-	. I (CMOR'=""),(CMOR=$G(@RGRSARAY@("SITENUM"))) S TRUE=TRUE+1 Q
-	. I BULSUB]"" S BULSUB=BULSUB_" & "
-	. S BULSUB=BULSUB_"CMOR"
-	I COUNT=TRUE Q 1
-	Q 0
+RGRSPT ;ALB/RJS,CML-HIGH LEVEL ROUTINE FOR PARSING AND FILING ;06/25/98
+ ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,7,8**;30 Apr 99
+ ;
+ ;Parse Incoming Message, and file.
+ ;
+ ;
+ Q:($G(HL("MTN"))'="ADT")
+ N RGRSDFN,VAFCA,RGRS,VAFCA08,RGRSARAY,BOGUS,RGDC,SENSTVTY,CMORDISP
+ N NAME,LASTNAME,SSN,ICN,CMOR,CMORIEN,OTHSITE,RGRSDATA,HERE,BULSUB,NODE
+ S RGRSARAY="RGRS(2)"
+ D INITIZE^RGRSUTIL ;copy HL7 message into local RGDC array
+ S VAFCA=$$EN^RGRSMSH() ;parse MSH for filer
+ D EN^RGRSPARS(RGRSARAY) ;parse HL7 message into local array RGRS
+ I $$SKIP^RGRSZZPT(1,RGRSARAY) D  G EXIT ;skip if certain data is not there
+ . D SKIPBULL^RGRSBULL(RGRSARAY)
+ S RGRSDFN=$$GETDFN^MPIF001(@RGRSARAY@(991.01)) ;Get DFN from ICN
+ Q:+$$SEND2^VAFCUTL1(RGRSDFN,"T")  ;safeguard to prevent the processing of test patients
+ S OTHSITE=@RGRSARAY@("SITENUM")\1
+ S HERE=$P($$SITE^VASITE,"^",3)\1
+ ;
+ ;If patient not known in site, send bulletin, go exit
+ ;
+ I +RGRSDFN=-1 D EXC^RGHLLOG(210,"Msg#"_$G(HL("MID"))_" Bad DFN#"_$G(RGRSDFN)_" for "_$G(@RGRSARAY@(.01))_" (ICN#"_$G(@RGRSARAY@(991.01))_")") D STOP^RGHLLOG(1) Q
+ ;
+ S NAME=$$GET1^DIQ(2,+RGRSDFN_",",.01)
+ S LASTNAME=$P(NAME,",",1)
+ S SSN=$$GET1^DIQ(2,+RGRSDFN_",",.09)
+ S NODE=$$MPINODE^MPIFAPI(RGRSDFN)
+ S ICN=$P(NODE,"^")
+ S CMORIEN=$P(NODE,"^",3)
+ S CMOR=$$NS^XUAF4(CMORIEN)
+ S CMORDISP=$P(CMOR,"^",1)
+ S CMOR=$P(CMOR,"^",2)
+ ;
+ S @RGRSARAY@("NAME")=@RGRSARAY@(.01)
+ S @RGRSARAY@("SSN")=@RGRSARAY@(.09)
+ S @RGRSARAY@("ICN")=@RGRSARAY@(991.01)
+ S @RGRSARAY@("CMOR")=$P($$NS^XUAF4($$LKUP^XUAF4(OTHSITE)),"^")
+ ;
+ ;If ICN or CMOR don't match, send bulletin and go exit
+ I '$$MATCH(RGRSDFN,RGRSARAY,,,ICN,CMOR,.BULSUB) D  G EXIT
+ . D MTCHBULL^RGRSBULL(RGRSDFN,RGRSARAY,NAME,SSN,ICN,CMORDISP,BULSUB)
+ ;
+ ;if ICN and CMOR match, check for SSN edit from CMOR
+ I @RGRSARAY@("SENDING SITE")=CMOR,(SSN'=@RGRSARAY@(.09)) D
+ .D SSNBULL^RGRSBUL1(RGRSDFN,RGRSARAY,NAME,SSN,ICN,CMORDISP)
+ ;
+ ;If patient is Sensitive at other site but not here send bulletin
+ S SENSTVTY=$G(@RGRSARAY@("SENSITIVITY"))
+ I '$$SENSTIVE^RGRSENS(RGRSDFN),SENSTVTY D SENSTIVE^RGRSBUL1(RGRSDFN,RGRSARAY,NAME)
+ ;
+ ;If patient has DATE OF DEATH (DOD) at remote site send bulletin
+ ;Ignore time if present with date.
+ S RMTDOD=@RGRSARAY@(.351),RMTDOD=$P(RMTDOD,".")
+ S DFN=RGRSDFN D DEM^VADPT
+ S LOCDOD=$P($P(VADM(6),"^"),".")
+ ;If there is a remote DOD but no local DOD  OR
+ ;if remote DOD is different from local DOD, send bulletin
+ I RMTDOD D RMTDOD^RGRSBUL1(RGRSDFN,RGRSARAY,NAME,RMTDOD,LOCDOD)
+ K LOCDOD,RMTDOD,VADM
+ ;
+ D  G EXIT ;**7
+ . ;
+ . ;IF it's the CMOR - review file
+ . ;
+ . I (OTHSITE)=(HERE) D  Q
+ . . S VAFCA=VAFCA_"^"_RGRSDFN
+ . . S VAFCA08=1 S BOGUS=$$ADD^VAFCEHU1(VAFCA,"RGRS")
+ . ;
+ . ;IF it's not the CMOR - Don't Rebroadcast
+ . ;
+ . I (OTHSITE)'=(HERE) D  Q
+ . . S VAFCA08=1
+ . . D EDIT^VAFCPTED(RGRSDFN,RGRSARAY,".01;.03;.09;.02;.2403") ;**7 broadcasted fields - removed .05,.08,.111;.112;.113;.114;.115;.1112;.117;.131;.132;.211;.219;.31115
+EXIT ;
+ Q
+ ;
+MATCH(DFN,RGRSARAY,LASTNAME,SSN,ICN,CMOR,BULSUB) ;
+ Q:$G(DFN)=""!($G(RGRSARAY)="") 0
+ N COUNT,TRUE S (COUNT,TRUE)=0
+ S BULSUB=""
+ I $D(LASTNAME) D
+ . S COUNT=COUNT+1
+ . I (LASTNAME'=""),(LASTNAME=$P(@RGRSARAY@(.01),",",1)) S TRUE=TRUE+1
+ I $D(SSN) D
+ . S COUNT=COUNT+1
+ . I (SSN'=""),(SSN=$G(@RGRSARAY@(.09))) S TRUE=TRUE+1
+ I $D(ICN) D
+ . S COUNT=COUNT+1
+ . I (ICN'=""),(ICN=$G(@RGRSARAY@(991.01))) S TRUE=TRUE+1 Q
+ . S BULSUB=BULSUB_"ICN"
+ I $D(CMOR) D
+ . S COUNT=COUNT+1
+ . I (CMOR'=""),(CMOR=$G(@RGRSARAY@("SITENUM"))) S TRUE=TRUE+1 Q
+ . I BULSUB]"" S BULSUB=BULSUB_" & "
+ . S BULSUB=BULSUB_"CMOR"
+ I COUNT=TRUE Q 1
+ Q 0
Index: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGSYSTAT.m
===================================================================
--- WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGSYSTAT.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGSYSTAT.m	(revision 623)
@@ -1,102 +1,101 @@
-RGSYSTAT	;BAY/ALS-MPI/PD STATUS DISPLAY ;01/05/01
-	;;1.0;CLINICAL INFO RESOURCE NETWORK;**16,19,23,25,20,43,45,52**;30 Apr 99;Build 2
-	;
-	;Reference to ^DGCN(391.98,"AST" supported by IA #3303
-	;Reference to ^DGCN(391.984 supported by IA #3304
-	;Reference to ^MPIF(984.9 supported by IA #3298
-	;Reference to OPTSTAT^XUTMOPT supported by IA #1472
-	;Reference to ^DPT("ACMORS", ^DPT("AICN", and ^DPT("AICNL" supported by IA #2070
-	;Reference to ^VAT(391.71 supported by IA #3422
-EN	;
-	; Count exceptions on hand
-EXC	;
-	W @IOF,"Exception Handler Entries:",!,"--------------------------"
-	S CNT=0,EXCTYP="",NTYP="",TOTL=0,PCNT=0
-	N STAT,DFN,ICN
-	S HOME=$$SITE^VASITE()
-	F  S EXCTYP=$O(^RGHL7(991.1,"AC",EXCTYP)) Q:'EXCTYP  D
-	. I (EXCTYP=234)!(EXCTYP=218) D  ;**45;MPIC_772; **52 remove 215, 216, 217, & 227
-	.. I (EXCTYP'=NTYP)&(CNT>0) D
-	... S ETEXT=$P($G(^RGHL7(991.11,NTYP,10)),"^",1)
-	... W !,$E(ETEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT,CNT=0
-	.. S IEN=0,NTYP=EXCTYP
-	.. F  S IEN=$O(^RGHL7(991.1,"AC",EXCTYP,IEN)) Q:'IEN  D
-	... S IEN2=0
-	... F  S IEN2=$O(^RGHL7(991.1,"AC",EXCTYP,IEN,IEN2)) Q:'IEN2  D
-	.... S STAT=$P(^RGHL7(991.1,IEN,1,IEN2,0),"^",5) I STAT<1 D
-	..... S DFN=$P(^RGHL7(991.1,IEN,1,IEN2,0),"^",4) Q:'DFN
-	..... S ^XTMP("RGEXC",0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"MPI/PD Status Display"
-	..... S ^XTMP("RGEXC",DFN)=DFN
-	..... S ICN=+$$GETICN^MPIF001(DFN)
-	..... I $E(ICN,1,3)=$E($P(HOME,"^",3),1,3)!(ICN<0)!(EXCTYP=234)!(EXCTYP=218) D  ;**43;**45;MPIC_772; **52 remove 215, 216, and 217
-	...... S CNT=CNT+1
-	I CNT>0 D
-	.S ETEXT=$P($G(^RGHL7(991.11,NTYP,10)),"^",1)
-	.W !,$E(ETEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT
-	I TOTL=0 W !,"There are no entries in the Exception Handler."
-	I TOTL>0 D
-	. W !!,"Total number of exceptions: ",?55,$J(TOTL,6)
-	. S PDFN=""
-	. F  S PDFN=$O(^XTMP("RGEXC",PDFN)) Q:'PDFN  D
-	.. S PCNT=PCNT+1
-	. W !,"Total unique patient exceptions: ",?55,$J(PCNT,6)
-	S STDT=$P($G(^RGSITE(991.8,1,"EXCPRG")),"^",1)
-	I $D(^RGSITE(991.8,1,"EXCPRG")) D
-	. S STDT=$$FMTE^XLFDT(STDT,1)
-	. W !!,"The MPI/PD Exception Purge process last ran "_STDT_"."
-	K CNT,EXCTYP,NTYP,ETEXT,TOTL,IEN,IEN2,HOME,PCNT,^XTMP("RGEXC"),PDFN,STDT
-	I $Y>21 D QUIT Q:X="^"
-PDR	;Count entries in Patient Data Review ;**52 Obsolete data removed from report.
-	;W !!,"Patient Data Review Entries:",!,"----------------------------"
-	;S CNT=0,PDRTYP="",NTYP="",TOTL=0
-	;F  S PDRTYP=$O(^DGCN(391.98,"AST",PDRTYP)) Q:'PDRTYP  D
-	;. I (PDRTYP'=NTYP)&(CNT>0) D
-	;.. S DIC="^DGCN(391.984,",DR=".01",DA=NTYP,DIQ(0)="E",DIQ="RGPDR"
-	;.. D EN^DIQ1 K DIC,DA,DR,DIQ
-	;.. S PTEXT=$G(RGPDR(391.984,NTYP,.01,"E"))
-	;.. W !,$E(PTEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT,CNT=0
-	;. I (PDRTYP=1)!(PDRTYP=2)!(PDRTYP=5) D
-	;.. S IEN=0,NTYP=PDRTYP
-	;.. F  S IEN=$O(^DGCN(391.98,"AST",PDRTYP,IEN)) Q:'IEN  D
-	;... S CNT=CNT+1
-	;I CNT>0 D
-	;. S DIC="^DGCN(391.984,",DR=".01",DA=NTYP,DIQ(0)="E",DIQ="RGPDR"
-	;. D EN^DIQ1 K DIC,DA,DR,DIQ
-	;. S PTEXT=$G(RGPDR(391.984,NTYP,.01,"E"))
-	;.W !,$E(PTEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT
-	;I TOTL=0 W !,"There are no entries in Patient Data Review."
-	;K CNT,PDRTYP,NTYP,TOTL,IEN,PTEXT,RGPDR
-	;Q
-	;I $Y>20 D QUIT Q:X="^"
-	;
-CMOR	;CMOR Requests Status ;**52 Obsolete data removed from report.
-	;W !!,"CMOR Requests Status:",!,"---------------------"
-	;S CNT=0,STAT="",NSTAT="",TOTL=0
-	;F  S STAT=$O(^MPIF(984.9,"AC",STAT)) Q:'STAT  D
-	;. I (STAT'=NSTAT)&(CNT>0) D
-	;.. S TEXT=$$EXTERNAL^DILFD(984.9,.06,,NSTAT)
-	;.. W !,$E(TEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT,CNT=0
-	;. S IEN=0,NSTAT=STAT
-	;. F  S IEN=$O(^MPIF(984.9,"AC",STAT,IEN)) Q:'IEN  D
-	;.. S CNT=CNT+1 S TOTL=TOTL+CNT
-	;I CNT>0 S TEXT=$$EXTERNAL^DILFD(984.9,.06,,NSTAT) W !,$E(TEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT,CNT=0
-	;I TOTL=0 W !,"There are no outstanding CMOR Requests."
-	;K CNT,STAT,NSTAT,TEXT,TOTL,IEN
-	;I $Y>20 D QUIT Q:X="^"
-	;
-	S HOME=$P($$SITE^VASITE(),"^",3)
-	S ICN=0,CNT=0
-	F  S ICN=$O(^DPT("AICN",ICN)) Q:'ICN  D
-	.Q:$E(ICN,1,3)=HOME
-	.S CNT=CNT+1
-	W !!,"Current total number of National ICNs = ",CNT
-	S ICN=0,CNT=0
-	F  S ICN=$O(^DPT("AICNL",1,ICN)) Q:'ICN  S CNT=CNT+1
-	W !,"Current total number of Local ICNs = ",CNT
-	K CNT,DFN,ICN
-	Q
-QUIT	S DIR(0)="E" D  D ^DIR K DIR
-	.S SS=21-$Y F JJ=1:1:SS W !
-	S $Y=0
-	K JJ,SS
-	Q
+RGSYSTAT ;BAY/ALS-MPI/PD STATUS DISPLAY ;01/05/01
+ ;;1.0;CLINICAL INFO RESOURCE NETWORK;**16,19,23,25,20,43,45**;30 Apr 99;Build 9
+ ;Reference to ^DGCN(391.98,"AST" supported by IA #3303
+ ;Reference to ^DGCN(391.984 supported by IA #3304
+ ;Reference to ^MPIF(984.9 supported by IA #3298
+ ;Reference to OPTSTAT^XUTMOPT supported by IA #1472
+ ;Reference to ^DPT("ACMORS", ^DPT("AICN", and ^DPT("AICNL" supported by IA #2070
+ ;Reference to ^VAT(391.71 supported by IA #3422
+EN ;
+ ; Count exceptions on hand
+EXC ;
+ W @IOF,"Exception Handler Entries:",!,"--------------------------"
+ S CNT=0,EXCTYP="",NTYP="",TOTL=0,PCNT=0
+ N STAT,DFN,ICN
+ S HOME=$$SITE^VASITE()
+ F  S EXCTYP=$O(^RGHL7(991.1,"AC",EXCTYP)) Q:'EXCTYP  D
+ . I (EXCTYP=234)!(EXCTYP=227)!((EXCTYP>214)&(EXCTYP<219)) D  ;**45
+ .. I (EXCTYP'=NTYP)&(CNT>0) D
+ ... S ETEXT=$P($G(^RGHL7(991.11,NTYP,10)),"^",1)
+ ... W !,$E(ETEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT,CNT=0
+ .. S IEN=0,NTYP=EXCTYP
+ .. F  S IEN=$O(^RGHL7(991.1,"AC",EXCTYP,IEN)) Q:'IEN  D
+ ... S IEN2=0
+ ... F  S IEN2=$O(^RGHL7(991.1,"AC",EXCTYP,IEN,IEN2)) Q:'IEN2  D
+ .... S STAT=$P(^RGHL7(991.1,IEN,1,IEN2,0),"^",5) I STAT<1 D
+ ..... S DFN=$P(^RGHL7(991.1,IEN,1,IEN2,0),"^",4) Q:'DFN
+ ..... S ^XTMP("RGEXC",0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"MPI/PD Status Display"
+ ..... S ^XTMP("RGEXC",DFN)=DFN
+ ..... S ICN=+$$GETICN^MPIF001(DFN)
+ ..... I $E(ICN,1,3)=$E($P(HOME,"^",3),1,3)!(ICN<0)!(EXCTYP=234)!((EXCTYP>214)&(EXCTYP<219)) D  ;**43,45
+ ...... S CNT=CNT+1
+ I CNT>0 D
+ .S ETEXT=$P($G(^RGHL7(991.11,NTYP,10)),"^",1)
+ .W !,$E(ETEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT
+ I TOTL=0 W !,"There are no entries in the Exception Handler."
+ I TOTL>0 D
+ . W !!,"Total number of exceptions: ",?55,$J(TOTL,6)
+ . S PDFN=""
+ . F  S PDFN=$O(^XTMP("RGEXC",PDFN)) Q:'PDFN  D
+ .. S PCNT=PCNT+1
+ . W !,"Total unique patient exceptions: ",?55,$J(PCNT,6)
+ S STDT=$P($G(^RGSITE(991.8,1,"EXCPRG")),"^",1)
+ I $D(^RGSITE(991.8,1,"EXCPRG")) D
+ . S STDT=$$FMTE^XLFDT(STDT,1)
+ . W !!,"The MPI/PD Exception Purge process last ran "_STDT_"."
+ K CNT,EXCTYP,NTYP,ETEXT,TOTL,IEN,IEN2,HOME,PCNT,^XTMP("RGEXC"),PDFN,STDT
+ I $Y>21 D QUIT Q:X="^"
+PDR ;Count entries in Patient Data Review
+ W !!,"Patient Data Review Entries:",!,"----------------------------"
+ S CNT=0,PDRTYP="",NTYP="",TOTL=0
+ F  S PDRTYP=$O(^DGCN(391.98,"AST",PDRTYP)) Q:'PDRTYP  D
+ . I (PDRTYP'=NTYP)&(CNT>0) D
+ .. S DIC="^DGCN(391.984,",DR=".01",DA=NTYP,DIQ(0)="E",DIQ="RGPDR"
+ .. D EN^DIQ1 K DIC,DA,DR,DIQ
+ .. S PTEXT=$G(RGPDR(391.984,NTYP,.01,"E"))
+ .. W !,$E(PTEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT,CNT=0
+ . I (PDRTYP=1)!(PDRTYP=2)!(PDRTYP=5) D
+ .. S IEN=0,NTYP=PDRTYP
+ .. F  S IEN=$O(^DGCN(391.98,"AST",PDRTYP,IEN)) Q:'IEN  D
+ ... S CNT=CNT+1
+ I CNT>0 D
+ . S DIC="^DGCN(391.984,",DR=".01",DA=NTYP,DIQ(0)="E",DIQ="RGPDR"
+ . D EN^DIQ1 K DIC,DA,DR,DIQ
+ . S PTEXT=$G(RGPDR(391.984,NTYP,.01,"E"))
+ .W !,$E(PTEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT
+ I TOTL=0 W !,"There are no entries in Patient Data Review."
+ K CNT,PDRTYP,NTYP,TOTL,IEN,PTEXT,RGPDR
+ ;Q
+ I $Y>20 D QUIT Q:X="^"
+ ;
+CMOR ;CMOR Requests Status
+ W !!,"CMOR Requests Status:",!,"---------------------"
+ S CNT=0,STAT="",NSTAT="",TOTL=0
+ F  S STAT=$O(^MPIF(984.9,"AC",STAT)) Q:'STAT  D
+ . I (STAT'=NSTAT)&(CNT>0) D
+ .. S TEXT=$$EXTERNAL^DILFD(984.9,.06,,NSTAT)
+ .. W !,$E(TEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT,CNT=0
+ . S IEN=0,NSTAT=STAT
+ . F  S IEN=$O(^MPIF(984.9,"AC",STAT,IEN)) Q:'IEN  D
+ .. S CNT=CNT+1 S TOTL=TOTL+CNT
+ I CNT>0 S TEXT=$$EXTERNAL^DILFD(984.9,.06,,NSTAT) W !,$E(TEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT,CNT=0
+ I TOTL=0 W !,"There are no outstanding CMOR Requests."
+ K CNT,STAT,NSTAT,TEXT,TOTL,IEN
+ I $Y>20 D QUIT Q:X="^"
+ ;
+ S HOME=$P($$SITE^VASITE(),"^",3)
+ S ICN=0,CNT=0
+ F  S ICN=$O(^DPT("AICN",ICN)) Q:'ICN  D
+ .Q:$E(ICN,1,3)=HOME
+ .S CNT=CNT+1
+ W !,"Current total number of National ICNs = ",CNT
+ S ICN=0,CNT=0
+ F  S ICN=$O(^DPT("AICNL",1,ICN)) Q:'ICN  S CNT=CNT+1
+ W !,"Current total number of Local ICNs = ",CNT
+ K CNT,DFN,ICN
+ Q
+QUIT S DIR(0)="E" D  D ^DIR K DIR
+ .S SS=21-$Y F JJ=1:1:SS W !
+ S $Y=0
+ K JJ,SS
+ Q