Changeset 623 for WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRPTX17.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRPTX17.m
r613 r623 1 DGRPTX17 ; ; 12/13/081 DGRPTX17 ; ;04/21/06 2 2 D DE G BEGIN 3 3 DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))="" 4 I $D(^(.21)) S %Z=^(.21) S %=$P(%Z,U,2) S:%]"" DE(1)=% S %=$P(%Z,U,3) S:%]"" DE(5)=% S %=$P(%Z,U,4) S:%]"" DE(7)=% S %=$P(%Z,U,5) S:%]"" DE(9)=% S %=$P(%Z,U,6) S:%]"" DE(10)=% S %=$P(%Z,U,7) S:%]"" DE(11)=% S %=$P(%Z,U,9) S:%]"" DE(13)=% 5 I S %=$P(%Z,U,10) S:%]"" DE(3)=% S %=$P(%Z,U,11) S:%]"" DE(14)=% 6 I $D(^(.22)) S %Z=^(.22) S %=$P(%Z,U,7) S:%]"" DE(12)=% 7 I $D(^(.33)) S %Z=^(.33) S %=$P(%Z,U,1) S:%]"" DE(22)=% S %=$P(%Z,U,10) S:%]"" DE(17)=% 4 I $D(^(.3)) S %Z=^(.3) S %=$P(%Z,U,1) S:%]"" DE(7)=% S %=$P(%Z,U,2) S:%]"" DE(9)=% 5 I $D(^(.321)) S %Z=^(.321) S %=$P(%Z,U,2) S:%]"" DE(3)=% S %=$P(%Z,U,3) S:%]"" DE(4)=% 6 I $D(^(.322)) S %Z=^(.322) S %=$P(%Z,U,13) S:%]"" DE(5)=% 7 I $D(^(.36)) S %Z=^(.36) S %=$P(%Z,U,2) S:%]"" DE(6)=% 8 I $D(^(.362)) S %Z=^(.362) S %=$P(%Z,U,12) S:%]"" DE(11)=% S %=$P(%Z,U,13) S:%]"" DE(12)=% 9 I $D(^(.53)) S %Z=^(.53) S %=$P(%Z,U,4) S:%]"" DE(1)=% 8 10 K %Z Q 9 11 ; … … 53 55 KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY") 54 56 BEGIN S DNM="DGRPTX17",DQ=1 55 1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".21;2",DV="FX",DU="",DLB="K-RELATIONSHIP TO PATIENT",DIFLD=.212 56 S DE(DW)="C1^DGRPTX17",DE(DW,"INDEX")=1 57 G RE 58 C1 G C1S:$D(DE(1))[0 K DB 59 S X=DE(1),DIC=DIE 60 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 61 C1S S X="" G:DG(DQ)=X C1F1 K DB 62 S X=DG(DQ),DIC=DIE 63 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 64 C1F1 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE))) 65 F DIXR=602 S DIEZRXR(2,DIXR)="" 66 Q 67 X1 K:$L(X)>30!($L(X)<1) X I $D(X) S DFN=DA D K1^DGLOCK2 68 I $D(X),X'?.ANP K X 69 Q 70 ; 71 2 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=2 G A 72 3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW=".21;10",DV="RSX",DU="",DLB="K-ADDRESS SAME AS PATIENT'S?",DIFLD=.2125 73 S DE(DW)="C3^DGRPTX17",DE(DW,"INDEX")=1 74 S DU="Y:YES;N:NO;" 75 S Y="NO" 76 G Y 57 1 S DW=".53;4",DV="P4'",DU="",DLB="PH DIVISION",DIFLD=.535 58 S DU="DIC(4," 59 S X=$$DIV^DGRPLE() 60 S Y=X 61 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) 62 G RD 63 X1 Q 64 2 S DQ=3 ;@53 65 3 S DW=".321;2",DV="RSX",DU="",DLB="AGENT ORANGE EXPOS. INDICATED?",DIFLD=.32102 66 S DE(DW)="C3^DGRPTX17" 67 S DU="Y:YES;N:NO;U:UNKNOWN;" 68 G RE 77 69 C3 G C3S:$D(DE(3))[0 K DB 70 S X=DE(3),DIC=DIE 71 ; 72 S X=DE(3),DIC=DIE 73 ; 74 S X=DE(3),DIC=DIE 75 ; 76 S X=DE(3),DIC=DIE 77 D AUTOUPD^DGENA2(DA) 78 S X=DE(3),DIC=DIE 79 ; 78 80 C3S S X="" G:DG(DQ)=X C3F1 K DB 79 C3F1 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE))) 80 F DIXR=602 S DIEZRXR(2,DIXR)="" 81 Q 82 X3 I $D(X),X="Y" S DFN=DA D K1^DGLOCK2 83 Q 84 ; 85 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 86 X4 I X="Y" S DGADD=".21" D AD^DGRPE S Y=.21011 87 Q 88 5 D:$D(DG)>9 F^DIE17,DE S DQ=5,DW=".21;3",DV="FX",DU="",DLB="K-STREET ADDRESS [LINE 1]",DIFLD=.213 89 S DE(DW)="C5^DGRPTX17",DE(DW,"INDEX")=1 81 S X=DG(DQ),DIC=DIE 82 X ^DD(2,.32102,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.321)):^(.321),1:"") S X=$P(Y(1),U,7) S DIU=X K Y S X=DIV S X="" X ^DD(2,.32102,1,1,1.4) 83 S X=DG(DQ),DIC=DIE 84 X ^DD(2,.32102,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.321)):^(.321),1:"") S X=$P(Y(1),U,9) S DIU=X K Y S X=DIV S X="" X ^DD(2,.32102,1,2,1.4) 85 S X=DG(DQ),DIC=DIE 86 X ^DD(2,.32102,1,3,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.321)):^(.321),1:"") S X=$P(Y(1),U,10) S DIU=X K Y S X=DIV S X="" X ^DD(2,.32102,1,3,1.4) 87 S X=DG(DQ),DIC=DIE 88 D AUTOUPD^DGENA2(DA) 89 S X=DG(DQ),DIC=DIE 90 X ^DD(2,.32102,1,5,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.321)):^(.321),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X="" S DIH=$G(^DPT(DIV(0),.321)),DIV=X S $P(^(.321),U,13)=DIV,DIH=2,DIG=.3213 D ^DICR 91 C3F1 Q 92 X3 S DFN=DA D SV^DGLOCK 93 Q 94 ; 95 4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW=".321;3",DV="RSX",DU="",DLB="RADIATION EXPOSURE INDICATED?",DIFLD=.32103 96 S DE(DW)="C4^DGRPTX17" 97 S DU="Y:YES;N:NO;U:UNKNOWN;" 98 G RE 99 C4 G C4S:$D(DE(4))[0 K DB 100 S X=DE(4),DIC=DIE 101 ; 102 S X=DE(4),DIC=DIE 103 ; 104 S X=DE(4),DIC=DIE 105 D AUTOUPD^DGENA2(DA) 106 C4S S X="" G:DG(DQ)=X C4F1 K DB 107 S X=DG(DQ),DIC=DIE 108 X ^DD(2,.32103,1,1,1.3) I X S X=DIV S Y(2)=";"_$S($D(^DD(2,.3212,0)):$P(^(0),U,3),1:""),Y(1)=$S($D(^DPT(D0,.321)):^(.321),1:"") S X=$P($P(Y(2),";"_$P(Y(1),U,12)_":",2),";",1) S DIU=X K Y S X=DIV S X="" X ^DD(2,.32103,1,1,1.4) 109 S X=DG(DQ),DIC=DIE 110 X ^DD(2,.32103,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.321)):^(.321),1:"") S X=$P(Y(1),U,11) S DIU=X K Y S X=DIV S X="" X ^DD(2,.32103,1,2,1.4) 111 S X=DG(DQ),DIC=DIE 112 D AUTOUPD^DGENA2(DA) 113 C4F1 Q 114 X4 S DFN=DA D SV^DGLOCK 115 Q 116 ; 117 5 D:$D(DG)>9 F^DIE17,DE S DQ=5,DW=".322;13",DV="RSX",DU="",DLB="ENVIRONMENTAL CONTAMINANTS?",DIFLD=.322013 118 S DE(DW)="C5^DGRPTX17" 119 S DU="Y:YES;N:NO;U:UNKNOWN;" 90 120 G RE 91 121 C5 G C5S:$D(DE(5))[0 K DB 92 122 S X=DE(5),DIC=DIE 93 X "S DGXRF=.213 D ^DGDDC Q"123 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.322)):^(.322),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y S X="" X ^DD(2,.322013,1,1,2.4) 94 124 S X=DE(5),DIC=DIE 125 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.322)):^(.322),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X="" X ^DD(2,.322013,1,2,2.4) 126 S X=DE(5),DIC=DIE 127 D AUTOUPD^DGENA2(DA) 128 C5S S X="" G:DG(DQ)=X C5F1 K DB 129 S X=DG(DQ),DIC=DIE 130 X ^DD(2,.322013,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.322)):^(.322),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y S X="" X ^DD(2,.322013,1,1,1.4) 131 S X=DG(DQ),DIC=DIE 132 X ^DD(2,.322013,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.322)):^(.322),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X="" X ^DD(2,.322013,1,2,1.4) 133 S X=DG(DQ),DIC=DIE 134 D AUTOUPD^DGENA2(DA) 135 C5F1 Q 136 X5 S DFN=DA D SV^DGLOCK 137 Q 138 ; 139 6 D:$D(DG)>9 F^DIE17,DE S DQ=6,DW=".36;2",DV="RSX",DU="",DLB="DISABILITY RET. FROM MILITARY?",DIFLD=.362 140 S DE(DW)="C6^DGRPTX17" 141 S DU="0:NO;1:YES, RECEIVING MILITARY RETIREMENT;2:YES, RECEIVING MILITARY RETIREMENT IN LIEU OF VA COMPENSATION;3:UNKNOWN;" 142 G RE 143 C6 G C6S:$D(DE(6))[0 K DB 144 S X=DE(6),DIC=DIE 145 ; 146 S X=DE(6),DIC=DIE 147 D AUTOUPD^DGENA2(DA) 148 C6S S X="" G:DG(DQ)=X C6F1 K DB 149 S X=DG(DQ),DIC=DIE 150 X "S DFN=DA D EN^DGMTR K DGREQF" 151 S X=DG(DQ),DIC=DIE 152 D AUTOUPD^DGENA2(DA) 153 C6F1 Q 154 X6 S DFN=DA D SV^DGLOCK 155 Q 156 ; 157 7 D:$D(DG)>9 F^DIE17,DE S DQ=7,DW=".3;1",DV="RSXa",DU="",DLB="SERVICE CONNECTED?",DIFLD=.301 158 S DE(DW)="C7^DGRPTX17" 159 S DU="Y:YES;N:NO;" 160 G RE 161 C7 G C7S:$D(DE(7))[0 K DB 162 S X=DE(7),DIC=DIE 163 ; 164 S X=DE(7),DIC=DIE 165 ; 166 S X=DE(7),DIC=DIE 167 D AUTOUPD^DGENA2(DA) 168 S X=DE(7),DIC=DIE 169 I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".301;" D AVAFC^VAFCDD01(DA) 170 S X=DE(7),DIC=DIE 95 171 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 96 C5S S X="" G:DG(DQ)=X C5F1 K DB 97 S X=DG(DQ),DIC=DIE 98 ; 99 S X=DG(DQ),DIC=DIE 172 S X=DE(7),DIIX=2_U_DIFLD D AUDIT^DIET 173 C7S S X="" G:DG(DQ)=X C7F1 K DB 174 D ^DGRPTX18 175 C7F1 Q 176 X7 S DFN=DA D EV^DGLOCK I $D(X),X="Y" D VET^DGLOCK 177 Q 178 ; 179 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 180 X8 S:X'="Y" Y="@50" 181 Q 182 9 D:$D(DG)>9 F^DIE17,DE S DQ=9,DW=".3;2",DV="NJ3,0Xa",DU="",DLB="SERVICE CONNECTED PERCENTAGE",DIFLD=.302 183 S DE(DW)="C9^DGRPTX17" 184 G RE 185 C9 G C9S:$D(DE(9))[0 K DB 186 S X=DE(9),DIC=DIE 187 ; 188 S X=DE(9),DIC=DIE 189 D AUTOUPD^DGENA2(DA) 190 S X=DE(9),DIC=DIE 191 ; 192 S X=DE(9),DIC=DIE 193 I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".302;" D AVAFC^VAFCDD01(DA) 194 S X=DE(9),DIC=DIE 100 195 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 101 C5F1 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE))) 102 F DIXR=602 S DIEZRXR(2,DIXR)="" 103 Q 104 X5 K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>30!($L(X)<3) X I $D(X) S DFN=DA D K1^DGLOCK2 105 I $D(X),X'?.ANP K X 106 Q 107 ; 108 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 109 X6 S:X="" Y=.216 110 Q 111 7 D:$D(DG)>9 F^DIE17,DE S DQ=7,DW=".21;4",DV="FX",DU="",DLB="K-STREET ADDRESS [LINE 2]",DIFLD=.214 112 S DE(DW)="C7^DGRPTX17",DE(DW,"INDEX")=1 113 G RE 114 C7 G C7S:$D(DE(7))[0 K DB 115 S X=DE(7),DIC=DIE 116 X "S DGXRF=.214 D ^DGDDC Q" 117 S X=DE(7),DIC=DIE 118 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 119 C7S S X="" G:DG(DQ)=X C7F1 K DB 120 S X=DG(DQ),DIC=DIE 121 ; 122 S X=DG(DQ),DIC=DIE 123 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 124 C7F1 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE))) 125 F DIXR=602 S DIEZRXR(2,DIXR)="" 126 Q 127 X7 K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>30!($L(X)<3) X I $D(X) S DFN=DA D K1^DGLOCK2 128 I $D(X),X'?.ANP K X 129 Q 130 ; 131 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 132 X8 S:X="" Y=.216 133 Q 134 9 D:$D(DG)>9 F^DIE17,DE S DQ=9,DW=".21;5",DV="FX",DU="",DLB="K-STREET ADDRESS [LINE 3]",DIFLD=.215 135 S DE(DW)="C9^DGRPTX17",DE(DW,"INDEX")=1 136 G RE 137 C9 G C9S:$D(DE(9))[0 K DB 196 S X=DE(9),DIIX=2_U_DIFLD D AUDIT^DIET 138 197 C9S S X="" G:DG(DQ)=X C9F1 K DB 139 C9F1 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE))) 140 F DIXR=602 S DIEZRXR(2,DIXR)="" 141 Q 142 X9 K:$L(X)>30!($L(X)<3) X I $D(X) S DFN=DA D K1^DGLOCK2 143 I $D(X),X'?.ANP K X 144 Q 145 ; 146 10 D:$D(DG)>9 F^DIE17,DE S DQ=10,DW=".21;6",DV="FX",DU="",DLB="K-CITY",DIFLD=.216 147 S DE(DW)="C10^DGRPTX17",DE(DW,"INDEX")=1 148 G RE 149 C10 G C10S:$D(DE(10))[0 K DB 150 S X=DE(10),DIC=DIE 151 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 152 C10S S X="" G:DG(DQ)=X C10F1 K DB 153 S X=DG(DQ),DIC=DIE 154 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 155 C10F1 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE))) 156 F DIXR=602 S DIEZRXR(2,DIXR)="" 157 Q 158 X10 K:$L(X)>30!($L(X)<3) X I $D(X) S DFN=DA D K1^DGLOCK2 159 I $D(X),X'?.ANP K X 160 Q 161 ; 162 11 D:$D(DG)>9 F^DIE17,DE S DQ=11,DW=".21;7",DV="P5'X",DU="",DLB="K-STATE",DIFLD=.217 163 S DE(DW)="C11^DGRPTX17",DE(DW,"INDEX")=1 164 S DU="DIC(5," 198 D ^DGRPTX19 199 C9F1 Q 200 X9 S DFN=DA D EV^DGLOCK Q:'$D(X) K:+X'=X!(X>100)!(X<0)!(X?.E1"."1N.N) X I $D(X),$D(^DPT(DA,.3)),$P(^(.3),U,1)'="Y" W !?4,*7,"Only applies to service-connected applicants." K X 201 Q 202 ; 203 10 S DQ=11 ;@50 204 11 D:$D(DG)>9 F^DIE17,DE S DQ=11,DW=".362;12",DV="SX",DU="",DLB="RECEIVING A&A BENEFITS?",DIFLD=.36205 205 S DE(DW)="C11^DGRPTX17" 206 S DU="Y:YES;N:NO;U:UNKNOWN;" 165 207 G RE 166 208 C11 G C11S:$D(DE(11))[0 K DB 167 S X=DE(11),DIC=DIE 168 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 209 D ^DGRPTX20 169 210 C11S S X="" G:DG(DQ)=X C11F1 K DB 170 S X=DG(DQ),DIC=DIE 171 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 172 C11F1 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE))) 173 F DIXR=602 S DIEZRXR(2,DIXR)="" 174 Q 175 X11 I $D(X) S DFN=DA D K1^DGLOCK2 176 Q 177 ; 178 12 D:$D(DG)>9 F^DIE17,DE S DQ=12,DW=".22;7",DV="FOX",DU="",DLB="K-ZIP+4",DIFLD=.2207 179 S DQ(12,2)="S Y(0)=Y D ZIPOUT^VAFADDR" 180 S DE(DW)="C12^DGRPTX17",DE(DW,"INDEX")=1 211 D ^DGRPTX21 212 C11F1 Q 213 X11 S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK 214 Q 215 ; 216 12 D:$D(DG)>9 F^DIE17,DE S DQ=12,DW=".362;13",DV="SX",DU="",DLB="RECEIVING HOUSEBOUND BENEFITS?",DIFLD=.36215 217 S DE(DW)="C12^DGRPTX17" 218 S DU="Y:YES;N:NO;U:UNKNOWN;" 181 219 G RE 182 220 C12 G C12S:$D(DE(12))[0 K DB 183 S X=DE(12),DIC=DIE 184 D KILL^DGREGDD1(DA,.218,.21,8,$E(X,1,5)) 221 D ^DGRPTX22 185 222 C12S S X="" G:DG(DQ)=X C12F1 K DB 186 S X=DG(DQ),DIC=DIE 187 D SET^DGREGDD1(DA,.218,.21,8,$E(X,1,5)) 188 C12F1 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE))) 189 F DIXR=602 S DIEZRXR(2,DIXR)="" 190 Q 191 X12 K:X[""""!($A(X)=45) X I $D(X) S DFN=DA D K1^DGLOCK2 I $D(X) K:$L(X)>15!($L(X)<5) X I $D(X) D ZIPIN^VAFADDR 192 I $D(X),X'?.ANP K X 193 Q 194 ; 195 13 D:$D(DG)>9 F^DIE17,DE S DQ=13,DW=".21;9",DV="FXa",DU="",DLB="K-PHONE NUMBER",DIFLD=.219 196 S DE(DW)="C13^DGRPTX17" 197 G RE 198 C13 G C13S:$D(DE(13))[0 K DB 199 S X=DE(13),DIC=DIE 200 I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".219;" D AVAFC^VAFCDD01(DA) 201 S X=DE(13),DIC=DIE 202 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 203 S X=DE(13),DIIX=2_U_DIFLD D AUDIT^DIET 204 C13S S X="" G:DG(DQ)=X C13F1 K DB 205 S X=DG(DQ),DIC=DIE 206 I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".219;" D AVAFC^VAFCDD01(DA) 207 S X=DG(DQ),DIC=DIE 208 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 209 I $D(DE(13))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET 210 C13F1 Q 211 X13 K:$L(X)>20!($L(X)<4) X I $D(X) S DFN=DA D K1^DGLOCK2 212 I $D(X),X'?.ANP K X 213 Q 214 ; 215 14 D:$D(DG)>9 F^DIE17,DE S DQ=14,DW=".21;11",DV="F",DU="",DLB="K-WORK PHONE NUMBER",DIFLD=.21011 216 G RE 217 X14 K:$L(X)>20!($L(X)<4) X 218 I $D(X),X'?.ANP K X 219 Q 220 ; 221 15 S DQ=16 ;@30 222 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 223 X16 I $S('$D(^DPT(DFN,.21)):1,$P(^(.21),U,1)="":1,1:0) S Y=.331 224 Q 225 17 S DW=".33;10",DV="RSX",DU="",DLB="E-EMER. CONTACT SAME AS NOK?",DIFLD=.3305 226 S DE(DW)="C17^DGRPTX17",DE(DW,"INDEX")=1 227 S DU="Y:YES;N:NO;" 228 S Y="NO" 229 G Y 230 C17 G C17S:$D(DE(17))[0 K DB 231 C17S S X="" G:DG(DQ)=X C17F1 K DB 232 C17F1 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE))) 233 F DIXR=604 S DIEZRXR(2,DIXR)="" 234 Q 235 X17 I $D(X),X="Y" D K1^DGLOCK2 236 Q 237 ; 238 18 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=18 D X18 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 239 X18 I X'="Y" S Y=.331 240 Q 241 19 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=19 D X19 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 242 X19 S X=$S($D(^DPT(DA,.21)):^(.21),1:"") S:X'="" ^(.33)=$P(X_"^^^^^^^^^^^",U,1,9)_U_$P(^(.33),U,10)_U_$P(X,U,11) 243 Q 244 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 245 X20 S:$D(^DPT(DFN,.22)) $P(^(.22),U,1)=$P(^(.22),U,7) 246 Q 247 21 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=21 D X21 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 248 X21 S Y=.33011 249 Q 250 22 D:$D(DG)>9 F^DIE17,DE S DQ=22,DW=".33;1",DV="F",DU="",DLB="E-NAME",DIFLD=.331 251 S DE(DW)="C22^DGRPTX17",DE(DW,"INDEX")=1 252 G RE 253 C22 G C22S:$D(DE(22))[0 K DB 254 D ^DGRPTX18 255 C22S S X="" G:DG(DQ)=X C22F1 K DB 256 D ^DGRPTX19 257 C22F1 N X,X1,X2 S DIXR=595 D C22X1(U) K X2 M X2=X D C22X1("O") K X1 M X1=X 258 I $G(X(1))]"" D 259 . I '$G(XUNOTRIG) N XUNOTRIG S XUNOTRIG=1 D DELCOMP^XLFNAME2(2,.DA,.331,1.07) Q 260 K X M X=X2 I $G(X(1))]"" D 261 . I '$G(XUNOTRIG) N XUNOTRIG S XUNOTRIG=1,DG20NAME=X D NARY^XLFNAME7(.DG20NAME),UPDCOMP^XLFNAME2(2,.DA,.331,.DG20NAME,1.07,+$P($G(^DPT(DA,"NAME")),U,7),"CL35") K DG20NAME Q 262 G C22F2 263 C22X1(DION) K X 264 S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.331,DION),$P($G(^DPT(DA,.33)),U,1)) 265 S X=$G(X(1)) 266 Q 267 C22F2 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE))) 268 F DIXR=604 S DIEZRXR(2,DIXR)="" 269 Q 270 X22 K:$L(X)>35!($L(X)<3) X I $D(X) S DG20NAME=X,(X,DG20NAME)=$$FORMAT^XLFNAME7(.DG20NAME,3,35) K:'$L(X) X,DG20NAME 271 I $D(X),X'?.ANP K X 272 Q 273 ; 274 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 275 X23 S:X="" Y="@40" 276 Q 277 24 D:$D(DG)>9 F^DIE17 G ^DGRPTX20 223 D ^DGRPTX23 224 C12F1 Q 225 X12 S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK 226 Q 227 ; 228 13 D:$D(DG)>9 F^DIE17 G ^DGRPTX24
Note:
See TracChangeset
for help on using the changeset viewer.
