- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUEDS6.m
r613 r623 1 TIUEDS6 ; ;11/08/09 2 D DE G BEGIN 3 DE S DIE="^TIU(8925,",DIC=DIE,DP=8925,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^TIU(8925,DA,""))="" 4 I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,12) S:%]"" DE(5)=% 5 I $D(^(12)) S %Z=^(12) S %=$P(%Z,U,1) S:%]"" DE(15)=% S %=$P(%Z,U,4) S:%]"" DE(23)=% S %=$P(%Z,U,8) S:%]"" DE(24)=% S %=$P(%Z,U,9) S:%]"" DE(18)=%,DE(21)=% 6 I $D(^(13)) S %Z=^(13) S %=$P(%Z,U,1) S:%]"" DE(7)=% S %=$P(%Z,U,2) S:%]"" DE(9)=% S %=$P(%Z,U,3) S:%]"" DE(12)=% S %=$P(%Z,U,7) S:%]"" DE(1)=% 7 I $D(^(14)) S %Z=^(14) S %=$P(%Z,U,1) S:%]"" DE(26)=% S %=$P(%Z,U,2) S:%]"" DE(27)=% S %=$P(%Z,U,4) S:%]"" DE(28)=% 8 I $D(^(15)) S %Z=^(15) S %=$P(%Z,U,6) S:%]"" DE(25)=% 9 K %Z Q 10 ; 11 W W !?DL+DL-2,DLB_": " 12 Q 13 O D W W Y W:$X>45 !?9 14 I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2 15 W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W " (No Editing)" Q 16 TR R X:DTIME E S (DTOUT,X)=U W $C(7) 17 Q 18 A K DQ(DQ) S DQ=DQ+1 19 B G @DQ 20 RE G PR:$D(DE(DQ)) D W,TR 21 N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A 22 RD G QS:X?."?" I X["^" D D G ^DIE17 23 I X="@" D D G Z^DIE2 24 I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W " "_X 25 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 26 K DDER G X 27 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 28 G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z 29 I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X 30 V D @("X"_DQ) K YS 31 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 32 X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17 33 S X="?BAD" 34 QS S DZ=X D D,QQ^DIEQ G B 35 D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q 36 Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N 37 PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP 38 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 39 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 40 X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=% 41 RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17 42 I I DV'["I",DV'["#" G RD 43 D E^DIE0 G RD:$D(X),PR 44 Q 45 SET N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=1 46 I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1 47 D ^DIR I 'DDER S %=Y(0),X=Y 48 Q 49 SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ)) 50 I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")="" 51 E K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/") 52 Q 53 NKEY W:'$D(ZTQUEUED) "?? Required key field" S X="?BAD" G QS 54 KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY") 55 BEGIN S DNM="TIUEDS6",DQ=1 56 1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW="13;7",DV="DR",DU="",DLB="DICTATION DATE",DIFLD=1307 57 G RE 58 X1 S %DT="ETX" D ^%DT S X=Y K:Y<1 X 59 Q 60 ; 61 2 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=2 G A 62 3 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=3 D X3 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 63 X3 S TIUREFDT=$$REFDATE^TIULC1(.TIU,+X) 64 Q 65 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 66 X4 I +$P(TIUREFDT,U,2)'>0 S Y="@4" 67 Q 68 5 S DW="0;12",DV="S",DU="",DLB="MARK DISCH DT FOR CORRECTION",DIFLD=.12 69 S DE(DW)="C5^TIUEDS6" 70 S DU="1:YES;" 71 S X=1 72 S Y=X 73 S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 74 G RD:X="@",Z 75 C5 G C5S:$D(DE(5))[0 K DB 76 S X=DE(5),DIC=DIE 77 K ^TIU(8925,"FIX",$E(X,1,30),DA) 78 C5S S X="" G:DG(DQ)=X C5F1 K DB 79 S X=DG(DQ),DIC=DIE 80 S ^TIU(8925,"FIX",$E(X,1,30),DA)="" 81 C5F1 Q 82 X5 Q 83 6 S DQ=7 ;@4 84 7 D:$D(DG)>9 F^DIE17,DE S DQ=7,DW="13;1",DV="D",DU="",DLB="REFERENCE DATE",DIFLD=1301 85 S DE(DW)="C7^TIUEDS6",DE(DW,"INDEX")=1 86 S X=$P(TIUREFDT,U) 87 S Y=X 88 S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 89 G RD:X="@",Z 90 C7 G C7S:$D(DE(7))[0 K DB 91 D ^TIUEDS7 92 C7S S X="" G:DG(DQ)=X C7F1 K DB 93 D ^TIUEDS8 94 C7F1 S DIEZRXR(8925,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE))) 95 F DIXR=247 S DIEZRXR(8925,DIXR)="" 96 Q 97 X7 Q 98 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 99 X8 I +$P($G(^TIU(8925,+DA,13)),U,2) S Y="@5" 100 Q 101 9 D:$D(DG)>9 F^DIE17,DE S DQ=9,DW="13;2",DV="P200'O",DU="",DLB="ENTERED BY",DIFLD=1302 102 S DQ(9,2)="S Y(0)=Y S Y=$S(+$G(TIUINI):$$LOWER^TIULS($P($G(^VA(200,+Y(0),0)),U,2)),1:$P($G(^VA(200,+Y(0),0)),U,2))" 103 S DE(DW)="C9^TIUEDS6" 104 S DU="VA(200," 105 S X=DUZ 106 S Y=X 107 S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 108 G RD:X="@",Z 109 C9 G C9S:$D(DE(9))[0 K DB 1 TIUEDS6 ; ;03/29/06 110 2 S X=DE(9),DIC=DIE 111 K ^TIU(8925,"TC",$E(X,1,30),DA)3 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,12)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"AAU",+$P(^TIU(8925,+DA,12),U,2),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA) 112 4 S X=DE(9),DIC=DIE 113 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,1 3)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ATC",+X,+$P($G(^TIU(8925,+DA,0)),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)5 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,12)),U,8),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ASUP",+$P(^TIU(8925,+DA,12),U,8),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA) 114 6 S X=DE(9),DIC=DIE 115 D KACLAU1^TIUDD01(1302,X) 116 C9S S X="" G:DG(DQ)=X C9F1 K DB 117 S X=DG(DQ),DIC=DIE 118 S ^TIU(8925,"TC",$E(X,1,30),DA)="" 119 S X=DG(DQ),DIC=DIE 120 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"ATC",+X,+$P($G(^TIU(8925,+DA,0)),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)="" 121 S X=DG(DQ),DIC=DIE 122 D SACLAU1^TIUDD0(1302,X) 123 C9F1 Q 124 X9 Q 125 10 S DQ=11 ;@5 126 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 127 X11 I $P($G(^TIU(8925,+DA,13)),U,3)]"" S Y="@6" 128 Q 129 12 D:$D(DG)>9 F^DIE17,DE S DQ=12,DW="13;3",DV="S",DU="",DLB="CAPTURE METHOD",DIFLD=1303 130 S DU="D:direct;U:upload;C:converted;R:remote procedure;O:copy;" 131 S X="D" 132 S Y=X 133 S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 134 G RD:X="@",Z 135 X12 Q 136 13 S DQ=14 ;@6 137 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 138 X14 I +$P($G(^TIU(8925,+DA,12)),U) S Y="@7" 139 Q 140 15 S DW="12;1",DV="D",DU="",DLB="ENTRY DATE/TIME",DIFLD=1201 141 S DE(DW)="C15^TIUEDS6" 142 S X=$$NOW^TIULC 143 S Y=X 144 S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 145 G RD:X="@",Z 146 C15 G C15S:$D(DE(15))[0 K DB 147 S X=DE(15),DIC=DIE 148 K ^TIU(8925,"F",$E(X,1,30),DA) 149 C15S S X="" G:DG(DQ)=X C15F1 K DB 150 S X=DG(DQ),DIC=DIE 151 S ^TIU(8925,"F",$E(X,1,30),DA)="" 152 C15F1 Q 153 X15 Q 154 16 S DQ=17 ;@7 155 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 156 X17 I +$$PROVIDER^TIUPXAP1(DUZ,DT)'>0 S Y="@9" 157 Q 158 18 D:$D(DG)>9 F^DIE17,DE S DQ=18,DW="12;9",DV="*P200'XR",DU="",DLB="ATTENDING PHYSICIAN",DIFLD=1209 159 S DU="VA(200," 160 G RE 161 X18 S DIC("S")="I +$G(DA),+$$SCRATT^TIULA3(+DA,+Y)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X 162 Q 163 ; 164 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 165 X19 S Y="@10" 166 Q 167 20 S DQ=21 ;@9 168 21 S DW="12;9",DV="*P200'X",DU="",DLB="ATTENDING PHYSICIAN",DIFLD=1209 169 S DU="VA(200," 170 G RE 171 X21 S DIC("S")="I +$G(DA),+$$SCRATT^TIULA3(+DA,+Y)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X 172 Q 173 ; 174 22 S DQ=23 ;@10 175 23 S DW="12;4",DV="P200'O",DU="",DLB="EXPECTED SIGNER",DIFLD=1204 176 S DQ(23,2)="S Y(0)=Y S:+Y>0&$D(TIUSIG) Y=$S($L($P(^VA(200,+Y,20),U,2)):$P(^(20),U,2),1:$P(^VA(200,+Y,0),U)) S:+Y>0&'$D(TIUSIG) Y=$P(^VA(200,+Y,0),U)" 177 S DU="VA(200," 178 S X=$$WHOSIGNS^TIULC1(DA) 179 S Y=X 180 S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 181 G RD:X="@",Z 182 X23 Q 183 24 S DW="12;8",DV="*P200'",DU="",DLB="EXPECTED COSIGNER",DIFLD=1208 184 S DE(DW)="C24^TIUEDS6" 185 S DU="VA(200," 186 S X=$$WHOCOSIG^TIULC1(DA) 187 S Y=X 188 S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 189 G RD:X="@",Z 190 C24 G C24S:$D(DE(24))[0 K DB 191 S X=DE(24),DIC=DIE 192 K ^TIU(8925,"CS",$E(X,1,30),DA) 193 S X=DE(24),DIC=DIE 194 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ASUP",+X,+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA) 195 S X=DE(24),DIC=DIE 196 D KACLEC^TIUDD01(1208,X) 197 C24S S X="" G:DG(DQ)=X C24F1 K DB 198 S X=DG(DQ),DIC=DIE 199 S ^TIU(8925,"CS",$E(X,1,30),DA)="" 200 S X=DG(DQ),DIC=DIE 201 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"ASUP",+X,+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)="" 202 S X=DG(DQ),DIC=DIE 203 D SACLEC^TIUDD0(1208,X) 204 C24F1 Q 205 X24 Q 206 25 D:$D(DG)>9 F^DIE17,DE S DQ=25,DW="15;6",DV="S",DU="",DLB="COSIGNATURE NEEDED",DIFLD=1506 207 S DU="1:YES;0:NO;" 208 S X=$S(+$P($G(^TIU(8925,+DA,12)),U,4)=+$P($G(^TIU(8925,+DA,12)),U,9):0,1:1) 209 S Y=X 210 S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 211 G RD:X="@",Z 212 X25 Q 213 26 S DW="14;1",DV="P405'",DU="",DLB="PATIENT MOVEMENT RECORD",DIFLD=1401 214 S DU="DGPM(" 215 S X=$G(TIU("AD#")) 216 S Y=X 217 S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 218 G RD:X="@",Z 219 X26 Q 220 27 S DW="14;2",DV="P45.7'",DU="",DLB="TREATING SPECIALTY",DIFLD=1402 221 S DE(DW)="C27^TIUEDS6" 222 S DU="DIC(45.7," 223 S X=$P($G(TIU("TS")),U) 224 S Y=X 225 S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 226 G RD:X="@",Z 227 C27 G C27S:$D(DE(27))[0 K DB 228 D ^TIUEDS9 229 C27S S X="" G:DG(DQ)=X C27F1 K DB 230 D ^TIUEDS10 231 C27F1 Q 232 X27 Q 233 28 D:$D(DG)>9 F^DIE17,DE S DQ=28,DW="14;4",DV="P49'",DU="",DLB="SERVICE",DIFLD=1404 234 S DE(DW)="C28^TIUEDS6" 235 S DU="DIC(49," 236 S X=$P($G(TIU("SVC")),U) 237 S Y=X 238 S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 239 G RD:X="@",Z 240 C28 G C28S:$D(DE(28))[0 K DB 241 D ^TIUEDS11 242 C28S S X="" G:DG(DQ)=X C28F1 K DB 243 D ^TIUEDS12 244 C28F1 Q 245 X28 Q 246 29 D:$D(DG)>9 F^DIE17 G ^TIUEDS13 7 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"APT",+$P(^TIU(8925,+DA,0),U,2),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA) 8 S X=DE(9),DIC=DIE 9 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,14)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ATS",+$P(^TIU(8925,+DA,14),U,2),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA) 10 S X=DE(9),DIC=DIE 11 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ATC",+$P(^TIU(8925,+DA,13),U,2),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA) 12 S X=DE(9),DIC=DIE 13 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ALL","ANY",+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA) 14 S X=DE(9),DIC=DIE 15 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),$L($P($G(^TIU(8925,+DA,17)),U)) D ASUBK^TIUDD($P($G(^TIU(8925,+DA,17)),U),+$G(^TIU(8925,+DA,0)),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA) 16 S X=DE(9),DIC=DIE 17 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,14)),U,4),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ASVC",+$P(^TIU(8925,+DA,14),U,4),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA) 18 S X=DE(9),DIC=DIE 19 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),+$O(^TIU(8925.9,"B",+DA,0)) D APRBK^TIUDD(+$G(^TIU(8925,+DA,0)),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA) 20 S X=DE(9),DIC=DIE 21 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,3),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"AVSIT",+$P(^TIU(8925,+DA,0),U,3),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),DA) 22 S X=DE(9),DIC=DIE 23 I +$P($G(^TIU(8925,+DA,0)),U,4),+$P($G(^TIU(8925,+DA,0)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ADCPT",+$P(^TIU(8925,+DA,0),U,2),+$P(^TIU(8925,+DA,0),U,4),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),DA) 24 S X=DE(9),DIC=DIE 25 K ^TIU(8925,"D",$E(X,1,30),DA) 26 S X=DE(9),DIC=DIE 27 I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,0)),U,2) K ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),+$$CLINDOC^TIULC1(+$P(^TIU(8925,+DA,0),U),+DA),(9999999-X),DA) 28 S X=DE(9),DIC=DIE 29 I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,0)),U,2) K ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),38,(9999999-X),DA) 30 S X=DE(9),DIC=DIE 31 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,12)),U,5),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ALOC",+$P(^TIU(8925,+DA,12),U,5),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA) 32 S X=DE(9),DIC=DIE 33 D KACLPT^TIUDD01(1301,X) 34 S X=DE(9),DIC=DIE 35 D KACLAU^TIUDD01(1301,X),KACLAU1^TIUDD01(1301,X) 36 S X=DE(9),DIC=DIE 37 D KACLEC^TIUDD01(1301,X) 38 S X=DE(9),DIC=DIE 39 D KACLSB^TIUDD01(1301,X)
Note:
See TracChangeset
for help on using the changeset viewer.