112 lines
4.3 KiB
Mathematica
112 lines
4.3 KiB
Mathematica
RAUTL12 ;HISC/CAH,FPT,GJC-Utility Routine ;12/23/97 09:25
|
|
;;5.0;Radiology/Nuclear Medicine;**75**;Mar 16, 1998;Build 4
|
|
;
|
|
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
|
|
N RALCKFLG,XY
|
|
S RADUZ=+$G(DUZ),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
|
|
N XY S RADUZ=+$G(DUZ),XY=X_Y L -@(XY_")")
|
|
K ^TMP("RAD LOCKS",$J,RADUZ,X,Y)
|
|
Q
|
|
EXTRA(RAQI) ;Input is RAQI (Modifier)
|
|
;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.
|
|
; Input: IEN of procedure
|
|
; The 'Date Desired' is passed back in internal format.
|
|
; 75.1 -> Rad Orders File Fld 21 -> Date desired
|
|
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' field contains the date for which the rad/nuc med exam"
|
|
.S DIR("?",2)="is requested. 'Date Desired' is required and should not be interpreted as"
|
|
.S DIR("?")="an appointment date."
|
|
.S DIR(0)="75.1,21" 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)
|