Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RACTQE5.m

    r613 r623  
    1 RACTQE5 ; ;01/02/09
     1RACTQE5 ; ;12/10/05
    22 D DE G BEGIN
    3 DE S DIE="^RAO(75.1,D0,""T"",",DIC=DIE,DP=75.12,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$O(^RAO(75.1,D0,"T",DA,""))=""
    4  I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,2) S:%]"" DE(1)=% S %=$P(%Z,U,3) S:%]"" DE(2)=%
     3DE 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,5) S:%]"" DE(1)=% S %=$P(%Z,U,6) S:%]"" DE(9)=% S %=$P(%Z,U,18) S:%]"" DE(2)=% S %=$P(%Z,U,19) S:%]"" DE(5)=% S %=$P(%Z,U,24) S:%]"" DE(7)=% S %=$P(%Z,U,26) S:%]"" DE(11)=%
    55 K %Z Q
    66 ;
     
    5050KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
    5151BEGIN S DNM="RACTQE5",DQ=1
    52 1 S DW="0;2",DV="S",DU="",DLB="NEW STATUS",DIFLD=2
     521 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW="0;5",DV="SX",DU="",DLB="REQUEST STATUS",DIFLD=5
     53 S DE(DW)="C1^RACTQE5"
    5354 S DU="1:DISCONTINUED;2:COMPLETE;3:HOLD;5:PENDING;6:ACTIVE;8:SCHEDULED;11:UNRELEASED;"
    5455 S X=$S($D(RAPKG):5,$$ORVR^RAORDU()=2.5:11,1:5)
     
    5657 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)
    5758 G RD:X="@",Z
     59C1 G C1S:$D(DE(1))[0 K DB
     60 S X=DE(1),DIC=DIE
     61 K ^RAO(75.1,"AS",+$P(^RAO(75.1,DA,0),U),X,DA)
     62 S X=DE(1),DIC=DIE
     63 ;
     64C1S S X="" G:DG(DQ)=X C1F1 K DB
     65 S X=DG(DQ),DIC=DIE
     66 S ^RAO(75.1,"AS",+$P(^RAO(75.1,DA,0),U),X,DA)=""
     67 S X=DG(DQ),DIC=DIE
     68 D:$$ORVR^RAORDU()=2.5&((X=1)!(X=3)) CH^RADD2(DA,X)
     69C1F1 Q
    5870X1 Q
    59 2 S DW="0;3",DV="P200'",DU="",DLB="COMPUTER USER",DIFLD=3
    60  S DU="VA(200,"
    61  S X=DUZ
     712 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW="0;18",DV="D",DU="",DLB="LAST ACTIVITY DATE/TIME",DIFLD=18
     72 S DE(DW)="C2^RACTQE5"
     73 S X="NOW"
     74 S Y=X
     75 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)
     76 G RD
     77C2 G C2S:$D(DE(2))[0 K DB
     78 S X=DE(2),DIC=DIE
     79 K ^RAO(75.1,"AO",$E(X,1,30),DA)
     80C2S S X="" G:DG(DQ)=X C2F1 K DB
     81 S X=DG(DQ),DIC=DIE
     82 S ^RAO(75.1,"AO",$E(X,1,30),DA)=""
     83C2F1 Q
     84X2 S %DT="TXR" D ^%DT S X=Y K:Y<1 X
     85 Q
     86 ;
     873 D:$D(DG)>9 F^DIE17,DE S DQ=3,D=0 K DE(1) ;75
     88 S DIFLD=75,DGO="^RACTQE6",DC="4^75.12DA^T^",DV="75.12D",DW="0;1",DOW="STATUS CHANGE DATE/TIME",DLB="Select "_DOW S:D DC=DC_D
     89 I $D(DSC(75.12))#2,$P(DSC(75.12),"I $D(^UTILITY(",1)="" X DSC(75.12) S D=$O(^(0)) S:D="" D=-1 G M3
     90 S D=$S($D(^RAO(75.1,DA,"T",0)):$P(^(0),U,3,4),$O(^(0))'="":$O(^(0)),1:-1)
     91M3 I D>0 S DC=DC_D I $D(^RAO(75.1,DA,"T",+D,0)) S DE(3)=$P(^(0),U,1)
     92 S X="""NOW"""
     93 S Y=X
     94 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)
     95 G RD
     96R3 D DE
     97 G A
     98 ;
     994 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
     100X4 I '$D(RAMT) S RAMT="a"
     101 Q
     1025 S DW="0;19",DV="S",DU="",DLB="MODE OF TRANSPORT",DIFLD=19
     103 S DU="a:AMBULATORY;p:PORTABLE;s:STRETCHER;w:WHEEL CHAIR;"
     104 S X=$P(RAMT,"^")
    62105 S Y=X
    63106 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)
    64107 G RD:X="@",Z
    65 X2 Q
    66 3 G 1^DIE17
     108X5 Q
     1096 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
     110X6 I '$D(RAIP) S RAIP="n"
     111 Q
     1127 S DW="0;24",DV="S",DU="",DLB="ISOLATION PROCEDURES",DIFLD=24
     113 S DU="y:YES;n:NO;"
     114 S X=RAIP
     115 S Y=X
     116 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)
     117 G RD:X="@",Z
     118X7 Q
     1198 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
     120X8 I '$D(RARU) S RARU=9
     121 Q
     1229 S DW="0;6",DV="S",DU="",DLB="REQUEST URGENCY",DIFLD=6
     123 S DU="1:STAT;2:URGENT;9:ROUTINE;"
     124 S X=RARU
     125 S Y=X
     126 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)
     127 G RD:X="@",Z
     128X9 Q
     12910 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
     130X10 S:$$ORVR^RAORDU()<3 Y="@80"
     131 Q
     13211 S DW="0;26",DV="S",DU="",DLB="NATURE OF (NEW) ORDER ACTIVITY",DIFLD=26
     133 S DU="w:WRITTEN;v:VERBAL;p:TELEPHONED;s:SERVICE CORRECTION;i:POLICY;e:PHYSICIAN ENTERED;"
     134 S Y="s"
     135 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)
     136 G RD:X="@",Z
     137X11 Q
     13812 S DQ=13 ;@80
     13913 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
     140X13 S RAFIN=1
     141 Q
     14214 S DQ=15 ;@99
     14315 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
     144X15 K RAI,RAPRI,RAMOD,RAIMAG,RAREQLOC,RAMODPRO
     145 Q
     14616 G 0^DIE17
Note: See TracChangeset for help on using the changeset viewer.