Changeset 623 for WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RACTRG6.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RACTRG6.m (modified) (2 diffs)

WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RACTRG6.m

@@ -1 @@
-RACTRG6 ; ;01/02/09
+RACTRG6 ; ;11/06/06
  D DE G BEGIN
 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,""))=""
- I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,28) S:%]"" DE(18)=%
+ I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,6) S:%]"" DE(1)=%,DE(4)=% S %=$P(%Z,U,7) S:%]"" DE(7)=%,DE(10)=% S %=$P(%Z,U,19) S:%]"" DE(13)=%,DE(16)=% S %=$P(%Z,U,21) S:%]"" DE(18)=% S %=$P(%Z,U,22) S:%]"" DE(19)=%
  K %Z Q
  ;
@@ -50 +50 @@
 KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
 BEGIN S DNM="RACTRG6",DQ=1
-1 S D=0 K DE(1) ;50
+1 S DW="0;6",DV="P42'R",DU="",DLB="WARD",DIFLD=6
+ S DU="DIC(42,"
+ G RE
+X1 Q
+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
+X2 S Y="@68"
+ Q
+3 S DQ=4 ;@66
+4 S DW="0;6",DV="P42'",DU="",DLB="WARD",DIFLD=6
+ S DU="DIC(42,"
+ S X=RAWARD
+ S Y=X
+ 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)
+ G RD
+X4 Q
+5 S DQ=6 ;@68
+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
+X6 I RASER'="Unknown" S Y="@80"
+ Q
+7 S DW="0;7",DV="P49'R",DU="",DLB="SERVICE",DIFLD=7
+ S DU="DIC(49,"
+ G RE
+X7 Q
+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
+X8 S Y="@85"
+ Q
+9 S DQ=10 ;@80
+10 S DW="0;7",DV="P49'",DU="",DLB="SERVICE",DIFLD=7
+ S DU="DIC(49,"
+ S X=RASER
+ S Y=X
+ 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)
+ G RD
+X10 Q
+11 S DQ=12 ;@85
+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
+X12 I RABED'="Unknown" S Y="@95"
+ Q
+13 S DW="0;19",DV="P42.4'R",DU="",DLB="BEDSECTION",DIFLD=19
+ S DU="DIC(42.4,"
+ G RE
+X13 Q
+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
+X14 S Y="@100"
+ Q
+15 S DQ=16 ;@95
+16 S DW="0;19",DV="P42.4'",DU="",DLB="BEDSECTION",DIFLD=19
+ S DU="DIC(42.4,"
+ S X=RABED
+ S Y=X
+ 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)
+ G RD
+X16 Q
+17 S DQ=18 ;@100
+18 S DW="0;21",DV="D",DU="",DLB="REQUESTED DATE",DIFLD=21
+ S X=$S($D(RARDTE):RARDTE,1:"")
+ S Y=X
+ 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)
+ G RD:X="@",Z
+X18 Q
+19 S DW="0;22",DV="P44'",DU="",DLB="REQUESTING LOCATION",DIFLD=22
+ S DU="SC("
+ S X=$S($D(RALIFN):RALIFN,1:"")
+ S Y=X
+ 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)
+ G RD:X="@",Z
+X19 Q
+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
+X20 I '$D(^RAMIS(71,RAPRI,"F",0)) S Y="@300"
+ Q
+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
+X21 S RAI=0
+ Q
+22 S DQ=23 ;@200
+23 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=23 D X23 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
+X23 S RAI=$O(^RAMIS(71,RAPRI,"F",RAI)) S:RAI'>0!('$D(^(+RAI,0))) Y="@300"
+ Q
+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
+X24 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"
+ Q
+25 S D=0 K DE(1) ;50
  S DIFLD=50,DGO="^RACTRG7",DC="2^70.04PA^F^",DV="70.04M*P78.4'",DW="0;1",DOW="FILM SIZE",DLB="Select "_DOW S:D DC=DC_D
  S DU="RA(78.4,"
- G RE:D I $D(DSC(70.04))#2,$P(DSC(70.04),"I $D(^UTILITY(",1)="" X DSC(70.04) S D=$O(^(0)) S:D="" D=-1 G M1
+ G RE:D I $D(DSC(70.04))#2,$P(DSC(70.04),"I $D(^UTILITY(",1)="" X DSC(70.04) S D=$O(^(0)) S:D="" D=-1 G M25
  S D=$S($D(^RADPT(D0,"DT",D1,"P",DA,"F",0)):$P(^(0),U,3,4),$O(^(0))'="":$O(^(0)),1:-1)
-M1 I D>0 S DC=DC_D I $D(^RADPT(D0,"DT",D1,"P",DA,"F",+D,0)) S DE(1)=$P(^(0),U,1)
+M25 I D>0 S DC=DC_D I $D(^RADPT(D0,"DT",D1,"P",DA,"F",+D,0)) S DE(25)=$P(^(0),U,1)
  S X=RAFM
  S Y=X
  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)
  G RD
-R1 D DE
+R25 D DE
  G A
  ;
-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
-X2 S Y="@200"
+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
+X26 S Y="@200"
  Q
-3 S DQ=4 ;@300
-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
-X4 S RAPOP=0 D USER^RAUTL S:RAPOP Y="@999"
+27 S DQ=28 ;@300
+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
+X28 S RAPOP=0 D USER^RAUTL S:RAPOP Y="@999"
  Q
-5 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=5 D X5 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
-X5 S:'$P(RAMDV,U,10) Y="@350"
+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
+X29 S:'$P(RAMDV,U,10) Y="@350"
  Q
-6 S D=0 K DE(1) ;75
+30 S D=0 K DE(1) ;75
  S DIFLD=75,DGO="^RACTRG8",DC="3^70.05DA^T^",DV="70.05DX",DW="0;1",DOW="STATUS CHANGE DATE/TIME",DLB="Select "_DOW S:D DC=DC_D
- I $D(DSC(70.05))#2,$P(DSC(70.05),"I $D(^UTILITY(",1)="" X DSC(70.05) S D=$O(^(0)) S:D="" D=-1 G M6
+ I $D(DSC(70.05))#2,$P(DSC(70.05),"I $D(^UTILITY(",1)="" X DSC(70.05) S D=$O(^(0)) S:D="" D=-1 G M30
  S D=$S($D(^RADPT(D0,"DT",D1,"P",DA,"T",0)):$P(^(0),U,3,4),$O(^(0))'="":$O(^(0)),1:-1)
-M6 I D>0 S DC=DC_D I $D(^RADPT(D0,"DT",D1,"P",DA,"T",+D,0)) S DE(6)=$P(^(0),U,1)
+M30 I D>0 S DC=DC_D I $D(^RADPT(D0,"DT",D1,"P",DA,"T",+D,0)) S DE(30)=$P(^(0),U,1)
  S X="""NOW"""
  S Y=X
  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)
  G RD
-R6 D DE
+R30 D DE
  G A
  ;
-7 S DQ=8 ;@350
-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
-X8 S RANMFLG=0
+31 S DQ=32 ;@350
+32 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=32 D X32 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
+X32 S RANMFLG=0
  Q
-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
-X9 S:'$D(RAIMGTYI) RAIMGTYI=$O(^RA(79.2,"B",RAIMGTY,0))
+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
+X33 S:'$D(RAIMGTYI) RAIMGTYI=$O(^RA(79.2,"B",RAIMGTY,0))
  Q
-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
-X10 S:$P($G(^RA(79.2,+$G(RAIMGTYI),0)),"^",5)="Y" RANMFLG=1
+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
+X34 S:$P($G(^RA(79.2,+$G(RAIMGTYI),0)),"^",5)="Y" RANMFLG=1
  Q
-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
-X11 S:'RANMFLG Y="@450"
+35 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=35 D X35 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
+X35 S:'RANMFLG Y="@450"
  Q
-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
-X12 S:'$O(^RAMIS(71,RAPRI,"NUC",0)) Y="@450"
+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
+X36 S:'$O(^RAMIS(71,RAPRI,"NUC",0)) Y="@450"
  Q
-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
-X13 S REM="is this proc's ASK RADIOPHARMACEUTICAL = NEVER ?"
+37 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=37 D X37 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
+X37 S REM="is this proc's ASK RADIOPHARMACEUTICAL = NEVER ?"
  Q
-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
-X14 S:$P(^RAMIS(71,RAPRI,0),U,2)=1 Y="@450"
+38 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=38 D X38 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
+X38 S:$P(^RAMIS(71,RAPRI,0),U,2)=1 Y="@450"
  Q
-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
-X15 S REM="en1^ranmpt1 will stuff default radiopharms during registration"
+39 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=39 D X39 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
+X39 S REM="en1^ranmpt1 will stuff default radiopharms during registration"
  Q
-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
-X16 S RAIEN702=$$EN1^RANMPT1(RADFN,RADTE,RACN)
+40 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=40 D X40 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
+X40 S RAIEN702=$$EN1^RANMPT1(RADFN,RADTE,RACN)
  Q
-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
-X17 S:RAIEN702=-1 Y="@450"
+41 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=41 D X41 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
+X41 S:RAIEN702=-1 Y="@450"
  Q
-18 S DW="0;28",DV="P70.2'",DU="",DLB="NUCLEAR MED DATA",DIFLD=500
- S DE(DW)="C18^RACTRG6"
- S DU="RADPTN("
- S X=RAIEN702
- S Y=X
- 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)
- G RD:X="@",Z
-C18 G C18S:$D(DE(18))[0 K DB
- S X=DE(18),DIC=DIE
- X "Q:$D(RAIEN702)  N DA,DIK S DA=X,DIK=""^RADPTN("" D ^DIK"
-C18S S X="" G:DG(DQ)=X C18F1 K DB
- S X=DG(DQ),DIC=DIE
- ;
-C18F1 Q
-X18 Q
-19 S DQ=20 ;@450
-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
-X20 S:'$O(^RAMIS(71,RAPRI,"P",0)) Y="@700"
- Q
-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
-X21 S REM="en2^ranmpt1 will stuff default meds"
- Q
-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
-X22 D EN2^RANMPT1(RADFN,RADTI,RACNI)
- Q
-23 S DQ=24 ;@700
-24 D:$D(DG)>9 F^DIE17,DE S DQ=24,D=0 K DE(1) ;100
- S DIFLD=100,DGO="^RACTRG9",DC="4^70.07DA^L^",DV="70.07RDI",DW="0;1",DOW="LOG DATE",DLB="Select "_DOW S:D DC=DC_D
- I $D(DSC(70.07))#2,$P(DSC(70.07),"I $D(^UTILITY(",1)="" X DSC(70.07) S D=$O(^(0)) S:D="" D=-1 G M24
- S D=$S($D(^RADPT(D0,"DT",D1,"P",DA,"L",0)):$P(^(0),U,3,4),$O(^(0))'="":$O(^(0)),1:-1)
-M24 I D>0 S DC=DC_D I $D(^RADPT(D0,"DT",D1,"P",DA,"L",+D,0)) S DE(24)=$P(^(0),U,1)
- S X="""NOW"""
- S Y=X
- 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)
- G RD
-R24 D DE
- G A
- ;
-25 G 1^DIE17
+42 D:$D(DG)>9 F^DIE17 G ^RACTRG9