- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RACTRG5.m
r613 r623 1 RACTRG5 ; ; 01/02/091 RACTRG5 ; ;11/06/06 2 2 D DE G BEGIN 3 DE S DIE="^RADPT(D0,""DT"",D1,""P"",",DIC=DIE,DP=70.03,DL=3,DIEL=2,DU="" K DG,DE,DB Q:$O(^RADPT(D0,"DT",D1,"P",DA,""))="" 4 I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,4) S:%]"" DE(5)=% S %=$P(%Z,U,6) S:%]"" DE(23)=%,DE(26)=% S %=$P(%Z,U,7) S:%]"" DE(29)=%,DE(32)=% S %=$P(%Z,U,8) S:%]"" DE(16)=% S %=$P(%Z,U,9) S:%]"" DE(11)=% S %=$P(%Z,U,11) S:%]"" DE(1)=% 5 I S %=$P(%Z,U,14) S:%]"" DE(2)=% S %=$P(%Z,U,18) S:%]"" DE(3)=% S %=$P(%Z,U,19) S:%]"" DE(35)=%,DE(38)=% S %=$P(%Z,U,21) S:%]"" DE(40)=% S %=$P(%Z,U,22) S:%]"" DE(41)=% 6 I $D(^("R")) S %Z=^("R") S %=$P(%Z,U,1) S:%]"" DE(8)=% 3 DE S DIE="^RADPT(D0,""DT"",D1,""P"",D2,""M"",",DIC=DIE,DP=70.1,DL=4,DIEL=3,DU="" K DG,DE,DB Q:$O(^RADPT(D0,"DT",D1,"P",D2,"M",DA,""))="" 4 I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,1) S:%]"" DE(1)=% 7 5 K %Z Q 8 6 ; … … 51 49 NKEY W:'$D(ZTQUEUED) "?? Required key field" S X="?BAD" G QS 52 50 KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY") 53 BEGIN S DNM="RACTRG5",DQ=1 54 1 S DW="0;1 1",DV="P75.1'",DU="",DLB="IMAGING ORDER",DIFLD=1151 BEGIN S DNM="RACTRG5",DQ=1+D G B 52 1 S DW="0;1",DV="M*P71.2'X",DU="",DLB="PROCEDURE MODIFIERS",DIFLD=.01 55 53 S DE(DW)="C1^RACTRG5" 56 S DU="RAO(75.1," 57 S X=RAOIFN 58 S Y=X 59 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) 60 G RD:X="@",Z 54 S DU="RAMIS(71.2," 55 G RE:'D S DQ=2 G 2 61 56 C1 G C1S:$D(DE(1))[0 K DB 62 57 S X=DE(1),DIC=DIE 63 K ^RADPT( "AO",$E(X,1,30),DA(2),DA(1),DA)58 K ^RADPT(DA(3),"DT",DA(2),"P",DA(1),"M","B",$E(X,1,30),DA) 64 59 C1S S X="" G:DG(DQ)=X C1F1 K DB 65 60 S X=DG(DQ),DIC=DIE 66 S ^RADPT( "AO",$E(X,1,30),DA(2),DA(1),DA)=""61 S ^RADPT(DA(3),"DT",DA(2),"P",DA(1),"M","B",$E(X,1,30),DA)="" 67 62 C1F1 Q 68 X1 Q 69 2 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW="0;14",DV="R*P200'X",DU="",DLB="REQUESTING PHYSICIAN",DIFLD=14 70 S DU="VA(200," 71 S X=$S($D(RAPIFN):RAPIFN,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 X2 Q 76 3 S DW="0;18",DV="*P78.6'",DU="",DLB="PRIMARY CAMERA/EQUIP/RM",DIFLD=18 77 S DU="RA(78.6," 78 S X=$S($P(RAPX(RACNI),U,15)]"":$P(RAPX(RACNI),U,15),1:"") 79 S Y=X 80 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) 81 G RD:X="@",Z 82 X3 Q 83 4 S DQ=5 ;@20 84 5 S DW="0;4",DV="RSX",DU="",DLB="CATEGORY OF EXAM",DIFLD=4 85 S DU="I:INPATIENT;O:OUTPATIENT;C:CONTRACT;S:SHARING;E:EMPLOYEE;R:RESEARCH;" 86 S X=RACAT 87 S Y=X 88 G Y 89 X5 I $D(X),$E(X)="I" S DFN=DA(2),VAINDT=9999999.9999-DA(1) D ADM^VADPT2 I 'VADMVT K X W !?3,"Patient not an inpatient at registration time.",! 63 X1 S DIC("S")="X ^DD(70.1,.01,9.2)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X 90 64 Q 91 65 ; 92 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 93 X6 S RAX=$E(X),Y=$S(RAX="I":"@60",RAX="E":"@45",RAX="R":"@30","CS"[RAX:"@40",1:"@50") K RAX 94 Q 95 7 S DQ=8 ;@30 96 8 S DW="R;1",DV="FR",DU="",DLB="RESEARCH SOURCE",DIFLD=9.5 97 S X=$S($D(RARSH):RARSH,1:"") 98 S Y=X 99 G Y 100 X8 K:$L(X)>40!($L(X)<3) X 101 I $D(X),X'?.ANP K X 102 Q 103 ; 104 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 105 X9 S Y=$S($D(RAWARD):"@60",1:"@50") 106 Q 107 10 S DQ=11 ;@40 108 11 S DW="0;9",DV="*P34'R",DU="",DLB="CONTRACT/SHARING SOURCE",DIFLD=9 109 S DU="DIC(34," 110 S X=$S($D(RASHA):RASHA,1:"") 111 S Y=X 112 G Y 113 X11 S DIC("S")="I $S('$D(^(""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X 114 Q 115 ; 116 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 117 X12 S Y="@100" 118 Q 119 13 S DQ=14 ;@45 120 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 121 X14 S:$D(RAWARD) Y="@60" 122 Q 123 15 S DQ=16 ;@50 124 16 S DW="0;8",DV="*P44'R",DU="",DLB="PRINCIPAL CLINIC",DIFLD=8 125 S DU="SC(" 126 S X=$S($D(RACLNC):RACLNC,1:"") 127 S Y=X 128 G Y 129 X16 S DIC("S")="I $P(^(0),U,3)=""C""" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X 130 Q 131 ; 132 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 133 X17 S RACLNC=$P(^SC(X,0),U) 134 Q 135 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 136 X18 S Y="@100" 137 Q 138 19 S DQ=20 ;@60 139 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 140 X20 S:'$D(RAWARD) RAWARD="Unknown" S:'$D(RASER) RASER="Unknown" S:'$D(RABED) RABED="Unknown" 141 Q 142 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 143 X21 W !?5,"Ward: ",RAWARD," Service: ",RASER," Bedsection: ",RABED 144 Q 145 22 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=22 D X22 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 146 X22 I RAWARD'="Unknown" S Y="@66" 147 Q 148 23 S DW="0;6",DV="P42'R",DU="",DLB="WARD",DIFLD=6 149 S DU="DIC(42," 150 G RE 151 X23 Q 152 24 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=24 D X24 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 153 X24 S Y="@68" 154 Q 155 25 S DQ=26 ;@66 156 26 S DW="0;6",DV="P42'",DU="",DLB="WARD",DIFLD=6 157 S DU="DIC(42," 158 S X=RAWARD 159 S Y=X 160 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) 161 G RD 162 X26 Q 163 27 S DQ=28 ;@68 164 28 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=28 D X28 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 X28 I RASER'="Unknown" S Y="@80" 166 Q 167 29 S DW="0;7",DV="P49'R",DU="",DLB="SERVICE",DIFLD=7 168 S DU="DIC(49," 169 G RE 170 X29 Q 171 30 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=30 D X30 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 172 X30 S Y="@85" 173 Q 174 31 S DQ=32 ;@80 175 32 S DW="0;7",DV="P49'",DU="",DLB="SERVICE",DIFLD=7 176 S DU="DIC(49," 177 S X=RASER 178 S Y=X 179 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) 180 G RD 181 X32 Q 182 33 S DQ=34 ;@85 183 34 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=34 D X34 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 184 X34 I RABED'="Unknown" S Y="@95" 185 Q 186 35 S DW="0;19",DV="P42.4'R",DU="",DLB="BEDSECTION",DIFLD=19 187 S DU="DIC(42.4," 188 G RE 189 X35 Q 190 36 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=36 D X36 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 191 X36 S Y="@100" 192 Q 193 37 S DQ=38 ;@95 194 38 S DW="0;19",DV="P42.4'",DU="",DLB="BEDSECTION",DIFLD=19 195 S DU="DIC(42.4," 196 S X=RABED 197 S Y=X 198 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) 199 G RD 200 X38 Q 201 39 S DQ=40 ;@100 202 40 S DW="0;21",DV="D",DU="",DLB="REQUESTED DATE",DIFLD=21 203 S X=$S($D(RARDTE):RARDTE,1:"") 204 S Y=X 205 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) 206 G RD:X="@",Z 207 X40 Q 208 41 S DW="0;22",DV="P44'",DU="",DLB="REQUESTING LOCATION",DIFLD=22 209 S DU="SC(" 210 S X=$S($D(RALIFN):RALIFN,1:"") 211 S Y=X 212 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) 213 G RD:X="@",Z 214 X41 Q 215 42 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=42 D X42 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 216 X42 I '$D(^RAMIS(71,RAPRI,"F",0)) S Y="@300" 217 Q 218 43 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=43 D X43 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 219 X43 S RAI=0 220 Q 221 44 S DQ=45 ;@200 222 45 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=45 D X45 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 X45 S RAI=$O(^RAMIS(71,RAPRI,"F",RAI)) S:RAI'>0!('$D(^(+RAI,0))) Y="@300" 224 Q 225 46 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=46 D X46 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 226 X46 S RAFM(1)=+^RAMIS(71,RAPRI,"F",RAI,0),RAFM1=+$P(^(0),U,2),RAFM=$S($D(^RA(78.4,RAFM(1),0)):$P(^(0),U),1:-1),RAFM=$S('$D(^("I")):RAFM,'^("I"):RAFM,1:-1) S:RAFM<0 Y="@200" 227 Q 228 47 D:$D(DG)>9 F^DIE17 G ^RACTRG6 66 2 G 1^DIE17
Note:
See TracChangeset
for help on using the changeset viewer.