- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE18.m
r613 r623 1 DVBHCE18 ; ;12/ 13/081 DVBHCE18 ; ;12/27/07 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(^(.11)) S %Z=^(.11) S %=$P(%Z,U, 3) S:%]"" DE(1)=% S %=$P(%Z,U,4) S:%]"" DE(2)=% S %=$P(%Z,U,5) S:%]"" DE(3)=% S %=$P(%Z,U,7) S:%]"" DE(5)=% S %=$P(%Z,U,12) S:%]"" DE(4)=%4 I $D(^(.11)) S %Z=^(.11) S %=$P(%Z,U,5) S:%]"" DE(1)=% S %=$P(%Z,U,7) S:%]"" DE(3)=% S %=$P(%Z,U,12) S:%]"" DE(2)=% 5 5 K %Z Q 6 6 ; … … 50 50 KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY") 51 51 BEGIN S DNM="DVBHCE18",DQ=1 52 1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".11; 3",DV="Fa",DU="",DLB="STREET ADDRESS [LINE 3]",DIFLD=.11352 1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".11;5",DV="P5'a",DU="",DLB="STATE",DIFLD=.115 53 53 S DE(DW)="C1^DVBHCE18",DE(DW,"INDEX")=1 54 S DU="DIC(5," 54 55 G RE 55 56 C1 G C1S:$D(DE(1))[0 K DB 56 57 S X=DE(1),DIC=DIE 58 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:""),Y=$P(Y(1),U,7) X:$D(^DD(2,.117,2)) ^(2) S X=Y S DIU=X K Y S X=DIV S X="" X ^DD(2,.115,1,1,2.4) 59 S X=DE(1),DIC=DIE 57 60 S A1B2TAG="PAT" D ^A1B2XFR 58 61 S X=DE(1),DIC=DIE 59 62 D EVENT^IVMPLOG(DA) 60 63 S X=DE(1),DIC=DIE 61 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT ()S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR62 S X=DE(1),DIC=DIE 63 S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX 64 S X=DE(1),DIC=DIE 65 I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".11 3;" D AVAFC^VAFCDD01(DA)64 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR 65 S X=DE(1),DIC=DIE 66 S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX 67 S X=DE(1),DIC=DIE 68 I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".115;" D AVAFC^VAFCDD01(DA) 66 69 S X=DE(1),DIC=DIE 67 70 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) … … 69 72 C1S S X="" G:DG(DQ)=X C1F1 K DB 70 73 S X=DG(DQ),DIC=DIE 74 ; 75 S X=DG(DQ),DIC=DIE 71 76 S A1B2TAG="PAT" D ^A1B2XFR 72 77 S X=DG(DQ),DIC=DIE … … 77 82 S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX 78 83 S X=DG(DQ),DIC=DIE 79 I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".11 3;" D AVAFC^VAFCDD01(DA)84 I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".115;" D AVAFC^VAFCDD01(DA) 80 85 S X=DG(DQ),DIC=DIE 81 86 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 82 87 I $D(DE(1))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET 83 C1F1 N X,X1,X2 S DIXR=233 D C1X1(U) K X2 M X2=X D C1X1("O") K X1 M X1=X 84 D 85 . D FC^DGFCPROT(.DA,2,.113,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q 86 K X M X=X2 D 87 . D FC^DGFCPROT(.DA,2,.113,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q 88 G C1F2 89 C1X1(DION) K X 90 S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.113,DION),$P($G(^DPT(DA,.11)),U,3)) 91 S X=$G(X(1)) 92 Q 93 C1F2 Q 94 X1 K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>30!($L(X)<3) X 95 I $D(X),X'?.ANP K X 96 Q 97 ; 98 2 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW=".11;4",DV="Fa",DU="",DLB="CITY",DIFLD=.114 99 S DE(DW)="C2^DVBHCE18",DE(DW,"INDEX")=1 100 G RE 101 C2 G C2S:$D(DE(2))[0 K DB 102 S X=DE(2),DIC=DIE 103 S A1B2TAG="PAT" D ^A1B2XFR 104 S X=DE(2),DIC=DIE 105 D EVENT^IVMPLOG(DA) 106 S X=DE(2),DIC=DIE 107 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR 108 S X=DE(2),DIC=DIE 109 S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX 110 S X=DE(2),DIC=DIE 111 I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".114;" D AVAFC^VAFCDD01(DA) 112 S X=DE(2),DIC=DIE 113 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 114 S X=DE(2),DIIX=2_U_DIFLD D AUDIT^DIET 115 C2S S X="" G:DG(DQ)=X C2F1 K DB 116 S X=DG(DQ),DIC=DIE 117 S A1B2TAG="PAT" D ^A1B2XFR 118 S X=DG(DQ),DIC=DIE 119 D EVENT^IVMPLOG(DA) 120 S X=DG(DQ),DIC=DIE 121 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR 122 S X=DG(DQ),DIC=DIE 123 S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX 124 S X=DG(DQ),DIC=DIE 125 I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".114;" D AVAFC^VAFCDD01(DA) 126 S X=DG(DQ),DIC=DIE 127 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 128 I $D(DE(2))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET 129 C2F1 N X,X1,X2 S DIXR=234 D C2X1(U) K X2 M X2=X D C2X1("O") K X1 M X1=X 130 D 131 . D FC^DGFCPROT(.DA,2,.114,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q 132 K X M X=X2 D 133 . D FC^DGFCPROT(.DA,2,.114,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q 134 G C2F2 135 C2X1(DION) K X 136 S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.114,DION),$P($G(^DPT(DA,.11)),U,4)) 137 S X=$G(X(1)) 138 Q 139 C2F2 Q 140 X2 K:$L(X)>15!($L(X)<2) X 141 I $D(X),X'?.ANP K X 142 Q 143 ; 144 3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW=".11;5",DV="P5'a",DU="",DLB="STATE",DIFLD=.115 145 S DE(DW)="C3^DVBHCE18",DE(DW,"INDEX")=1 146 S DU="DIC(5," 147 G RE 148 C3 G C3S:$D(DE(3))[0 K DB 149 S X=DE(3),DIC=DIE 150 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:""),Y=$P(Y(1),U,7) X:$D(^DD(2,.117,2)) ^(2) S X=Y S DIU=X K Y S X=DIV S X="" X ^DD(2,.115,1,1,2.4) 151 S X=DE(3),DIC=DIE 152 S A1B2TAG="PAT" D ^A1B2XFR 153 S X=DE(3),DIC=DIE 154 D EVENT^IVMPLOG(DA) 155 S X=DE(3),DIC=DIE 156 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR 157 S X=DE(3),DIC=DIE 158 S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX 159 S X=DE(3),DIC=DIE 160 I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".115;" D AVAFC^VAFCDD01(DA) 161 S X=DE(3),DIC=DIE 162 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 163 S X=DE(3),DIIX=2_U_DIFLD D AUDIT^DIET 164 C3S S X="" G:DG(DQ)=X C3F1 K DB 165 S X=DG(DQ),DIC=DIE 166 ; 167 S X=DG(DQ),DIC=DIE 168 S A1B2TAG="PAT" D ^A1B2XFR 169 S X=DG(DQ),DIC=DIE 170 D EVENT^IVMPLOG(DA) 171 S X=DG(DQ),DIC=DIE 172 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR 173 S X=DG(DQ),DIC=DIE 174 S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX 175 S X=DG(DQ),DIC=DIE 176 I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".115;" D AVAFC^VAFCDD01(DA) 177 S X=DG(DQ),DIC=DIE 178 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 179 I $D(DE(3))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET 180 C3F1 N X,X1,X2 S DIXR=235 D C3X1(U) K X2 M X2=X D C3X1("O") K X1 M X1=X 88 C1F1 N X,X1,X2 S DIXR=235 D C1X1(U) K X2 M X2=X D C1X1("O") K X1 M X1=X 181 89 D 182 90 . D FC^DGFCPROT(.DA,2,.115,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q 183 91 K X M X=X2 D 184 92 . D FC^DGFCPROT(.DA,2,.115,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q 185 G C 3F2186 C 3X1(DION) K X93 G C1F2 94 C1X1(DION) K X 187 95 S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.115,DION),$P($G(^DPT(DA,.11)),U,5)) 188 96 S X=$G(X(1)) 189 97 Q 190 C 3F2 Q191 X 3Q192 4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW=".11;12",DV="FXOa",DU="",DLB="ZIP+4",DIFLD=.1112193 S DQ( 4,2)="S Y(0)=Y D ZIPOUT^VAFADDR"194 S DE(DW)="C 4^DVBHCE18",DE(DW,"INDEX")=198 C1F2 Q 99 X1 Q 100 2 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW=".11;12",DV="FXOa",DU="",DLB="ZIP+4",DIFLD=.1112 101 S DQ(2,2)="S Y(0)=Y D ZIPOUT^VAFADDR" 102 S DE(DW)="C2^DVBHCE18",DE(DW,"INDEX")=1 195 103 G RE 196 C 4 G C4S:$D(DE(4))[0 K DB197 S X=DE( 4),DIC=DIE104 C2 G C2S:$D(DE(2))[0 K DB 105 S X=DE(2),DIC=DIE 198 106 D KILL^DGREGDD1(DA,.116,.11,6,$E(X,1,5)) 199 S X=DE( 4),DIC=DIE200 D EVENT^IVMPLOG(DA) 201 S X=DE( 4),DIC=DIE107 S X=DE(2),DIC=DIE 108 D EVENT^IVMPLOG(DA) 109 S X=DE(2),DIC=DIE 202 110 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR 203 S X=DE( 4),DIC=DIE204 S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX 205 S X=DE( 4),DIC=DIE111 S X=DE(2),DIC=DIE 112 S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX 113 S X=DE(2),DIC=DIE 206 114 I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".1112;" D AVAFC^VAFCDD01(DA) 207 S X=DE(4),DIC=DIE 208 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 209 S X=DE(4),DIIX=2_U_DIFLD D AUDIT^DIET 210 C4S S X="" G:DG(DQ)=X C4F1 K DB 211 D ^DVBHCE19 212 C4F1 N X,X1,X2 S DIXR=185 D C4X1(U) K X2 M X2=X D C4X1("O") K X1 M X1=X 115 S X=DE(2),DIC=DIE 116 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 117 S X=DE(2),DIIX=2_U_DIFLD D AUDIT^DIET 118 C2S S X="" G:DG(DQ)=X C2F1 K DB 119 S X=DG(DQ),DIC=DIE 120 D SET^DGREGDD1(DA,.116,.11,6,$E(X,1,5)) 121 S X=DG(DQ),DIC=DIE 122 D EVENT^IVMPLOG(DA) 123 S X=DG(DQ),DIC=DIE 124 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR 125 S X=DG(DQ),DIC=DIE 126 S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX 127 S X=DG(DQ),DIC=DIE 128 I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".1112;" D AVAFC^VAFCDD01(DA) 129 S X=DG(DQ),DIC=DIE 130 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA) 131 I $D(DE(2))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET 132 C2F1 N X,X1,X2 S DIXR=185 D C2X1(U) K X2 M X2=X D C2X1("O") K X1 M X1=X 213 133 D 214 134 . N DIEXARR M DIEXARR=X S DIEZCOND=1 … … 216 136 . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND 217 137 . K EASDO2 218 G C 4F2219 C 4X1(DION) K X138 G C2F2 139 C2X1(DION) K X 220 140 S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.1112,DION),$P($G(^DPT(DA,.11)),U,12)) 221 141 S:('$G(EASDO2)&($D(EASZIPLK))) X=$$ZIP^DGREGDD1(DA,X(1)) … … 223 143 S X=$G(X(1)) 224 144 Q 225 C 4F2 S DIXR=231 D C4X2(U) K X2 M X2=X D C4X2("O") K X1 M X1=X145 C2F2 S DIXR=231 D C2X2(U) K X2 M X2=X D C2X2("O") K X1 M X1=X 226 146 D 227 147 . D FC^DGFCPROT(.DA,2,.1112,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q 228 148 K X M X=X2 D 229 149 . D FC^DGFCPROT(.DA,2,.1112,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q 230 G C 4F3231 C 4X2(DION) K X150 G C2F3 151 C2X2(DION) K X 232 152 S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.1112,DION),$P($G(^DPT(DA,.11)),U,12)) 233 153 S X=$G(X(1)) 234 154 Q 235 C 4F3 Q236 X 4K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>20!($L(X)<5) X I $D(X) D ZIPIN^VAFADDR155 C2F3 Q 156 X2 K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>20!($L(X)<5) X I $D(X) D ZIPIN^VAFADDR 237 157 I $D(X),X'?.ANP K X 238 158 Q 239 159 ; 240 5 D:$D(DG)>9 F^DIE17,DE S DQ=5,DW=".11;7",DV="NJ3,0XOa",DU="",DLB="COUNTY",DIFLD=.117241 S DQ( 5,2)="S Y(0)=Y Q:Y']"""" S Z0=$S($D(^DPT(D0,.11)):+$P(^(.11),""^"",5),1:"""") Q:'Z0 S Y=$P($S($D(^DIC(5,Z0,1,Y,0)):^(0),1:""""),""^"",3)"242 S DE(DW)="C 5^DVBHCE18"160 3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW=".11;7",DV="NJ3,0XOa",DU="",DLB="COUNTY",DIFLD=.117 161 S DQ(3,2)="S Y(0)=Y Q:Y']"""" S Z0=$S($D(^DPT(D0,.11)):+$P(^(.11),""^"",5),1:"""") Q:'Z0 S Y=$P($S($D(^DIC(5,Z0,1,Y,0)):^(0),1:""""),""^"",3)" 162 S DE(DW)="C3^DVBHCE18" 243 163 G RE 244 C5 G C5S:$D(DE(5))[0 K DB 245 D ^DVBHCE20 246 C5S S X="" G:DG(DQ)=X C5F1 K DB 247 D ^DVBHCE21 248 C5F1 Q 249 X5 S Z0=$S($D(^DPT(D0,.11)):+$P(^(.11),"^",5),1:0) K:'Z0 X Q:'Z0!'$D(^DIC(5,Z0,1,0)) S DIC="^DIC(5,Z0,1,",DIC(0)="QEM" D ^DIC S X=+Y K:Y'>0 X K Z0,DIC 250 Q 251 ; 164 C3 G C3S:$D(DE(3))[0 K DB 165 S X=DE(3),DIC=DIE 166 S A1B2TAG="PAT" D ^A1B2XFR 167 S X=DE(3),DIC=DIE 168 D EVENT^IVMPLOG(DA) 169 S X=DE(3),DIC=DIE 170 S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX 171 S X=DE(3),DIC=DIE 172 I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".117;" D AVAFC^VAFCDD01(DA) 173 S X=DE(3),DIIX=2_U_DIFLD D AUDIT^DIET 174 C3S S X="" G:DG(DQ)=X C3F1 K DB 175 D ^DVBHCE19 176 C3F1 Q 177 X3 S Z0=$S($D(^DPT(D0,.11)):+$P(^(.11),"^",5),1:0) K:'Z0 X Q:'Z0!'$D(^DIC(5,Z0,1,0)) S DIC="^DIC(5,Z0,1,",DIC(0)="QEM" D ^DIC S X=+Y K:Y'>0 X K Z0,DIC 178 Q 179 ; 180 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 181 X4 S Y="@1001" 182 Q 183 5 S DQ=6 ;@5 252 184 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 253 X6 S Y="@1001"254 Q 255 7 S DQ=8 ;@ 5185 X6 D SCRQ^DVBHUTIL 186 Q 187 7 S DQ=8 ;@6 256 188 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 257 X8 D SCRQ^DVBHUTIL258 Q 259 9 S DQ=10 ;@ 6189 X8 D B^DVBHQEDT R AA:DTIME K AA S Y=$S(DVBJS=11:"@1001",DVBJS=28:"@1",DVBJS=35:"@2",DVBJS=44:"@3",DVBJS=53:"@104",1:"@10") 190 Q 191 9 S DQ=10 ;@8 260 192 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 261 X10 D B^DVBHQEDT R AA:DTIME K AA S Y=$S(DVBJS=11:"@1001",DVBJS=28:"@1",DVBJS=35:"@2",DVBJS=44:"@3",DVBJS=53:"@104",1:"@10")262 Q 263 11 S DQ=12 ;@8264 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 265 X12 S Y=$S(ANS="^0":"@101",ANS="^1":"@1001",ANS="^2":"@1",ANS="^3":"@2",ANS="^4":"@3",ANS="^5":"@104",1:Y) I Y["@" W @$S('$D(IOF):"#",IOF="":"#",1:IOF) 266 Q 193 X10 S Y=$S(ANS="^0":"@101",ANS="^1":"@1001",ANS="^2":"@1",ANS="^3":"@2",ANS="^4":"@3",ANS="^5":"@104",1:Y) I Y["@" W @$S('$D(IOF):"#",IOF="":"#",1:IOF) 194 Q 195 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 196 X11 D A^DVBHQEDT S Z2=Z I ERROR K ERROR S Y=$S(DVBJS=11:"@1001",DVBJS=28:"@1",DVBJS=35:"@2",DVBJS=44:"@3",DVBJS=53:"@104",1:"@10") 197 Q 198 12 S DQ=13 ;@20 267 199 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 268 X13 D A^DVBHQEDT S Z2=Z I ERROR K ERROR S Y=$S(DVBJS=11:"@1001",DVBJS=28:"@1",DVBJS=35:"@2",DVBJS=44:"@3",DVBJS=53:"@104",1:"@10")269 Q 270 14 S DQ=15 ;@2 0200 X13 S JP=1,Y=$S(DVBJS=11:"@11",DVBJS=35:"@40",DVBJS=44:"@30",DVBJS=53:"@204",1:Y) 201 Q 202 14 S DQ=15 ;@21 271 203 15 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=15 D X15 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 272 X15 S JP=1,Y=$S(DVBJS=11:"@11",DVBJS=35:"@40",DVBJS=44:"@30",DVBJS=53:"@204",1:Y) 273 Q 274 16 S DQ=17 ;@21 204 X15 I $P(Z2,U,JP)'=1 S Y="@22" 205 Q 206 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 207 X16 I '$D(DVBCN) S Y="@22",JP=JP+1 208 Q 275 209 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 276 X17 I $P(Z2,U,JP)'=1 S Y="@22"210 X17 I 'DVBCN S Y="@22",JP=JP+1 277 211 Q 278 212 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 279 X18 I '$D(DVBCN) S Y="@22",JP=JP+1213 X18 S DVBCN=$TR(DVBCN," ") 280 214 Q 281 215 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 282 X19 I 'DVBCN S Y="@22",JP=JP+1 283 Q 284 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 285 X20 S DVBCN=$TR(DVBCN," ") 286 Q 287 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 288 X21 I $L(DVBCN)=9,(DVBCN?9N),(DVBCN'=$P(^DPT(D0,0),U,9)) W !!,*7,"HINQ claim # is a SSN, does not match patient file SSN NO UPDATING claim #" R !,?25,"<RET to continue>",DVBQ:DTIME K DVBQ S Y="@22",JP=JP+1 289 Q 290 22 D:$D(DG)>9 F^DIE17 G ^DVBHCE22 216 X19 I $L(DVBCN)=9,(DVBCN?9N),(DVBCN'=$P(^DPT(D0,0),U,9)) W !!,*7,"HINQ claim # is a SSN, does not match patient file SSN NO UPDATING claim #" R !,?25,"<RET to continue>",DVBQ:DTIME K DVBQ S Y="@22",JP=JP+1 217 Q 218 20 D:$D(DG)>9 F^DIE17 G ^DVBHCE20
Note:
See TracChangeset
for help on using the changeset viewer.
