Changeset 623 for WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RACTRG9.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/RACTRG9.m (modified) (2 diffs)

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

@@ -1 @@
-RACTRG9 ; ;01/02/09
+RACTRG9 ; ;11/06/06
  D DE G BEGIN
-DE S DIE="^RADPT(D0,""DT"",D1,""P"",D2,""L"",",DIC=DIE,DP=70.07,DL=4,DIEL=3,DU="" K DG,DE,DB Q:$O(^RADPT(D0,"DT",D1,"P",D2,"L",DA,""))=""
- I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,2) S:%]"" DE(1)=% S %=$P(%Z,U,3) S:%]"" DE(2)=%
- I $D(^("TCOM")) S %Z=^("TCOM") S %=$E(%Z,1,245) S:%'?." " DE(4)=%,DE(6)=%
+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(1)=%
  K %Z Q
  ;
@@ -51 +50 @@
 KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
 BEGIN S DNM="RACTRG9",DQ=1
-1 S DW="0;2",DV="RSI",DU="",DLB="TYPE OF ACTION",DIFLD=2
- S DU="E:EXAM ENTRY;C:EDIT BY CASE NO.;P:EDIT BY PATIENT;D:DIAGNOSIS ENTRY BY CASE NO.;S:EXAM STATUS TRACKING;X:CANCELLED;O:COMPLETE STATUS OVERRIDE;U:UPDATE STATUS;N:NO PURGING SPECIFIED;"
- S X="E"
+1 S DW="0;28",DV="P70.2'",DU="",DLB="NUCLEAR MED DATA",DIFLD=500
+ S DE(DW)="C1^RACTRG9"
+ 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
+C1 G C1S:$D(DE(1))[0 K DB
+ S X=DE(1),DIC=DIE
+ X "Q:$D(RAIEN702)  N DA,DIK S DA=X,DIK=""^RADPTN("" D ^DIK"
+C1S S X="" G:DG(DQ)=X C1F1 K DB
+ S X=DG(DQ),DIC=DIE
+ ;
+C1F1 Q
+X1 Q
+2 S DQ=3 ;@450
+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
+X3 S:'$O(^RAMIS(71,RAPRI,"P",0)) Y="@700"
+ Q
+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 REM="en2^ranmpt1 will stuff default meds"
+ 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 D EN2^RANMPT1(RADFN,RADTI,RACNI)
+ Q
+6 S DQ=7 ;@700
+7 D:$D(DG)>9 F^DIE17,DE S DQ=7,D=0 K DE(1) ;100
+ S DIFLD=100,DGO="^RACTRG10",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 M7
+ S D=$S($D(^RADPT(D0,"DT",D1,"P",DA,"L",0)):$P(^(0),U,3,4),$O(^(0))'="":$O(^(0)),1:-1)
+M7 I D>0 S DC=DC_D I $D(^RADPT(D0,"DT",D1,"P",DA,"L",+D,0)) S DE(7)=$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
-X1 Q
-2 S DW="0;3",DV="RP200'I",DU="",DLB="COMPUTER USER",DIFLD=3
- S DU="VA(200,"
- S X=RADUZ
- 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
-X2 Q
-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
-X3 S RATCXX=$$GETTCOM^RAUTL11(RADFN,RADTI,RACNI)
- Q
-4 S DW="TCOM;E1,245",DV="F",DU="",DLB="TECHNOLOGIST COMMENT",DIFLD=4
- S X=RATCXX
- S Y=X
- G Y
-X4 K:$L(X)>245!($L(X)<3)!'(X?1A.ANP) X
- I $D(X),X'?.ANP K X
- Q
+R7 D DE
+ G A
  ;
-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:RATCXX'=X Y="@18"
- Q
-6 S DW="TCOM;E1,245",DV="F",DU="",DLB="TECHNOLOGIST COMMENT",DIFLD=4
- S Y="@"
- 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
-X6 K:$L(X)>245!($L(X)<3)!'(X?1A.ANP) X
- I $D(X),X'?.ANP K X
- Q
- ;
-7 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=7 D X7 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
-X7 K ^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L",DA,"TCOM")
- Q
-8 S DQ=9 ;@18
-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 K RATCXX S RAFIN=""
- Q
-10 G 1^DIE17
+8 G 1^DIE17