- RAUTL1 ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Utility Routine ; Nov 26, 2019@16:15:02
- ;;5.0;Radiology/Nuclear Medicine;**5,9,18,71,82,84,94,47,162**;Mar 16, 1998;Build 2
- ;last modification by SS for P18 June 19,00
- ;07/28/2008 BAY/KAM RA*5*94 Remove patch 81 from 2nd line of routine
- ;02/10/2006 BAY/KAM RA*5*71 Add ability to update exam data to V/R
- ;
- ;Integration Agreements
- ;----------------------
- ;DIC(10006); DIE(10018); FILE^DIE(2053); UPDATE^DIE(2053); EN^ORB3(1362); NOTE^ORX3(868)
- ;
- I "IOSCR"'[X!(X="") S X="Unknown" Q
- G @($E(X))
- ;Set X=Inpatient Location
- I S X=$S($D(^DIC(42,+$P(^RADPT(D0,"DT",D1,"P",D2,0),"^",6),0)):$P(^(0),"^"),1:"Unknown")
- Q
- ;
- ;Set X=Outpatient Location
- O S X=$S($D(^SC(+$P(^RADPT(D0,"DT",D1,"P",D2,0),"^",8),0)):$P(^(0),"^"),1:"Unknown")
- Q
- ;
- ;Set X=Contract/Sharing Agreement patient location
- S ;
- C S X=$S($D(^DIC(34,+$P(^RADPT(D0,"DT",D1,"P",D2,0),"^",9),0)):$P(^(0),"^"),1:"Unknown")
- Q
- ;
- ;Set X=Research patient location
- R S X=$S($D(^RADPT(D0,"DT",D1,"P",D2,"R")):$P(^("R"),"^"),1:"Unknown") Q
- ;
- ;Set X=time of day in external format (ex: 2:28 PM)
- NOW S %=$P($H,",",2),X=DT_(%\60#60/100+(%\3600)+(%#60/10000)/100) D TIME
- Q
- ;Input X=FM date/time, Output X=time (external format)
- 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)
- Q
- ;
- ELAPSED ;Pass parameters X (from date) and X1 (to date)
- ;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
- ;Variable Y1 is returned as the # of minutes of elapsed time
- 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
- X RAMTIME S Y1=X I X<0 S Y="Neg. Time" G Q
- 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)
- Q K RAX,X Q
- ;
- UPDATE ;Entry point for Update Rad/Nuc Med Exam Status option
- I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0)
- I $G(RAIMGTY)="" D SETVARS^RAPSET1(1)
- I $G(RAIMGTY)="" K XQUIT Q ; didn't sign-on to an imaging location
- D ^RACNLU G UPQ:"^"[X
- 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
- I $D(^RA(72,"AA",RAIMGTY,0,+RAST)) W !!?3,$C(7),"Exam has been 'cancelled' therefore the status cannot be changed." G UPDATE
- ;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
- D UP1 I RAOR>0 D
- .L +^RADPT(RADFN,"DT",RADTI,"P",RACNI):$G(DILOCKTM,3)
- .N RAIEN
- .S RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_","
- .S RAFDA(70.07,RAIENS,.01)="NOW"
- .K RAERR D UPDATE^DIE("E","RAFDA","RAIEN","RAERR")
- .K RAFDA,RAIENS
- .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
- .S RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_","
- .S RAFDA(70.07,RAIENS,2)="U"
- .S RAFDA(70.07,RAIENS,3)=$S($G(RADUZ):RADUZ,1:DUZ)
- .D FILE^DIE(,"RAFDA","RAERR")
- .L -^RADPT(RADFN,"DT",RADTI,"P",RACNI)
- .I $D(RAERR) S RAERR="Error in update of 70.07, 2,3 "_$G(RAERR("DIERR",1,"TEXT",1)) K RAERR("DIERR")
- UPQ K RAFDA,RAIENS
- 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
- ;
- ;Exam status updating and accompanying updates to status log, oe/rr
- UP1 N RA8,RAEXEDT S RA8=0 ;use this to flag when one alert has been sent
- ;Line change for RA*5*82
- S RAEXEDT=$$CMPAFTR^RAO7XX(1) ;P18 if procedure changed in RAEDCN or RAEDPT sends XX message to CPRS if needed
- ; RA EDITCN and RA EDITPT should process this case only
- I $D(RAOPT("EDITCN"))!($D(RAOPT("EDITPT"))) D UP2,UPK Q
- ; see if this case belongs to a printset
- N:'$D(RAPRTSET) RAPRTSET N:'$D(RAMEMARR) RAMEMARR
- D EN2^RAUTL20(.RAMEMARR) ;043099 always recalculate RAPRTSET
- ; if not print set, then just process this case only
- I 'RAPRTSET D UP2,UPK Q
- ;case belongs to print set, so process all members of same print set
- N RACNISAV,RA7
- S RACNISAV=RACNI,RA7=0
- F S RA7=$O(RAMEMARR(RA7)) Q:RA7="" S RACNI=RA7 D UP2
- S RACNI=RACNISAV
- G UPK
- UP2 ;Remedy Call 124379 Patch *71 BAY/KAM Added next line
- ;Patch RA*5*82 next line commented out
- ;D:$G(RAHLTCPB)'=1 EXM^RAHLRPC
- ;
- S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI,DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"","
- N RAAFTER,RABEFORE
- D STUFF^RASTREQ1 I RAOR<0,$D(RASN) W:'$D(RAONLINE)&('$D(ZTQUEUED)) !?5,"...exam status remains '",RASN,"'." K DIE,RACS,RAPRIT D Q
- .D:$G(RAEXEDT) EXM^RAHLRPC ; DO statement added by RA*5*82
- ;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)
- N RASSAN,RACNDSP S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
- S RACNDSP=$S((RASSAN'=""):RASSAN,1:$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U))
- I $$USESSAN^RAHLRU1() W:'$D(RAONLINE)&('$D(ZTQUEUED)) !?3,"...will now designate exam status as '",RASN,"'",!?25,"...for case no. ",RACNDSP
- I '$$USESSAN^RAHLRU1() 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)
- ; S DR="3////"_RASTI_$S($P(RAMDV,"^",10):";75///^S X=$$MIDNGHT^RAUTL5($$NOW^XLFDT())",1:"")
- ; user duz could be in RADUZ, if session is from the Voice recognition
- ;S DR(2,70.05)=$S($P(RAMDV,"^",11)&('$D(ZTQUEUED)):".01;",1:"")_"2////"_RASTI_";3////"_$S($G(RADUZ):RADUZ,1:DUZ)
- ;D ^DIE
- ;*** P162 mod on timeout INC7406782 use DILOCKTM
- ;*** else default to three
- L +^RADPT(RADFN,"DT",RADTI,"P",RACNI):$G(DILOCKTM,3)
- ;*** P162 end
- N RAIEN
- S RAIENS=RACNI_","_RADTI_","_RADFN_","
- S RAFDA(70.03,RAIENS,3)=RASTI
- K RAERR D FILE^DIE(,"RAFDA","RAERR")
- 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
- I $P(RAMDV,"^",10) D
- .N RAERR2
- .S RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_","
- .S RAFDA(70.05,RAIENS,.01)=$$MIDNGHT^RAUTL5($$NOW^XLFDT())
- .D UPDATE^DIE(,"RAFDA","RAIEN","RAERR")
- .K RAFDA,RAIENS
- .I $D(RAERR) S RAERR="Error in update of 70.05, .01 "_$G(RAERR("DIERR",1,"TEXT",1)) K RAERR("DIERR")
- .Q:'$D(RAIEN(1))
- .I $P(RAMDV,"^",11),('$D(ZTQUEUED)) D
- ..S DIE=DIE_RACNI_",""T"",",DA=RAIEN(1)
- ..S DR=".01"
- ..D ^DIE
- .S RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_","
- .S RAFDA(70.05,RAIENS,2)=RASTI
- .S RAFDA(70.05,RAIENS,3)=$S($G(RADUZ):RADUZ,1:DUZ)
- .K RAERR2 D FILE^DIE(,"RAFDA","RAERR2")
- .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)
- ;Patch RA*5*82 added next line send EXM message after status update, not before the update
- D:'$D(RAERR) EXM^RAHLRPC
- L -^RADPT(RADFN,"DT",RADTI,"P",RACNI)
- ;
- 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
- 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
- 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
- K RACS,RAORDIFN,RAPRIT,RAF5
- Q
- UPK K ORIFN,ORVP,ORNOTE,ORBPMSG,RACS,RAORDIFN,RAPRIT,RAF5
- Q
- OERR ;Send Alert to OERR after pt examined
- 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
- Q
- OERR3 ; Send RADIOLOGY PATIENT EXAMINED notification via oe/rr v3
- ; Called from UP1
- ;
- ; RADFN,RADTI,RACNI,RAPRIT must be defined
- Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))!('$D(RAPRIT))
- ;
- N RAIENS,RAMSG,RAOIFN,RAOSTS,RAONODE,RADPTNDE,RAREQPHY
- S RADPTNDE=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
- S RAOIFN=$P(RADPTNDE,U,11) Q:'RAOIFN ;file 75.1 ien
- S RAONODE=$G(^RAO(75.1,+RAOIFN,0))
- S RAOSTS=$P(RAONODE,U,5) Q:RAOSTS'=6 ;active exams only
- S RAOIFN=$P(RAONODE,U,7) ;file 100 ien
- S RAREQPHY=+$P(RADPTNDE,U,14) ;ordering provider
- S RAREQPHY(RAREQPHY)=""
- S RAMSG="Imaging Pt Examined - "_$S($D(^RAMIS(71,RAPRIT,0)):$E($P(^(0),U),1,24),1:"Unknown"),RAMSG=$E(RAMSG,1,51)
- S RAIENS=RADTI_"~"_RACNI
- ;
- ; oe parameters:
- ; ORN: notification id (#100.9 ien)
- ; | ORBDFN: patient id (#2 ien)
- ; | | ORNUM: order number (#100 ien)
- ; | | | ORBADUZ: recipient array
- ; | | | | ORBPMSG: message text
- ; | | | | | ORBPDATA exam dt~case iens
- ; | | | | | |
- D EN^ORB3(21,RADFN,RAOIFN,.RAREQPHY,RAMSG,RAIENS)
- Q
- ;
- ;Called by many report programs. Sets RACRT() array containing all
- ;exam statuses that are to be included on the report. RACRT is set
- ;to the piece of the Exam Status File #72 record that corresponds
- ;to the report being generated.
- CRIT F I=0:0 S I=$O(^RA(72,I)) Q:'I I $D(^(I,.3)),$P(^(.3),"^",RACRT)="y" S RACRT(I)=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAUTL1 9631 printed Jan 18, 2025@03:41:08 Page 2
- RAUTL1 ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Utility Routine ; Nov 26, 2019@16:15:02
- +1 ;;5.0;Radiology/Nuclear Medicine;**5,9,18,71,82,84,94,47,162**;Mar 16, 1998;Build 2
- +2 ;last modification by SS for P18 June 19,00
- +3 ;07/28/2008 BAY/KAM RA*5*94 Remove patch 81 from 2nd line of routine
- +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 IF "IOSCR"'[X!(X="")
- SET X="Unknown"
- QUIT
- +11 GOTO @($EXTRACT(X))
- +12 ;Set X=Inpatient Location
- I SET X=$SELECT($DATA(^DIC(42,+$PIECE(^RADPT(D0,"DT",D1,"P",D2,0),"^",6),0)):$PIECE(^(0),"^"),1:"Unknown")
- +1 QUIT
- +2 ;
- +3 ;Set X=Outpatient Location
- O SET X=$SELECT($DATA(^SC(+$PIECE(^RADPT(D0,"DT",D1,"P",D2,0),"^",8),0)):$PIECE(^(0),"^"),1:"Unknown")
- +1 QUIT
- +2 ;
- +3 ;Set X=Contract/Sharing Agreement patient location
- S ;
- C SET X=$SELECT($DATA(^DIC(34,+$PIECE(^RADPT(D0,"DT",D1,"P",D2,0),"^",9),0)):$PIECE(^(0),"^"),1:"Unknown")
- +1 QUIT
- +2 ;
- +3 ;Set X=Research patient location
- R SET X=$SELECT($DATA(^RADPT(D0,"DT",D1,"P",D2,"R")):$PIECE(^("R"),"^"),1:"Unknown")
- QUIT
- +1 ;
- +2 ;Set X=time of day in external format (ex: 2:28 PM)
- NOW SET %=$PIECE($HOROLOG,",",2)
- SET X=DT_(%\60#60/100+(%\3600)+(%#60/10000)/100)
- DO TIME
- +1 QUIT
- +2 ;Input X=FM date/time, Output X=time (external format)
- TIME SET X=$EXTRACT($PIECE(X,".",2)_"0000",1,4)
- SET %=X>1159
- if X>1259
- SET X=X-1200
- SET X=X\100_":"_$EXTRACT(X#100+100,2,3)_" "_$EXTRACT("AP",%+1)_"M"
- if $PIECE(X,"
- SET X=12_":"_$PIECE(X,":",2)
- +1 QUIT
- +2 ;
- ELAPSED ;Pass parameters X (from date) and X1 (to date)
- +1 ;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
- +2 ;Variable Y1 is returned as the # of minutes of elapsed time
- +3 IF '$DATA(RAMTIME)
- SET DIC="^DD(""FUNC"","
- SET DIC(0)="FX"
- SET RAX=X
- SET X="MINUTES"
- DO ^DIC
- KILL DIC
- SET X=RAX
- if $DATA(^DD("FUNC",+Y,1))
- SET RAMTIME=^(1)
- IF '$DATA(RAMTIME)
- WRITE $CHAR(7),!!,"Can't continue --- No 'MINUTES' function found in File Manager"
- KILL Y,Y1
- GOTO Q
- +4 XECUTE RAMTIME
- SET Y1=X
- IF X<0
- SET Y="Neg. Time"
- GOTO Q
- MINUTS SET X(1)=X\1440
- SET X=X-(1440*X(1))
- SET X(2)=X\60
- SET X(3)=X-(60*X(2))
- SET Y=$EXTRACT(100+X(1),2,3)_":"_$EXTRACT(100+X(2),2,3)_":"_$EXTRACT(100+X(3),2,3)
- Q KILL RAX,X
- QUIT
- +1 ;
- UPDATE ;Entry point for Update Rad/Nuc Med Exam Status option
- +1 IF $ORDER(RACCESS(DUZ,""))=""
- DO SETVARS^RAPSET1(0)
- +2 IF $GET(RAIMGTY)=""
- DO SETVARS^RAPSET1(1)
- +3 ; didn't sign-on to an imaging location
- IF $GET(RAIMGTY)=""
- KILL XQUIT
- QUIT
- +4 DO ^RACNLU
- if "^"[X
- GOTO UPQ
- +5 IF $DATA(^RA(72,"AA",RAIMGTY,9,+RAST))
- IF '$DATA(^XUSEC("RA MGR",DUZ))
- WRITE !!?3,$CHAR(7),"You do not have the appropriate access privileges to act on completed exams."
- GOTO UPDATE
- +6 IF $DATA(^RA(72,"AA",RAIMGTY,0,+RAST))
- WRITE !!?3,$CHAR(7),"Exam has been 'cancelled' therefore the status cannot be changed."
- GOTO UPDATE
- +7 ;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
- +8 DO UP1
- IF RAOR>0
- Begin DoDot:1
- +9 LOCK +^RADPT(RADFN,"DT",RADTI,"P",RACNI):$GET(DILOCKTM,3)
- +10 NEW RAIEN
- +11 SET RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_","
- +12 SET RAFDA(70.07,RAIENS,.01)="NOW"
- +13 KILL RAERR
- DO UPDATE^DIE("E","RAFDA","RAIEN","RAERR")
- +14 KILL RAFDA,RAIENS
- +15 IF $DATA(RAERR)
- SET RAERR="Error in update of 70.07, .01 "_$GET(RAERR("DIERR",1,"TEXT",1))
- KILL RAERR("DIERR")
- LOCK -^RADPT(RADFN,"DT",RADTI,"P",RACNI)
- KILL RAIEN
- QUIT
- +16 SET RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_","
- +17 SET RAFDA(70.07,RAIENS,2)="U"
- +18 SET RAFDA(70.07,RAIENS,3)=$SELECT($GET(RADUZ):RADUZ,1:DUZ)
- +19 DO FILE^DIE(,"RAFDA","RAERR")
- +20 LOCK -^RADPT(RADFN,"DT",RADTI,"P",RACNI)
- +21 IF $DATA(RAERR)
- SET RAERR="Error in update of 70.07, 2,3 "_$GET(RAERR("DIERR",1,"TEXT",1))
- KILL RAERR("DIERR")
- End DoDot:1
- UPQ KILL RAFDA,RAIENS
- +1 KILL %,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($JOB,"RAEX"),C,DIPGM
- QUIT
- +2 ;
- +3 ;Exam status updating and accompanying updates to status log, oe/rr
- UP1 ;use this to flag when one alert has been sent
- NEW RA8,RAEXEDT
- SET RA8=0
- +1 ;Line change for RA*5*82
- +2 ;P18 if procedure changed in RAEDCN or RAEDPT sends XX message to CPRS if needed
- SET RAEXEDT=$$CMPAFTR^RAO7XX(1)
- +3 ; RA EDITCN and RA EDITPT should process this case only
- +4 IF $DATA(RAOPT("EDITCN"))!($DATA(RAOPT("EDITPT")))
- DO UP2
- DO UPK
- QUIT
- +5 ; see if this case belongs to a printset
- +6 if '$DATA(RAPRTSET)
- NEW RAPRTSET
- if '$DATA(RAMEMARR)
- NEW RAMEMARR
- +7 ;043099 always recalculate RAPRTSET
- DO EN2^RAUTL20(.RAMEMARR)
- +8 ; if not print set, then just process this case only
- +9 IF 'RAPRTSET
- DO UP2
- DO UPK
- QUIT
- +10 ;case belongs to print set, so process all members of same print set
- +11 NEW RACNISAV,RA7
- +12 SET RACNISAV=RACNI
- SET RA7=0
- +13 FOR
- SET RA7=$ORDER(RAMEMARR(RA7))
- if RA7=""
- QUIT
- SET RACNI=RA7
- DO UP2
- +14 SET RACNI=RACNISAV
- +15 GOTO UPK
- UP2 ;Remedy Call 124379 Patch *71 BAY/KAM Added next line
- +1 ;Patch RA*5*82 next line commented out
- +2 ;D:$G(RAHLTCPB)'=1 EXM^RAHLRPC
- +3 ;
- +4 SET DA(2)=RADFN
- SET DA(1)=RADTI
- SET DA=RACNI
- SET DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"","
- +5 NEW RAAFTER,RABEFORE
- +6 DO STUFF^RASTREQ1
- IF RAOR<0
- IF $DATA(RASN)
- if '$DATA(RAONLINE)&('$DATA(ZTQUEUED))
- WRITE !?5,"...exam status remains '",RASN,"'."
- KILL DIE,RACS,RAPRIT
- Begin DoDot:1
- +7 ; DO statement added by RA*5*82
- if $GET(RAEXEDT)
- DO EXM^RAHLRPC
- End DoDot:1
- QUIT
- +8 ;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)
- +9 NEW RASSAN,RACNDSP
- SET RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
- +10 SET RACNDSP=$SELECT((RASSAN'=""):RASSAN,1:$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U))
- +11 IF $$USESSAN^RAHLRU1()
- if '$DATA(RAONLINE)&('$DATA(ZTQUEUED))
- WRITE !?3,"...will now designate exam status as '",RASN,"'",!?25,"...for case no. ",RACNDSP
- +12 IF '$$USESSAN^RAHLRU1()
- if '$DATA(RAONLINE)&('$DATA(ZTQUEUED))
- WRITE !?3,"...will now designate exam status as '",RASN,"'... for case no. ",$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U)
- +13 ; S DR="3////"_RASTI_$S($P(RAMDV,"^",10):";75///^S X=$$MIDNGHT^RAUTL5($$NOW^XLFDT())",1:"")
- +14 ; user duz could be in RADUZ, if session is from the Voice recognition
- +15 ;S DR(2,70.05)=$S($P(RAMDV,"^",11)&('$D(ZTQUEUED)):".01;",1:"")_"2////"_RASTI_";3////"_$S($G(RADUZ):RADUZ,1:DUZ)
- +16 ;D ^DIE
- +17 ;*** P162 mod on timeout INC7406782 use DILOCKTM
- +18 ;*** else default to three
- +19 LOCK +^RADPT(RADFN,"DT",RADTI,"P",RACNI):$GET(DILOCKTM,3)
- +20 ;*** P162 end
- +21 NEW RAIEN
- +22 SET RAIENS=RACNI_","_RADTI_","_RADFN_","
- +23 SET RAFDA(70.03,RAIENS,3)=RASTI
- +24 KILL RAERR
- DO FILE^DIE(,"RAFDA","RAERR")
- +25 ;L - P18
- IF $DATA(RAERR)
- SET RAERR="Error in update of 70.03 "_$GET(RAERR("DIERR",1,"TEXT",1))
- KILL RAERR("DIERR")
- LOCK -^RADPT(RADFN,"DT",RADTI,"P",RACNI)
- GOTO UP2K
- +26 IF $PIECE(RAMDV,"^",10)
- Begin DoDot:1
- +27 NEW RAERR2
- +28 SET RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_","
- +29 SET RAFDA(70.05,RAIENS,.01)=$$MIDNGHT^RAUTL5($$NOW^XLFDT())
- +30 DO UPDATE^DIE(,"RAFDA","RAIEN","RAERR")
- +31 KILL RAFDA,RAIENS
- +32 IF $DATA(RAERR)
- SET RAERR="Error in update of 70.05, .01 "_$GET(RAERR("DIERR",1,"TEXT",1))
- KILL RAERR("DIERR")
- +33 if '$DATA(RAIEN(1))
- QUIT
- +34 IF $PIECE(RAMDV,"^",11)
- IF ('$DATA(ZTQUEUED))
- Begin DoDot:2
- +35 SET DIE=DIE_RACNI_",""T"","
- SET DA=RAIEN(1)
- +36 SET DR=".01"
- +37 DO ^DIE
- End DoDot:2
- +38 SET RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_","
- +39 SET RAFDA(70.05,RAIENS,2)=RASTI
- +40 SET RAFDA(70.05,RAIENS,3)=$SELECT($GET(RADUZ):RADUZ,1:DUZ)
- +41 KILL RAERR2
- DO FILE^DIE(,"RAFDA","RAERR2")
- +42 IF $DATA(RAERR2)
- SET RAERR2="Error in update of 70.05 2,3 "_$GET(RAERR2("DIERR",1,"TEXT",1))
- SET RAERR=$SELECT($DATA(RAERR):RAERR_";"_RAERR2,1:RAERR2)
- End DoDot:1
- +43 ;Patch RA*5*82 added next line send EXM message after status update, not before the update
- +44 if '$DATA(RAERR)
- DO EXM^RAHLRPC
- +45 LOCK -^RADPT(RADFN,"DT",RADTI,"P",RACNI)
- +46 ;
- UP2K KILL DE,DQ,DIE,DR,RAFDA,RAIENS
- if $DATA(RAERR)
- KILL RACS,RAPRIT
- if $DATA(RAERR)
- QUIT
- if '$DATA(RAONLINE)&('$DATA(ZTQUEUED))
- WRITE !?10,"...exam status ",$SELECT($GET(RABEFORE)>$GET(RAAFTER):"backed down",1:"successfully updated"),"."
- DO ^RAORDC
- +1 IF RA8=0
- IF $DATA(^RA(72,RASTI,"ALERT"))
- IF $PIECE(^("ALERT"),"^")="y"
- if $$ORVR^RAORDU()=2.5
- DO OERR
- if $$ORVR^RAORDU()'<3
- DO OERR3
- SET RA8=1
- +2 IF $DATA(^RA(72,RASTI,0))
- IF $PIECE(^(0),"^",3)>1
- IF RACS'="Y"
- IF $SELECT('$DATA(RAF5):1,$PIECE(^DIC(42,+RAF5,0),U,3)="D":1,1:0)
- DO EN^RAUTL0
- +3 KILL RACS,RAORDIFN,RAPRIT,RAF5
- +4 QUIT
- UPK KILL ORIFN,ORVP,ORNOTE,ORBPMSG,RACS,RAORDIFN,RAPRIT,RAF5
- +1 QUIT
- OERR ;Send Alert to OERR after pt examined
- +1 SET ORVP=RADFN_";DPT("
- SET ORBPMSG="Rad Pt Examined - "_$SELECT($DATA(^RAMIS(71,RAPRIT,0)):$EXTRACT($PIECE(^(0),"^"),1,24),1:"Unknown")
- if $DATA(^RAO(75.1,+RAORDIFN,0))
- SET ORIFN=+$PIECE(^(0),"^",7)
- SET ORNOTE(21)=$SELECT($DATA(ORIFN):1,1:"")
- DO NOTE^ORX3
- +2 QUIT
- OERR3 ; Send RADIOLOGY PATIENT EXAMINED notification via oe/rr v3
- +1 ; Called from UP1
- +2 ;
- +3 ; RADFN,RADTI,RACNI,RAPRIT must be defined
- +4 if '$DATA(RADFN)!('$DATA(RADTI))!('$DATA(RACNI))!('$DATA(RAPRIT))
- QUIT
- +5 ;
- +6 NEW RAIENS,RAMSG,RAOIFN,RAOSTS,RAONODE,RADPTNDE,RAREQPHY
- +7 SET RADPTNDE=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
- +8 ;file 75.1 ien
- SET RAOIFN=$PIECE(RADPTNDE,U,11)
- if 'RAOIFN
- QUIT
- +9 SET RAONODE=$GET(^RAO(75.1,+RAOIFN,0))
- +10 ;active exams only
- SET RAOSTS=$PIECE(RAONODE,U,5)
- if RAOSTS'=6
- QUIT
- +11 ;file 100 ien
- SET RAOIFN=$PIECE(RAONODE,U,7)
- +12 ;ordering provider
- SET RAREQPHY=+$PIECE(RADPTNDE,U,14)
- +13 SET RAREQPHY(RAREQPHY)=""
- +14 SET RAMSG="Imaging Pt Examined - "_$SELECT($DATA(^RAMIS(71,RAPRIT,0)):$EXTRACT($PIECE(^(0),U),1,24),1:"Unknown")
- SET RAMSG=$EXTRACT(RAMSG,1,51)
- +15 SET RAIENS=RADTI_"~"_RACNI
- +16 ;
- +17 ; oe parameters:
- +18 ; ORN: notification id (#100.9 ien)
- +19 ; | ORBDFN: patient id (#2 ien)
- +20 ; | | ORNUM: order number (#100 ien)
- +21 ; | | | ORBADUZ: recipient array
- +22 ; | | | | ORBPMSG: message text
- +23 ; | | | | | ORBPDATA exam dt~case iens
- +24 ; | | | | | |
- +25 DO EN^ORB3(21,RADFN,RAOIFN,.RAREQPHY,RAMSG,RAIENS)
- +26 QUIT
- +27 ;
- +28 ;Called by many report programs. Sets RACRT() array containing all
- +29 ;exam statuses that are to be included on the report. RACRT is set
- +30 ;to the piece of the Exam Status File #72 record that corresponds
- +31 ;to the report being generated.
- CRIT FOR I=0:0
- SET I=$ORDER(^RA(72,I))
- if 'I
- QUIT
- IF $DATA(^(I,.3))
- IF $PIECE(^(.3),"^",RACRT)="y"
- SET RACRT(I)=""
- +1 QUIT