Changeset 636 for FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RACTOE3.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RACTOE3.m
r628 r636 1 RACTOE3 ; ; 05/26/081 RACTOE3 ; ;12/27/07 2 2 D DE G BEGIN 3 3 DE S DIE="^RAO(75.1,",DIC=DIE,DP=75.1,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^RAO(75.1,DA,""))="" 4 I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,4) S:%]"" DE(1 0)=% S %=$P(%Z,U,9) S:%]"" DE(16)=% S %=$P(%Z,U,12) S:%]"" DE(21)=% S %=$P(%Z,U,13) S:%]"" DE(27)=% S %=$P(%Z,U,14) S:%]"" DE(9)=% S %=$P(%Z,U,17) S:%]"" DE(31)=% S %=$P(%Z,U,22) S:%]"" DE(18)=%5 I $D(^("R")) S %Z=^("R") S %=$P(%Z,U,1) S:%]"" DE( 13)=%4 I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,4) S:%]"" DE(11)=%,DE(20)=% S %=$P(%Z,U,9) S:%]"" DE(27)=% S %=$P(%Z,U,14) S:%]"" DE(9)=% S %=$P(%Z,U,22) S:%]"" DE(32)=% 5 I $D(^("R")) S %Z=^("R") S %=$P(%Z,U,1) S:%]"" DE(24)=% 6 6 K %Z Q 7 7 ; … … 80 80 G RD:X="@",Z 81 81 X9 Q 82 10 S DW="0;4",DV="SX",DU="",DLB="CATEGORY OF EXAM",DIFLD=4 82 10 S DQ=11 ;@20 83 11 S DW="0;4",DV="SX",DU="",DLB="CATEGORY OF EXAM",DIFLD=4 83 84 S DU="I:INPATIENT;O:OUTPATIENT;C:CONTRACT;S:SHARING;E:EMPLOYEE;R:RESEARCH;" 84 85 S X=RACAT 85 86 S Y=X 86 87 G Y 87 X1 0Q88 1 1 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=11 D X11D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE1789 X1 1 S Y=$E(X),Y=$S(Y="R":"@30",(Y'="")&("CS"[Y):"@40",1:"@50")88 X11 Q 89 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 90 X12 S RAX=$E(X,1),Y=$S(RAX="R":"@30","CS"[RAX:"@40",RAX="I"&($D(RAWARD))!("EO"[RAX&('$D(RAWARD))):"@50",1:"@25") 90 91 Q 91 12 S DQ=13 ;@30 92 13 S DW="R;1",DV="FR",DU="",DLB="RESEARCH SOURCE",DIFLD=9.5 92 13 S DQ=14 ;@25 93 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 94 X14 I $D(RAWARD) W !?3,$C(7),"Please choose 'I' for INPATIENT, 'R' RESEARCH, 'C' CONTRACT,",!?3,"'S' SHARING!" 95 Q 96 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 97 X15 I '$D(RAWARD) W !?3,$C(7),"Please choose 'O' for OUTPATIENT, 'E' EMPLOYEE, 'R' RESEARCH,",!?3,"'C' CONTRACT, 'S' SHARING!" 98 Q 99 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 100 X16 D CS^RAORD1A I $D(RALIFN("OUT")) S Y="@26" 101 Q 102 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 103 X17 I '$D(RALIFN("NO")) S Y="@50" 104 Q 105 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 106 X18 K RALIFN("NO") 107 Q 108 19 S DQ=20 ;@26 109 20 S DW="0;4",DV="SX",DU="",DLB="CATEGORY OF EXAM",DIFLD=4 110 S DU="I:INPATIENT;O:OUTPATIENT;C:CONTRACT;S:SHARING;E:EMPLOYEE;R:RESEARCH;" 111 S Y="@" 112 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) 113 G RD 114 X20 Q 115 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 116 X21 K RALIFN("OUT") 117 Q 118 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 119 X22 S Y="@20" 120 Q 121 23 S DQ=24 ;@30 122 24 S DW="R;1",DV="FR",DU="",DLB="RESEARCH SOURCE",DIFLD=9.5 93 123 S X=$S($D(RARSH):RARSH,1:"") 94 124 S Y=X 95 125 G Y 96 X 13K:$L(X)>40!($L(X)<3) X126 X24 K:$L(X)>40!($L(X)<3) X 97 127 I $D(X),X'?.ANP K X 98 128 Q 99 129 ; 100 14 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=14 D X14D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17101 X 14S Y="@50"130 25 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=25 D X25 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 131 X25 S Y="@50" 102 132 Q 103 15 S DQ=16;@40104 16S DW="0;9",DV="*P34'R",DU="",DLB="CONTRACT/SHARING SOURCE",DIFLD=9133 26 S DQ=27 ;@40 134 27 S DW="0;9",DV="*P34'R",DU="",DLB="CONTRACT/SHARING SOURCE",DIFLD=9 105 135 S DU="DIC(34," 106 136 S X=$S($D(RASHA):RASHA,1:"") 107 137 S Y=X 108 138 G Y 109 X 16S 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 X139 X27 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 110 140 Q 111 141 ; 112 17 S DQ=18 ;@50 113 18 S DW="0;22",DV="P44'",DU="",DLB="REQUESTING LOCATION",DIFLD=22 142 28 S DQ=29 ;@50 143 29 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=29 D X29 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 144 X29 I RAX="I",($P($G(^SC(+RALIFN,0)),U,3)'="W"),($P($G(^SC(+RALIFN,0)),U,3)'="OR") S RAWHEN=$P($G(^RAO(75.1,DA,0)),U,21),RAWHEN=$S(RAWHEN]"":$P(RAWHEN,".",1),1:DT) D REQLOC1^RAORD1A 145 Q 146 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 147 X30 I RAX="O",($P($G(^SC(+RALIFN,0)),U,3)'="C"),($P($G(^SC(+RALIFN,0)),U,3)'="OR") D REQLOC1^RAORD1A 148 Q 149 31 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=31 D X31 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 150 X31 I $D(RALIFN("OUT")) K RALIFN("OUT") S Y="@999" 151 Q 152 32 S DW="0;22",DV="P44'a",DU="",DLB="REQUESTING LOCATION",DIFLD=22 153 S DE(DW)="C32^RACTOE3" 114 154 S DU="SC(" 115 155 S X=RALIFN … … 117 157 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) 118 158 G RD:X="@",Z 119 X18 Q 120 19 S DQ=20 ;@100 121 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 122 X20 W !,"IS PATIENT SCHEDULED FOR PRE-OP" S %=2 D YN^DICN S:%<0 Y="@999" S:%=2 Y="@120" I '% W !!,"Enter 'YES' if patient is scheduled for pre-op, or 'NO' if not.",! S Y="@100" 159 C32 G C32S:$D(DE(32))[0 K DB 160 D ^RACTOE4 161 C32S S X="" G:DG(DQ)=X C32F1 K DB 162 D ^RACTOE5 163 C32F1 Q 164 X32 Q 165 33 S DQ=34 ;@100 166 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 167 X34 W !,"IS PATIENT SCHEDULED FOR PRE-OP" S %=2 D YN^DICN S:%<0 Y="@999" S:%=2 Y="@120" I '% W !!,"Enter 'YES' if patient is scheduled for pre-op, or 'NO' if not.",! S Y="@100" 123 168 Q 124 21 S DW="0;12",DV="D",DU="",DLB="PRE-OP SCHEDULED DATE (TIME optional)",DIFLD=12 125 S X="TODAY" 126 S Y=X 127 G Y 128 X21 S %DT="ETX" D ^%DT S X=Y K:Y<1 X 129 Q 130 ; 131 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 132 X22 S:$D(RAEXMUL) RAPREOP1=X 133 Q 134 23 S DQ=24 ;@120 135 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 136 X24 I RASEX="M" S Y="@130" 137 Q 138 25 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=25 D X25 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 139 X25 I RASEX'="F" W !,"THE SEX OF THIS PATIENT IS NOT AVAILABLE. IS PATIENT FEMALE" S %=2 D YN^DICN S:%<0 Y="@999" S:%=2 Y="@130" I '% W !!,"Enter 'YES' if patient is female, or 'NO' if patient is male.",! S Y="@120" 140 Q 141 26 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=26 D X26 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 142 X26 S RASEX="F" 143 Q 144 27 S DW="0;13",DV="RS",DU="",DLB="PREGNANT",DIFLD=13 145 S DU="y:YES;n:NO;u:UNKNOWN;" 146 S X=$S($D(RAPREG):$$EXTERNAL^DILFD(75.1,13,"",RAPREG),1:"") 147 S Y=X 148 G Y 149 X27 Q 150 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 151 X28 S RAPREG=X 152 Q 153 29 S DQ=30 ;@130 154 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 155 X30 I '$D(RAVSTFLG)!('$D(RAVLEDTI)) S Y="@135" 156 Q 157 31 S DW="0;17",DV="D",DU="",DLB="PAST VISIT DATE/TIME",DIFLD=17 158 S X=9999999.9999-RAVLEDTI 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 X31 S %DT="TXR" D ^%DT S X=Y K:Y<1 X 163 Q 164 ; 165 32 S DQ=33 ;@135 166 33 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=33 D X33 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 167 X33 S:$D(RAWHEN)#2 Y="@145" 168 Q 169 34 D:$D(DG)>9 F^DIE17 G ^RACTOE4 169 35 D:$D(DG)>9 F^DIE17 G ^RACTOE6
Note:
See TracChangeset
for help on using the changeset viewer.