- 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/RAUTL1.m
r613 r623 1 RAUTL1 ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Utility Routine ;10/22/97 13:54 2 ;;5.0;Radiology/Nuclear Medicine;**5,9,18,71,82,81,84**;Mar 16, 1998;Build 13 3 ;last modification by SS for P18 June 19,00 4 ;02/10/2006 BAY/KAM RA*5*71 Add ability to update exam data to V/R 5 ; 6 ;Integration Agreements 7 ;---------------------- 8 ;DIC(10006); DIE(10018); FILE^DIE(2053); UPDATE^DIE(2053); EN^ORB3(1362); NOTE^ORX3(868) 9 ; 10 I "IOSCR"'[X!(X="") S X="Unknown" Q 11 G @($E(X)) 12 ;Set X=Inpatient Location 13 I S X=$S($D(^DIC(42,+$P(^RADPT(D0,"DT",D1,"P",D2,0),"^",6),0)):$P(^(0),"^"),1:"Unknown") 14 Q 15 ; 16 ;Set X=Outpatient Location 17 O S X=$S($D(^SC(+$P(^RADPT(D0,"DT",D1,"P",D2,0),"^",8),0)):$P(^(0),"^"),1:"Unknown") 18 Q 19 ; 20 ;Set X=Contract/Sharing Agreement patient location 21 S ; 22 C S X=$S($D(^DIC(34,+$P(^RADPT(D0,"DT",D1,"P",D2,0),"^",9),0)):$P(^(0),"^"),1:"Unknown") 23 Q 24 ; 25 ;Set X=Research patient location 26 R S X=$S($D(^RADPT(D0,"DT",D1,"P",D2,"R")):$P(^("R"),"^"),1:"Unknown") Q 27 ; 28 ;Set X=time of day in external format (ex: 2:28 PM) 29 NOW S %=$P($H,",",2),X=DT_(%\60#60/100+(%\3600)+(%#60/10000)/100) D TIME 30 Q 31 ;Input X=FM date/time, Output X=time (external format) 32 TIME S X=$E($P(X,".",2)_"0000",1,4),%=X>1159 S:X>1259 X=X-1200 S X=X\100_":"_$E(X#100+100,2,3)_" "_$E("AP",%+1)_"M" S:$P(X,":")=0 X=12_":"_$P(X,":",2) 33 Q 34 ; 35 ELAPSED ;Pass parameters X (from date) and X1 (to date) 36 ;Variable Y is returned as either an elapsed time in the form DD:HH:MM where DD=days, HH=hours, MM=minutes or as the string 'Neg. Time' indicating a negative elapsed time 37 ;Variable Y1 is returned as the # of minutes of elapsed time 38 I '$D(RAMTIME) S DIC="^DD(""FUNC"",",DIC(0)="FX",RAX=X,X="MINUTES" D ^DIC K DIC S X=RAX S:$D(^DD("FUNC",+Y,1)) RAMTIME=^(1) I '$D(RAMTIME) W $C(7),!!,"Can't continue --- No 'MINUTES' function found in File Manager" K Y,Y1 G Q 39 X RAMTIME S Y1=X I X<0 S Y="Neg. Time" G Q 40 MINUTS S X(1)=X\1440,X=X-(1440*X(1)),X(2)=X\60,X(3)=X-(60*X(2)),Y=$E(100+X(1),2,3)_":"_$E(100+X(2),2,3)_":"_$E(100+X(3),2,3) 41 Q K RAX,X Q 42 ; 43 UPDATE ;Entry point for Update Rad/Nuc Med Exam Status option 44 I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) 45 I $G(RAIMGTY)="" D SETVARS^RAPSET1(1) 46 I $G(RAIMGTY)="" K XQUIT Q ; didn't sign-on to an imaging location 47 D ^RACNLU G UPQ:"^"[X 48 I $D(^RA(72,"AA",RAIMGTY,9,+RAST)),'$D(^XUSEC("RA MGR",DUZ)) W !!?3,$C(7),"You do not have the appropriate access privileges to act on completed exams." G UPDATE 49 I $D(^RA(72,"AA",RAIMGTY,0,+RAST)) W !!?3,$C(7),"Exam has been 'cancelled' therefore the status cannot be changed." G UPDATE 50 ;D UP1 I RAOR>0 S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI,DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"",",DR="100///""NOW""",DR(2,70.07)="2///U;3////"_$S($G(RADUZ):RADUZ,1:DUZ) D ^DIE 51 D UP1 I RAOR>0 D 52 .L +^RADPT(RADFN,"DT",RADTI,"P",RACNI):$G(DILOCKTM,3) 53 .N RAIEN 54 .S RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_"," 55 .S RAFDA(70.07,RAIENS,.01)="NOW" 56 .K RAERR D UPDATE^DIE("E","RAFDA","RAIEN","RAERR") 57 .K RAFDA,RAIENS 58 .I $D(RAERR) S RAERR="Error in update of 70.07, .01 "_$G(RAERR("DIERR",1,"TEXT",1)) K RAERR("DIERR") L -^RADPT(RADFN,"DT",RADTI,"P",RACNI) K RAIEN Q 59 .S RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_"," 60 .S RAFDA(70.07,RAIENS,2)="U" 61 .S RAFDA(70.07,RAIENS,3)=$S($G(RADUZ):RADUZ,1:DUZ) 62 .D FILE^DIE(,"RAFDA","RAERR") 63 .L -^RADPT(RADFN,"DT",RADTI,"P",RACNI) 64 .I $D(RAERR) S RAERR="Error in update of 70.07, 2,3 "_$G(RAERR("DIERR",1,"TEXT",1)) K RAERR("DIERR") 65 UPQ K RAFDA,RAIENS 66 K %,D,DA,DE,DIC,DIE,DQ,DR,I,J,POP,RACS,RAEND,RAF5,RAFL,RAFST,RAI,RAIX,RAJ1,RAORDIFN,RAPRIT,RAHEAD,RASN,RAOR,RASTI,RASSN,RADATE,RAST,RACN,RACNI,RADFN,RADTE,RADTI,RANME,RAPRC,RARPT,X,Y,Z,^TMP($J,"RAEX"),C,DIPGM Q 67 ; 68 ;Exam status updating and accompanying updates to status log, oe/rr 69 UP1 N RA8,RAEXEDT S RA8=0 ;use this to flag when one alert has been sent 70 ;Line change for RA*5*82 71 S RAEXEDT=$$CMPAFTR^RAO7XX(1) ;P18 if procedure changed in RAEDCN or RAEDPT sends XX message to CPRS if needed 72 ; RA EDITCN and RA EDITPT should process this case only 73 I $D(RAOPT("EDITCN"))!($D(RAOPT("EDITPT"))) D UP2,UPK Q 74 ; see if this case belongs to a printset 75 N:'$D(RAPRTSET) RAPRTSET N:'$D(RAMEMARR) RAMEMARR 76 D EN2^RAUTL20(.RAMEMARR) ;043099 always recalculate RAPRTSET 77 ; if not print set, then just process this case only 78 I 'RAPRTSET D UP2,UPK Q 79 ;case belongs to print set, so process all members of same print set 80 N RACNISAV,RA7 81 S RACNISAV=RACNI,RA7=0 82 F S RA7=$O(RAMEMARR(RA7)) Q:RA7="" S RACNI=RA7 D UP2 83 S RACNI=RACNISAV 84 G UPK 85 UP2 ;Remedy Call 124379 Patch *71 BAY/KAM Added next line 86 ;Patch RA*5*82 next line commented out 87 ;D:$G(RAHLTCPB)'=1 EXM^RAHLRPC 88 ; 89 S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI,DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P""," 90 N RAAFTER,RABEFORE 91 D STUFF^RASTREQ1 I RAOR<0,$D(RASN) W:'$D(RAONLINE)&('$D(ZTQUEUED)) !?5,"...exam status remains '",RASN,"'." K DIE,RACS,RAPRIT D Q 92 .D:$G(RAEXEDT) EXM^RAHLRPC ; DO statement added by RA*5*82 93 W:'$D(RAONLINE)&('$D(ZTQUEUED)) !?3,"...will now designate exam status as '",RASN,"'... for case no. ",$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U) 94 ; S DR="3////"_RASTI_$S($P(RAMDV,"^",10):";75///^S X=$$MIDNGHT^RAUTL5($$NOW^XLFDT())",1:"") 95 ; user duz could be in RADUZ, if session is from the Voice recognition 96 ;S DR(2,70.05)=$S($P(RAMDV,"^",11)&('$D(ZTQUEUED)):".01;",1:"")_"2////"_RASTI_";3////"_$S($G(RADUZ):RADUZ,1:DUZ) 97 ;D ^DIE 98 L +^RADPT(RADFN,"DT",RADTI,"P",RACNI):$G(DILOCKTM,3) 99 N RAIEN 100 S RAIENS=RACNI_","_RADTI_","_RADFN_"," 101 S RAFDA(70.03,RAIENS,3)=RASTI 102 K RAERR D FILE^DIE(,"RAFDA","RAERR") 103 I $D(RAERR) S RAERR="Error in update of 70.03 "_$G(RAERR("DIERR",1,"TEXT",1)) K RAERR("DIERR") L -^RADPT(RADFN,"DT",RADTI,"P",RACNI) G UP2K ;L - P18 104 I $P(RAMDV,"^",10) D 105 .N RAERR2 106 .S RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_"," 107 .S RAFDA(70.05,RAIENS,.01)=$$MIDNGHT^RAUTL5($$NOW^XLFDT()) 108 .D UPDATE^DIE(,"RAFDA","RAIEN","RAERR") 109 .K RAFDA,RAIENS 110 .I $D(RAERR) S RAERR="Error in update of 70.05, .01 "_$G(RAERR("DIERR",1,"TEXT",1)) K RAERR("DIERR") 111 .Q:'$D(RAIEN(1)) 112 .I $P(RAMDV,"^",11),('$D(ZTQUEUED)) D 113 ..S DIE=DIE_RACNI_",""T"",",DA=RAIEN(1) 114 ..S DR=".01" 115 ..D ^DIE 116 .S RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_"," 117 .S RAFDA(70.05,RAIENS,2)=RASTI 118 .S RAFDA(70.05,RAIENS,3)=$S($G(RADUZ):RADUZ,1:DUZ) 119 .K RAERR2 D FILE^DIE(,"RAFDA","RAERR2") 120 .I $D(RAERR2) S RAERR2="Error in update of 70.05 2,3 "_$G(RAERR2("DIERR",1,"TEXT",1)),RAERR=$S($D(RAERR):RAERR_";"_RAERR2,1:RAERR2) 121 ;Patch RA*5*82 added next line send EXM message after status update, not before the update 122 D:'$D(RAERR) EXM^RAHLRPC 123 L -^RADPT(RADFN,"DT",RADTI,"P",RACNI) 124 ; 125 UP2K K DE,DQ,DIE,DR,RAFDA,RAIENS K:$D(RAERR) RACS,RAPRIT Q:$D(RAERR) W:'$D(RAONLINE)&('$D(ZTQUEUED)) !?10,"...exam status ",$S($G(RABEFORE)>$G(RAAFTER):"backed down",1:"successfully updated"),"." D ^RAORDC 126 I RA8=0,$D(^RA(72,RASTI,"ALERT")),$P(^("ALERT"),"^")="y" D:$$ORVR^RAORDU()=2.5 OERR D:$$ORVR^RAORDU()'<3 OERR3 S RA8=1 127 I $D(^RA(72,RASTI,0)),$P(^(0),"^",3)>1,RACS'="Y",$S('$D(RAF5):1,$P(^DIC(42,+RAF5,0),U,3)="D":1,1:0) D EN^RAUTL0 128 K RACS,RAORDIFN,RAPRIT,RAF5 129 Q 130 UPK K ORIFN,ORVP,ORNOTE,ORBPMSG,RACS,RAORDIFN,RAPRIT,RAF5 131 Q 132 OERR ;Send Alert to OERR after pt examined 133 S ORVP=RADFN_";DPT(",ORBPMSG="Rad Pt Examined - "_$S($D(^RAMIS(71,RAPRIT,0)):$E($P(^(0),"^"),1,24),1:"Unknown") S:$D(^RAO(75.1,+RAORDIFN,0)) ORIFN=+$P(^(0),"^",7) S ORNOTE(21)=$S($D(ORIFN):1,1:"") D NOTE^ORX3 134 Q 135 OERR3 ; Send RADIOLOGY PATIENT EXAMINED notification via oe/rr v3 136 ; Called from UP1 137 ; 138 ; RADFN,RADTI,RACNI,RAPRIT must be defined 139 Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))!('$D(RAPRIT)) 140 ; 141 N RAIENS,RAMSG,RAOIFN,RAOSTS,RAONODE,RADPTNDE,RAREQPHY 142 S RADPTNDE=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) 143 S RAOIFN=$P(RADPTNDE,U,11) Q:'RAOIFN ;file 75.1 ien 144 S RAONODE=$G(^RAO(75.1,+RAOIFN,0)) 145 S RAOSTS=$P(RAONODE,U,5) Q:RAOSTS'=6 ;active exams only 146 S RAOIFN=$P(RAONODE,U,7) ;file 100 ien 147 S RAREQPHY=+$P(RADPTNDE,U,14) ;ordering provider 148 S RAREQPHY(RAREQPHY)="" 149 S RAMSG="Imaging Pt Examined - "_$S($D(^RAMIS(71,RAPRIT,0)):$E($P(^(0),U),1,24),1:"Unknown"),RAMSG=$E(RAMSG,1,51) 150 S RAIENS=RADTI_"~"_RACNI 151 ; 152 ; oe parameters: 153 ; ORN: notification id (#100.9 ien) 154 ; | ORBDFN: patient id (#2 ien) 155 ; | | ORNUM: order number (#100 ien) 156 ; | | | ORBADUZ: recipient array 157 ; | | | | ORBPMSG: message text 158 ; | | | | | ORBPDATA exam dt~case iens 159 ; | | | | | | 160 D EN^ORB3(21,RADFN,RAOIFN,.RAREQPHY,RAMSG,RAIENS) 161 Q 162 ; 163 ;Called by many report programs. Sets RACRT() array containing all 164 ;exam statuses that are to be included on the report. RACRT is set 165 ;to the piece of the Exam Status File #72 record that corresponds 166 ;to the report being generated. 167 CRIT F I=0:0 S I=$O(^RA(72,I)) Q:'I I $D(^(I,.3)),$P(^(.3),"^",RACRT)="y" S RACRT(I)="" 168 Q 1 RAUTL1 ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Utility Routine ;10/22/97 13:54 2 ;;5.0;Radiology/Nuclear Medicine;**5,9,18,71,82**;Mar 16, 1998;Build 8 3 ;last modification by SS for P18 June 19,00 4 ;02/10/2006 BAY/KAM RA*5*71 Add ability to update exam data to V/R 5 I "IOSCR"'[X!(X="") S X="Unknown" Q 6 G @($E(X)) 7 ;Set X=Inpatient Location 8 I S X=$S($D(^DIC(42,+$P(^RADPT(D0,"DT",D1,"P",D2,0),"^",6),0)):$P(^(0),"^"),1:"Unknown") 9 Q 10 ; 11 ;Set X=Outpatient Location 12 O S X=$S($D(^SC(+$P(^RADPT(D0,"DT",D1,"P",D2,0),"^",8),0)):$P(^(0),"^"),1:"Unknown") 13 Q 14 ; 15 ;Set X=Contract/Sharing Agreement patient location 16 S ; 17 C S X=$S($D(^DIC(34,+$P(^RADPT(D0,"DT",D1,"P",D2,0),"^",9),0)):$P(^(0),"^"),1:"Unknown") 18 Q 19 ; 20 ;Set X=Research patient location 21 R S X=$S($D(^RADPT(D0,"DT",D1,"P",D2,"R")):$P(^("R"),"^"),1:"Unknown") Q 22 ; 23 ;Set X=time of day in external format (ex: 2:28 PM) 24 NOW S %=$P($H,",",2),X=DT_(%\60#60/100+(%\3600)+(%#60/10000)/100) D TIME 25 Q 26 ;Input X=FM date/time, Output X=time (external format) 27 TIME S X=$E($P(X,".",2)_"0000",1,4),%=X>1159 S:X>1259 X=X-1200 S X=X\100_":"_$E(X#100+100,2,3)_" "_$E("AP",%+1)_"M" S:$P(X,":")=0 X=12_":"_$P(X,":",2) 28 Q 29 ; 30 ELAPSED ;Pass parameters X (from date) and X1 (to date) 31 ;Variable Y is returned as either an elapsed time in the form DD:HH:MM where DD=days, HH=hours, MM=minutes or as the string 'Neg. Time' indicating a negative elapsed time 32 ;Variable Y1 is returned as the # of minutes of elapsed time 33 I '$D(RAMTIME) S DIC="^DD(""FUNC"",",DIC(0)="FX",RAX=X,X="MINUTES" D ^DIC K DIC S X=RAX S:$D(^DD("FUNC",+Y,1)) RAMTIME=^(1) I '$D(RAMTIME) W *7,!!,"Can't continue --- No 'MINUTES' function found in File Manager" K Y,Y1 G Q 34 X RAMTIME S Y1=X I X<0 S Y="Neg. Time" G Q 35 MINUTS S X(1)=X\1440,X=X-(1440*X(1)),X(2)=X\60,X(3)=X-(60*X(2)),Y=$E(100+X(1),2,3)_":"_$E(100+X(2),2,3)_":"_$E(100+X(3),2,3) 36 Q K RAX,X Q 37 ; 38 UPDATE ;Entry point for Update Rad/Nuc Med Exam Status option 39 I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) 40 I $G(RAIMGTY)="" D SETVARS^RAPSET1(1) 41 I $G(RAIMGTY)="" K XQUIT Q ; didn't sign-on to an imaging location 42 D ^RACNLU G UPQ:"^"[X 43 I $D(^RA(72,"AA",RAIMGTY,9,+RAST)),'$D(^XUSEC("RA MGR",DUZ)) W !!?3,*7,"You do not have the appropriate access privileges to act on completed exams." G UPDATE 44 I $D(^RA(72,"AA",RAIMGTY,0,+RAST)) W !!?3,*7,"Exam has been 'cancelled' therefore the status cannot be changed." G UPDATE 45 ;D UP1 I RAOR>0 S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI,DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"",",DR="100///""NOW""",DR(2,70.07)="2///U;3////"_$S($G(RADUZ):RADUZ,1:DUZ) D ^DIE 46 D UP1 I RAOR>0 D 47 .L +^RADPT(RADFN,"DT",RADTI,"P",RACNI) 48 .N RAIEN 49 .S RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_"," 50 .S RAFDA(70.07,RAIENS,.01)="NOW" 51 .K RAERR D UPDATE^DIE("E","RAFDA","RAIEN","RAERR") 52 .K RAFDA,RAIENS 53 .I $D(RAERR) L -^RADPT(RADFN,"DT",RADTI,"P",RACNI) K RAIEN Q 54 .S RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_"," 55 .S RAFDA(70.07,RAIENS,2)="U" 56 .S RAFDA(70.07,RAIENS,3)=$S($G(RADUZ):RADUZ,1:DUZ) 57 .D FILE^DIE(,"RAFDA") 58 .L -^RADPT(RADFN,"DT",RADTI,"P",RACNI) 59 UPQ K RAFDA,RAIENS 60 K %,D,DA,DE,DIC,DIE,DQ,DR,I,J,POP,RACS,RAEND,RAF5,RAFL,RAFST,RAI,RAIX,RAJ1,RAORDIFN,RAPRIT,RAHEAD,RASN,RAOR,RASTI,RASSN,RADATE,RAST,RACN,RACNI,RADFN,RADTE,RADTI,RANME,RAPRC,RARPT,X,Y,Z,^TMP($J,"RAEX"),C,DIPGM Q 61 ; 62 ;Exam status updating and accompanying updates to status log, oe/rr 63 UP1 N RA8,RAEXEDT S RA8=0 ;use this to flag when one alert has been sent 64 ;Line change for RA*5*82 65 S RAEXEDT=$$CMPAFTR^RAO7XX(1) ;P18 if procedure changed in RAEDCN or RAEDPT sends XX message to CPRS if needed 66 ; RA EDITCN and RA EDITPT should process this case only 67 I $D(RAOPT("EDITCN"))!($D(RAOPT("EDITPT"))) D UP2,UPK Q 68 ; see if this case belongs to a printset 69 N:'$D(RAPRTSET) RAPRTSET N:'$D(RAMEMARR) RAMEMARR 70 D EN2^RAUTL20(.RAMEMARR) ;043099 always recalculate RAPRTSET 71 ; if not print set, then just process this case only 72 I 'RAPRTSET D UP2,UPK Q 73 ;case belongs to print set, so process all members of same print set 74 N RACNISAV,RA7 75 S RACNISAV=RACNI,RA7=0 76 F S RA7=$O(RAMEMARR(RA7)) Q:RA7="" S RACNI=RA7 D UP2 77 S RACNI=RACNISAV 78 G UPK 79 UP2 ;Remedy Call 124379 Patch *71 BAY/KAM Added next line 80 ;Patch RA*5*82 next line commented out 81 ;D:$G(RAHLTCPB)'=1 EXM^RAHLRPC 82 ; 83 S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI,DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P""," 84 N RAAFTER,RABEFORE 85 D STUFF^RASTREQ1 I RAOR<0,$D(RASN) W:'$D(RAONLINE)&('$D(ZTQUEUED)) !?5,"...exam status remains '",RASN,"'." K DIE,RACS,RAPRIT D Q 86 .D:$G(RAEXEDT) EXM^RAHLRPC ; DO statement added by RA*5*82 87 W:'$D(RAONLINE)&('$D(ZTQUEUED)) !?3,"...will now designate exam status as '",RASN,"'... for case no. ",$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U) 88 ; S DR="3////"_RASTI_$S($P(RAMDV,"^",10):";75///^S X=$$MIDNGHT^RAUTL5($$NOW^XLFDT())",1:"") 89 ; user duz could be in RADUZ, if session is from the Voice recognition 90 ;S DR(2,70.05)=$S($P(RAMDV,"^",11)&('$D(ZTQUEUED)):".01;",1:"")_"2////"_RASTI_";3////"_$S($G(RADUZ):RADUZ,1:DUZ) 91 ;D ^DIE 92 L +^RADPT(RADFN,"DT",RADTI,"P",RACNI) 93 N RAIEN 94 S RAIENS=RACNI_","_RADTI_","_RADFN_"," 95 S RAFDA(70.03,RAIENS,3)=RASTI 96 K RAERR D FILE^DIE(,"RAFDA","RAERR") 97 I $D(RAERR) L -^RADPT(RADFN,"DT",RADTI,"P",RACNI) G UP2K ;L - P18 98 I $P(RAMDV,"^",10) D 99 .S RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_"," 100 .S RAFDA(70.05,RAIENS,.01)=$$MIDNGHT^RAUTL5($$NOW^XLFDT()) 101 .D UPDATE^DIE(,"RAFDA","RAIEN") 102 .K RAFDA,RAIENS 103 .Q:'$D(RAIEN(1)) 104 .I $P(RAMDV,"^",11),('$D(ZTQUEUED)) D 105 ..S DIE=DIE_RACNI_",""T"",",DA=RAIEN(1) 106 ..S DR=".01" 107 ..D ^DIE 108 .S RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_"," 109 .S RAFDA(70.05,RAIENS,2)=RASTI 110 .S RAFDA(70.05,RAIENS,3)=$S($G(RADUZ):RADUZ,1:DUZ) 111 .K RAERR2 D FILE^DIE(,"RAFDA") 112 ;Patch RA*5*82 added next line send EXM message after status update, not before the update 113 D EXM^RAHLRPC 114 L -^RADPT(RADFN,"DT",RADTI,"P",RACNI) 115 ; 116 UP2K K DE,DQ,DIE,DR,RAFDA,RAIENS K:$D(RAERR) RACS,RAPRIT Q:$D(RAERR) W:'$D(RAONLINE)&('$D(ZTQUEUED)) !?10,"...exam status ",$S($G(RABEFORE)>$G(RAAFTER):"backed down",1:"successfully updated"),"." D ^RAORDC 117 I RA8=0,$D(^RA(72,RASTI,"ALERT")),$P(^("ALERT"),"^")="y" D:$$ORVR^RAORDU()=2.5 OERR D:$$ORVR^RAORDU()'<3 OERR3 S RA8=1 118 I $D(^RA(72,RASTI,0)),$P(^(0),"^",3)>1,RACS'="Y",$S('$D(RAF5):1,$P(^DIC(42,+RAF5,0),U,3)="D":1,1:0) D EN^RAUTL0 119 K RACS,RAORDIFN,RAPRIT,RAF5 120 Q 121 UPK K ORIFN,ORVP,ORNOTE,ORBPMSG,RACS,RAORDIFN,RAPRIT,RAF5 122 Q 123 OERR ;Send Alert to OERR after pt examined 124 S ORVP=RADFN_";DPT(",ORBPMSG="Rad Pt Examined - "_$S($D(^RAMIS(71,RAPRIT,0)):$E($P(^(0),"^"),1,24),1:"Unknown") S:$D(^RAO(75.1,+RAORDIFN,0)) ORIFN=+$P(^(0),"^",7) S ORNOTE(21)=$S($D(ORIFN):1,1:"") D NOTE^ORX3 125 Q 126 OERR3 ; Send RADIOLOGY PATIENT EXAMINED notification via oe/rr v3 127 ; Called from UP1 128 ; 129 ; RADFN,RADTI,RACNI,RAPRIT must be defined 130 Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))!('$D(RAPRIT)) 131 ; 132 N RAIENS,RAMSG,RAOIFN,RAOSTS,RAONODE,RADPTNDE,RAREQPHY 133 S RADPTNDE=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) 134 S RAOIFN=$P(RADPTNDE,U,11) Q:'RAOIFN ;file 75.1 ien 135 S RAONODE=$G(^RAO(75.1,+RAOIFN,0)) 136 S RAOSTS=$P(RAONODE,U,5) Q:RAOSTS'=6 ;active exams only 137 S RAOIFN=$P(RAONODE,U,7) ;file 100 ien 138 S RAREQPHY=+$P(RADPTNDE,U,14) ;ordering provider 139 S RAREQPHY(RAREQPHY)="" 140 S RAMSG="Imaging Pt Examined - "_$S($D(^RAMIS(71,RAPRIT,0)):$E($P(^(0),U),1,24),1:"Unknown"),RAMSG=$E(RAMSG,1,51) 141 S RAIENS=RADTI_"~"_RACNI 142 ; 143 ; oe parameters: 144 ; ORN: notification id (#100.9 ien) 145 ; | ORBDFN: patient id (#2 ien) 146 ; | | ORNUM: order number (#100 ien) 147 ; | | | ORBADUZ: recipient array 148 ; | | | | ORBPMSG: message text 149 ; | | | | | ORBPDATA exam dt~case iens 150 ; | | | | | | 151 D EN^ORB3(21,RADFN,RAOIFN,.RAREQPHY,RAMSG,RAIENS) 152 Q 153 ; 154 ;Called by many report programs. Sets RACRT() array containing all 155 ;exam statuses that are to be included on the report. RACRT is set 156 ;to the piece of the Exam Status File #72 record that corresponds 157 ;to the report being generated. 158 CRIT F I=0:0 S I=$O(^RA(72,I)) Q:'I I $D(^(I,.3)),$P(^(.3),"^",RACRT)="y" S RACRT(I)="" 159 Q
Note:
See TracChangeset
for help on using the changeset viewer.
