- RAUTL12 ;HISC/CAH,FPT,GJC-Utility Routine ; May 21, 2021@11:13:20
- ;;5.0;Radiology/Nuclear Medicine;**75,163,181**;Mar 16, 1998;Build 1
- ;
- IMGTY(X,Y,Z) ; Determines the Imaging Type
- ; 'X' -> either 'e', 'l', or 'p'
- ; 'e' means we determine the Imaging Type from the 'Registered
- ; Exams' multiple in Rad/Nuc Med Patient file (70)
- ; 'l' means that we determine the Imaging Type from data in the
- ; Imaging Locations file (79.1)
- ; 'p' means that we determine the Imaging Type from data in the
- ; Rad/Nuc Med Procedures file (71)
- ;
- ; 'Y' -> The value of D0 in the above files.
- ;
- ; 'Z' -> The value of D1 in the Rad/Nuc Med Patient file (70).
- ; [ This routine passes back the Imaging Type in the external format ]
- N A,B,RAXYZ
- I X="e" D
- . S A=$G(^RADPT(+$G(Y),"DT",+$G(Z),0)),B=+$P(A,U,2)
- . S RAXYZ=$P($G(^RA(79.2,B,0)),U)
- . Q
- I X="l" D
- . S A=$G(^RA(79.1,+$G(Y),0)),B=+$P(A,U,6)
- . S RAXYZ=$P($G(^RA(79.2,B,0)),U)
- . Q
- I X="p" D
- . S A=$G(^RAMIS(71,+$G(Y),0)),B=+$P(A,U,12)
- . S RAXYZ=$P($G(^RA(79.2,B,0)),U)
- . Q
- Q RAXYZ
- ;
- LOCK(X,Y) ; Lock the data global
- ; 'X' is the global root
- ; 'Y' is the record number
- ; KLM/163 - remove setting of RADUZ and ^TMP("RAD LOCS"
- N RALCKFLG,XY
- ;S RADUZ=+$G(DUZ),
- S RALCKFLG=0,XY=X_Y
- L +@(XY_")"):5
- I '$T S RALCKFLG=1 D
- . W !?5,"This record is being edited by another user."
- . W !?5,"Try again later!",$C(7)
- . Q
- ;E D
- ;. S ^TMP("RAD LOCKS",$J,RADUZ,X,Y)=""
- ;. Q
- Q RALCKFLG
- ;
- UNLOCK(X,Y) ; Unlock the data global
- ;KLM/163 - remove setting of RADUZ and ^TMP("RAD LOCS"
- N XY ;S RADUZ=+$G(DUZ),
- S XY=X_Y L -@(XY_")")
- ;K ^TMP("RAD LOCKS",$J,RADUZ,X,Y)
- Q
- ;Output is AMIS Credit Indicator: RABILAT = BILATERAL,
- ;RAPORT = PORTABLE, and RAOR = OPERATING ROOM.
- S RAQI=$P($G(^RAMIS(71.2,RAQI,0)),U,2) S:RAQI="b" RABILAT="" S:RAQI="p" RAPORT="" S:RAQI="o" RAOR=""
- Q
- ;
- DESDT(RAPRI) ;Obtain 'Date Desired (NOT appt date)' by DIR call.
- ;from DESDT^RAUTL12 gjc@181
- ; The 'Date Desired' is passed back in internal format.
- ; 75.1 -> Rad Orders File Fld 21 -> Date desired
- ; Input: RAPRI = IEN of the procedure being ordered.
- ;
- N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
- I '$D(RAPKG),($D(ORVP)),($D(ORL)),($D(ORNP)) D PROCMSG^RAUTL5(RAPRI)
- F D Q:Y'=""
- .S DIR("?",1)="The date desired cannot be greater than 390 days into the future from today."
- .S DIR("?",2)=" "
- .S DIR("?",3)="The Date Desired or Clinically Indicated Date (CID) is the date for which the"
- .S DIR("?",4)="Rad/Nuc Med exam is requested. The CID is required and should not be interpreted"
- .S DIR("?")="as an appointment date."
- .; 1st parameter is user's input in internal FM date format ('Y' not 'X')
- .S DIR(0)="75.1,21^^K:$$FMDIFF^XLFDT(Y,DT,1)>390 X" D ^DIR
- .S:$D(DTOUT)#2!($D(DUOUT)#2) Y=-1
- .Q
- Q Y
- ;
- PTLOC() ; Current patient location. Used for entry: 'CURRENT PATIENT
- ; LOCATION' in the Label Print Fields file. (78.7)
- ; 'X' is the patient's DFN. DFN must be a positive integer.
- N %,%H,%I,A,B,C,DFN,VAERR,VAIN,X,Y,Y1,Y2,Y3,Y4,Y5
- S Y=$$NOW^XLFDT(),Y1=$P(Y,"."),Y2=$E($P(Y,".",2),1,4)
- S Y3=$E(Y1,4,5)_"-"_$E(Y1,6,7)_"-"_(1700+$E(Y1,1,3))
- S Y4=$E(Y2,1,2)_":"_$E(Y2,3,4)
- S Y5=Y3_"@"_Y4,DFN=+$P($G(^RADPT(+$G(RADFN),0)),"^")
- Q:'+$G(DFN) "OP Unknown/"_Y5
- D INP^VADPT ; If currently an inpatient, grab the ward.
- I $P($G(VAIN(4)),"^",2)]"" D Q Y
- . S Y=$E($P($G(VAIN(4)),"^",2),1,15)_"/"_Y5
- . Q
- ; If not currently an inpatient, check if last recorded patient location
- ; is a ward. If it is a ward or operating room, pass back 'OP Unknown'.
- ; We do not have the benefit of PIMS updating our Rad/Nuc Med files.
- S X=+$P($G(^RADPT(+$G(RADFN),"DT",+$G(RADTI),"P",+$G(RACNI),0)),"^",11)
- S A=+$P($G(^RAO(75.1,X,0)),"^",22),B=$G(^SC(A,0)),C=$P(B,"^",3)
- Q:B']""!("WOR"[C) "OP Unknown/"_Y5
- Q $P(B,"^")_" (Req'g Loc)"
- ;
- IMG() ; Select one/many/all imaging types. This code will be used for ALL
- ; the options under the Procedure File Listings option as exported by
- ; Rad/Nuc Med version 5. I-Types are not screened.
- ; Passes back '1' if I-Type(s) are selected, '0' if nothing selected.
- N RADIC,RAQUIT,RAUTIL,X,Y
- S RADIC="^RA(79.2,",RADIC(0)="QEAMZ"
- S RADIC("A")="Select Imaging Type: ",RADIC("B")="All"
- S RAUTIL="RA I-TYPE" W !! D EN1^RASELCT(.RADIC,RAUTIL)
- Q $S($D(^TMP($J,"RA I-TYPE"))\10:1,1:0)
- ;
- LOC(RAX) ; Select one/many/all imaging locations. L-Types are not
- ; screened. Passes back '1' if L-Type(s) are selected, '0' if nothing
- ; selected. Used for the option: 'Location Parameter List' (4^RASYS)
- N RADIC,RAQUIT,RAUTIL,X,Y
- S RADIC="^RA(79.1,",RADIC(0)="QEFAMZ"
- S RADIC("A")="Select Imaging Location: ",RADIC("B")="All"
- S:'RAX RADIC("S")="N RADT S RADT=$P(^(0),""^"",19) I $S('RADT:1,RADT>DT:1,1:0)"
- S RAUTIL="RA L-TYPE" W !! D EN1^RASELCT(.RADIC,RAUTIL)
- Q $S($D(^TMP($J,"RA L-TYPE"))\10:1,1:0)
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAUTL12 4980 printed Jan 18, 2025@03:41:11 Page 2
- RAUTL12 ;HISC/CAH,FPT,GJC-Utility Routine ; May 21, 2021@11:13:20
- +1 ;;5.0;Radiology/Nuclear Medicine;**75,163,181**;Mar 16, 1998;Build 1
- +2 ;
- IMGTY(X,Y,Z) ; Determines the Imaging Type
- +1 ; 'X' -> either 'e', 'l', or 'p'
- +2 ; 'e' means we determine the Imaging Type from the 'Registered
- +3 ; Exams' multiple in Rad/Nuc Med Patient file (70)
- +4 ; 'l' means that we determine the Imaging Type from data in the
- +5 ; Imaging Locations file (79.1)
- +6 ; 'p' means that we determine the Imaging Type from data in the
- +7 ; Rad/Nuc Med Procedures file (71)
- +8 ;
- +9 ; 'Y' -> The value of D0 in the above files.
- +10 ;
- +11 ; 'Z' -> The value of D1 in the Rad/Nuc Med Patient file (70).
- +12 ; [ This routine passes back the Imaging Type in the external format ]
- +13 NEW A,B,RAXYZ
- +14 IF X="e"
- Begin DoDot:1
- +15 SET A=$GET(^RADPT(+$GET(Y),"DT",+$GET(Z),0))
- SET B=+$PIECE(A,U,2)
- +16 SET RAXYZ=$PIECE($GET(^RA(79.2,B,0)),U)
- +17 QUIT
- End DoDot:1
- +18 IF X="l"
- Begin DoDot:1
- +19 SET A=$GET(^RA(79.1,+$GET(Y),0))
- SET B=+$PIECE(A,U,6)
- +20 SET RAXYZ=$PIECE($GET(^RA(79.2,B,0)),U)
- +21 QUIT
- End DoDot:1
- +22 IF X="p"
- Begin DoDot:1
- +23 SET A=$GET(^RAMIS(71,+$GET(Y),0))
- SET B=+$PIECE(A,U,12)
- +24 SET RAXYZ=$PIECE($GET(^RA(79.2,B,0)),U)
- +25 QUIT
- End DoDot:1
- +26 QUIT RAXYZ
- +27 ;
- LOCK(X,Y) ; Lock the data global
- +1 ; 'X' is the global root
- +2 ; 'Y' is the record number
- +3 ; KLM/163 - remove setting of RADUZ and ^TMP("RAD LOCS"
- +4 NEW RALCKFLG,XY
- +5 ;S RADUZ=+$G(DUZ),
- +6 SET RALCKFLG=0
- SET XY=X_Y
- +7 LOCK +@(XY_")"):5
- +8 IF '$TEST
- SET RALCKFLG=1
- Begin DoDot:1
- +9 WRITE !?5,"This record is being edited by another user."
- +10 WRITE !?5,"Try again later!",$CHAR(7)
- +11 QUIT
- End DoDot:1
- +12 ;E D
- +13 ;. S ^TMP("RAD LOCKS",$J,RADUZ,X,Y)=""
- +14 ;. Q
- +15 QUIT RALCKFLG
- +16 ;
- UNLOCK(X,Y) ; Unlock the data global
- +1 ;KLM/163 - remove setting of RADUZ and ^TMP("RAD LOCS"
- +2 ;S RADUZ=+$G(DUZ),
- NEW XY
- +3 SET XY=X_Y
- LOCK -@(XY_")")
- +4 ;K ^TMP("RAD LOCKS",$J,RADUZ,X,Y)
- +5 QUIT
- +1 ;Output is AMIS Credit Indicator: RABILAT = BILATERAL,
- +2 ;RAPORT = PORTABLE, and RAOR = OPERATING ROOM.
- +3 SET RAQI=$PIECE($GET(^RAMIS(71.2,RAQI,0)),U,2)
- if RAQI="b"
- SET RABILAT=""
- if RAQI="p"
- SET RAPORT=""
- if RAQI="o"
- SET RAOR=""
- +4 QUIT
- +5 ;
- DESDT(RAPRI) ;Obtain 'Date Desired (NOT appt date)' by DIR call.
- +1 ;from DESDT^RAUTL12 gjc@181
- +2 ; The 'Date Desired' is passed back in internal format.
- +3 ; 75.1 -> Rad Orders File Fld 21 -> Date desired
- +4 ; Input: RAPRI = IEN of the procedure being ordered.
- +5 ;
- +6 NEW DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
- +7 IF '$DATA(RAPKG)
- IF ($DATA(ORVP))
- IF ($DATA(ORL))
- IF ($DATA(ORNP))
- DO PROCMSG^RAUTL5(RAPRI)
- +8 FOR
- Begin DoDot:1
- +9 SET DIR("?",1)="The date desired cannot be greater than 390 days into the future from today."
- +10 SET DIR("?",2)=" "
- +11 SET DIR("?",3)="The Date Desired or Clinically Indicated Date (CID) is the date for which the"
- +12 SET DIR("?",4)="Rad/Nuc Med exam is requested. The CID is required and should not be interpreted"
- +13 SET DIR("?")="as an appointment date."
- +14 ; 1st parameter is user's input in internal FM date format ('Y' not 'X')
- +15 SET DIR(0)="75.1,21^^K:$$FMDIFF^XLFDT(Y,DT,1)>390 X"
- DO ^DIR
- +16 if $DATA(DTOUT)#2!($DATA(DUOUT)#2)
- SET Y=-1
- +17 QUIT
- End DoDot:1
- if Y'=""
- QUIT
- +18 QUIT Y
- +19 ;
- PTLOC() ; Current patient location. Used for entry: 'CURRENT PATIENT
- +1 ; LOCATION' in the Label Print Fields file. (78.7)
- +2 ; 'X' is the patient's DFN. DFN must be a positive integer.
- +3 NEW %,%H,%I,A,B,C,DFN,VAERR,VAIN,X,Y,Y1,Y2,Y3,Y4,Y5
- +4 SET Y=$$NOW^XLFDT()
- SET Y1=$PIECE(Y,".")
- SET Y2=$EXTRACT($PIECE(Y,".",2),1,4)
- +5 SET Y3=$EXTRACT(Y1,4,5)_"-"_$EXTRACT(Y1,6,7)_"-"_(1700+$EXTRACT(Y1,1,3))
- +6 SET Y4=$EXTRACT(Y2,1,2)_":"_$EXTRACT(Y2,3,4)
- +7 SET Y5=Y3_"@"_Y4
- SET DFN=+$PIECE($GET(^RADPT(+$GET(RADFN),0)),"^")
- +8 if '+$GET(DFN)
- QUIT "OP Unknown/"_Y5
- +9 ; If currently an inpatient, grab the ward.
- DO INP^VADPT
- +10 IF $PIECE($GET(VAIN(4)),"^",2)]""
- Begin DoDot:1
- +11 SET Y=$EXTRACT($PIECE($GET(VAIN(4)),"^",2),1,15)_"/"_Y5
- +12 QUIT
- End DoDot:1
- QUIT Y
- +13 ; If not currently an inpatient, check if last recorded patient location
- +14 ; is a ward. If it is a ward or operating room, pass back 'OP Unknown'.
- +15 ; We do not have the benefit of PIMS updating our Rad/Nuc Med files.
- +16 SET X=+$PIECE($GET(^RADPT(+$GET(RADFN),"DT",+$GET(RADTI),"P",+$GET(RACNI),0)),"^",11)
- +17 SET A=+$PIECE($GET(^RAO(75.1,X,0)),"^",22)
- SET B=$GET(^SC(A,0))
- SET C=$PIECE(B,"^",3)
- +18 if B']""!("WOR"[C)
- QUIT "OP Unknown/"_Y5
- +19 QUIT $PIECE(B,"^")_" (Req'g Loc)"
- +20 ;
- IMG() ; Select one/many/all imaging types. This code will be used for ALL
- +1 ; the options under the Procedure File Listings option as exported by
- +2 ; Rad/Nuc Med version 5. I-Types are not screened.
- +3 ; Passes back '1' if I-Type(s) are selected, '0' if nothing selected.
- +4 NEW RADIC,RAQUIT,RAUTIL,X,Y
- +5 SET RADIC="^RA(79.2,"
- SET RADIC(0)="QEAMZ"
- +6 SET RADIC("A")="Select Imaging Type: "
- SET RADIC("B")="All"
- +7 SET RAUTIL="RA I-TYPE"
- WRITE !!
- DO EN1^RASELCT(.RADIC,RAUTIL)
- +8 QUIT $SELECT($DATA(^TMP($JOB,"RA I-TYPE"))\10:1,1:0)
- +9 ;
- LOC(RAX) ; Select one/many/all imaging locations. L-Types are not
- +1 ; screened. Passes back '1' if L-Type(s) are selected, '0' if nothing
- +2 ; selected. Used for the option: 'Location Parameter List' (4^RASYS)
- +3 NEW RADIC,RAQUIT,RAUTIL,X,Y
- +4 SET RADIC="^RA(79.1,"
- SET RADIC(0)="QEFAMZ"
- +5 SET RADIC("A")="Select Imaging Location: "
- SET RADIC("B")="All"
- +6 if 'RAX
- SET RADIC("S")="N RADT S RADT=$P(^(0),""^"",19) I $S('RADT:1,RADT>DT:1,1:0)"
- +7 SET RAUTIL="RA L-TYPE"
- WRITE !!
- DO EN1^RASELCT(.RADIC,RAUTIL)
- +8 QUIT $SELECT($DATA(^TMP($JOB,"RA L-TYPE"))\10:1,1:0)
- +9 ;