- 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/TIUEDS10.m
r613 r623 1 TIUEDS10 ; ;11/08/09 1 TIUEDS10 ; ;03/29/06 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(^(12)) S %Z=^(12) S %=$P(%Z,U,4) S:%]"" DE(6)=% S %=$P(%Z,U,5) S:%]"" DE(12)=% S %=$P(%Z,U,8) S:%]"" DE(7)=% S %=$P(%Z,U,9) S:%]"" DE(1)=%,DE(4)=% S %=$P(%Z,U,12) S:%]"" DE(13)=% 5 I $D(^(14)) S %Z=^(14) S %=$P(%Z,U,1) S:%]"" DE(9)=% S %=$P(%Z,U,2) S:%]"" DE(10)=% S %=$P(%Z,U,4) S:%]"" DE(11)=% 6 I $D(^(15)) S %Z=^(15) S %=$P(%Z,U,6) S:%]"" DE(8)=% 7 K %Z Q 8 ; 9 W W !?DL+DL-2,DLB_": " 10 Q 11 O D W W Y W:$X>45 !?9 12 I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2 13 W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W " (No Editing)" Q 14 TR R X:DTIME E S (DTOUT,X)=U W $C(7) 15 Q 16 A K DQ(DQ) S DQ=DQ+1 17 B G @DQ 18 RE G PR:$D(DE(DQ)) D W,TR 19 N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A 20 RD G QS:X?."?" I X["^" D D G ^DIE17 21 I X="@" D D G Z^DIE2 22 I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W " "_X 23 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 24 K DDER G X 25 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 26 G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z 27 I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X 28 V D @("X"_DQ) K YS 29 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 30 X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17 31 S X="?BAD" 32 QS S DZ=X D D,QQ^DIEQ G B 33 D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q 34 Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N 35 PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP 36 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 37 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 38 X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=% 39 RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17 40 I I DV'["I",DV'["#" G RD 41 D E^DIE0 G RD:$D(X),PR 42 Q 43 SET N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=1 44 I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1 45 D ^DIR I 'DDER S %=Y(0),X=Y 46 Q 47 SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ)) 48 I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")="" 49 E K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/") 50 Q 51 NKEY W:'$D(ZTQUEUED) "?? Required key field" S X="?BAD" G QS 52 KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY") 53 BEGIN S DNM="TIUEDS10",DQ=1 54 1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW="12;9",DV="*P200'R",DU="",DLB="ATTENDING PHYSICIAN",DIFLD=1209 55 S DU="VA(200," 56 G RE 57 X1 S DIC("S")="I '+$$ISTERM^USRLM(+Y),+$$PROVIDER^TIUPXAP1(+Y,DT)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X 58 Q 59 ; 60 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 61 X2 S Y="@10" 62 Q 63 3 S DQ=4 ;@9 64 4 S DW="12;9",DV="*P200'",DU="",DLB="ATTENDING PHYSICIAN",DIFLD=1209 65 S DU="VA(200," 66 G RE 67 X4 S DIC("S")="I '+$$ISTERM^USRLM(+Y),+$$PROVIDER^TIUPXAP1(+Y,DT)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X 68 Q 69 ; 70 5 S DQ=6 ;@10 71 6 S DW="12;4",DV="P200'O",DU="",DLB="EXPECTED SIGNER",DIFLD=1204 72 S DQ(6,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)" 73 S DU="VA(200," 74 S X=$$WHOSIGNS^TIULC1(DA) 75 S Y=X 76 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) 77 G RD:X="@",Z 78 X6 Q 79 7 S DW="12;8",DV="*P200'",DU="",DLB="EXPECTED COSIGNER",DIFLD=1208 80 S DE(DW)="C7^TIUEDS10" 81 S DU="VA(200," 82 S X=$$WHOCOSIG^TIULC1(DA) 83 S Y=X 84 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) 85 G RD:X="@",Z 86 C7 G C7S:$D(DE(7))[0 K DB 87 S X=DE(7),DIC=DIE 88 K ^TIU(8925,"CS",$E(X,1,30),DA) 89 S X=DE(7),DIC=DIE 90 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) 91 S X=DE(7),DIC=DIE 92 D KACLEC^TIUDD01(1208,X) 93 C7S S X="" G:DG(DQ)=X C7F1 K DB 94 S X=DG(DQ),DIC=DIE 95 S ^TIU(8925,"CS",$E(X,1,30),DA)="" 96 S X=DG(DQ),DIC=DIE 97 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)="" 98 S X=DG(DQ),DIC=DIE 99 D SACLEC^TIUDD0(1208,X) 100 C7F1 Q 101 X7 Q 102 8 D:$D(DG)>9 F^DIE17,DE S DQ=8,DW="15;6",DV="S",DU="",DLB="COSIGNATURE NEEDED",DIFLD=1506 103 S DU="1:YES;0:NO;" 104 S X=$S(+$P($G(^TIU(8925,+DA,12)),U,4)=+$P($G(^TIU(8925,+DA,12)),U,9):0,1:1) 105 S Y=X 106 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) 107 G RD:X="@",Z 108 X8 Q 109 9 S DW="14;1",DV="P405'",DU="",DLB="PATIENT MOVEMENT RECORD",DIFLD=1401 110 S DU="DGPM(" 111 S X=$G(TIU("AD#")) 112 S Y=X 113 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) 114 G RD:X="@",Z 115 X9 Q 116 10 S DW="14;2",DV="P45.7'",DU="",DLB="TREATING SPECIALTY",DIFLD=1402 117 S DE(DW)="C10^TIUEDS10" 118 S DU="DIC(45.7," 119 S X=$P($G(TIU("TS")),U) 120 S Y=X 121 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) 122 G RD:X="@",Z 123 C10 G C10S:$D(DE(10))[0 K DB 124 S X=DE(10),DIC=DIE 125 K ^TIU(8925,"TS",$E(X,1,30),DA) 126 S X=DE(10),DIC=DIE 127 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,"ATS",+X,+$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA) 128 C10S S X="" G:DG(DQ)=X C10F1 K DB 2 129 S X=DG(DQ),DIC=DIE 3 130 S ^TIU(8925,"TS",$E(X,1,30),DA)="" 4 131 S X=DG(DQ),DIC=DIE 5 132 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,"ATS",+X,+$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)="" 133 C10F1 Q 134 X10 Q 135 11 D:$D(DG)>9 F^DIE17,DE S DQ=11,DW="14;4",DV="P49'",DU="",DLB="SERVICE",DIFLD=1404 136 S DE(DW)="C11^TIUEDS10" 137 S DU="DIC(49," 138 S X=$P($G(TIU("SVC")),U) 139 S Y=X 140 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) 141 G RD:X="@",Z 142 C11 G C11S:$D(DE(11))[0 K DB 143 S X=DE(11),DIC=DIE 144 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,"ASVC",+X,+$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA) 145 S X=DE(11),DIC=DIE 146 K ^TIU(8925,"SVC",$E(X,1,30),DA) 147 C11S S X="" G:DG(DQ)=X C11F1 K DB 148 S X=DG(DQ),DIC=DIE 149 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,"ASVC",+X,+$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)="" 150 S X=DG(DQ),DIC=DIE 151 S ^TIU(8925,"SVC",$E(X,1,30),DA)="" 152 C11F1 Q 153 X11 Q 154 12 D:$D(DG)>9 F^DIE17,DE S DQ=12,DW="12;5",DV="P44'",DU="",DLB="HOSPITAL LOCATION",DIFLD=1205 155 S DE(DW)="C12^TIUEDS10" 156 S DU="SC(" 157 S X=$P($G(TIU("LOC")),U) 158 S Y=X 159 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) 160 G RD:X="@",Z 161 C12 G C12S:$D(DE(12))[0 K DB 162 D ^TIUEDS11 163 C12S S X="" G:DG(DQ)=X C12F1 K DB 164 D ^TIUEDS12 165 C12F1 Q 166 X12 Q 167 13 D:$D(DG)>9 F^DIE17,DE S DQ=13,DW="12;12",DV="P4'",DU="",DLB="DIVISION",DIFLD=1212 168 S DE(DW)="C13^TIUEDS10",DE(DW,"INDEX")=1 169 S DU="DIC(4," 170 S X=$P($G(TIU("INST")),U) 171 S Y=X 172 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) 173 G RD:X="@",Z 174 C13 G C13S:$D(DE(13))[0 K DB 175 C13S S X="" G:DG(DQ)=X C13F1 K DB 176 D ^TIUEDS13 177 C13F1 S DIEZRXR(8925,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE))) 178 F DIXR=247 S DIEZRXR(8925,DIXR)="" 179 Q 180 X13 Q 181 14 G 0^DIE17
Note:
See TracChangeset
for help on using the changeset viewer.