| [613] | 1 | RAUTL12 ;HISC/CAH,FPT,GJC-Utility Routine ;12/23/97 09:25
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**75**;Mar 16, 1998;Build 4
|
|---|
| 3 | ;
|
|---|
| 4 | IMGTY(X,Y,Z) ; Determines the Imaging Type
|
|---|
| 5 | ; 'X' -> either 'e', 'l', or 'p'
|
|---|
| 6 | ; 'e' means we determine the Imaging Type from the 'Registered
|
|---|
| 7 | ; Exams' multiple in Rad/Nuc Med Patient file (70)
|
|---|
| 8 | ; 'l' means that we determine the Imaging Type from data in the
|
|---|
| 9 | ; Imaging Locations file (79.1)
|
|---|
| 10 | ; 'p' means that we determine the Imaging Type from data in the
|
|---|
| 11 | ; Rad/Nuc Med Procedures file (71)
|
|---|
| 12 | ;
|
|---|
| 13 | ; 'Y' -> The value of D0 in the above files.
|
|---|
| 14 | ;
|
|---|
| 15 | ; 'Z' -> The value of D1 in the Rad/Nuc Med Patient file (70).
|
|---|
| 16 | ; [ This routine passes back the Imaging Type in the external format ]
|
|---|
| 17 | N A,B,RAXYZ
|
|---|
| 18 | I X="e" D
|
|---|
| 19 | . S A=$G(^RADPT(+$G(Y),"DT",+$G(Z),0)),B=+$P(A,U,2)
|
|---|
| 20 | . S RAXYZ=$P($G(^RA(79.2,B,0)),U)
|
|---|
| 21 | . Q
|
|---|
| 22 | I X="l" D
|
|---|
| 23 | . S A=$G(^RA(79.1,+$G(Y),0)),B=+$P(A,U,6)
|
|---|
| 24 | . S RAXYZ=$P($G(^RA(79.2,B,0)),U)
|
|---|
| 25 | . Q
|
|---|
| 26 | I X="p" D
|
|---|
| 27 | . S A=$G(^RAMIS(71,+$G(Y),0)),B=+$P(A,U,12)
|
|---|
| 28 | . S RAXYZ=$P($G(^RA(79.2,B,0)),U)
|
|---|
| 29 | . Q
|
|---|
| 30 | Q RAXYZ
|
|---|
| 31 | ;
|
|---|
| 32 | LOCK(X,Y) ; Lock the data global
|
|---|
| 33 | ; 'X' is the global root
|
|---|
| 34 | ; 'Y' is the record number
|
|---|
| 35 | N RALCKFLG,XY
|
|---|
| 36 | S RADUZ=+$G(DUZ),RALCKFLG=0,XY=X_Y
|
|---|
| 37 | L +@(XY_")"):5
|
|---|
| 38 | I '$T S RALCKFLG=1 D
|
|---|
| 39 | . W !?5,"This record is being edited by another user."
|
|---|
| 40 | . W !?5,"Try again later!",$C(7)
|
|---|
| 41 | . Q
|
|---|
| 42 | E D
|
|---|
| 43 | . S ^TMP("RAD LOCKS",$J,RADUZ,X,Y)=""
|
|---|
| 44 | . Q
|
|---|
| 45 | Q RALCKFLG
|
|---|
| 46 | ;
|
|---|
| 47 | UNLOCK(X,Y) ; Unlock the data global
|
|---|
| 48 | N XY S RADUZ=+$G(DUZ),XY=X_Y L -@(XY_")")
|
|---|
| 49 | K ^TMP("RAD LOCKS",$J,RADUZ,X,Y)
|
|---|
| 50 | Q
|
|---|
| 51 | EXTRA(RAQI) ;Input is RAQI (Modifier)
|
|---|
| 52 | ;Output is AMIS Credit Indicator: RABILAT = BILATERAL,
|
|---|
| 53 | ;RAPORT = PORTABLE, and RAOR = OPERATING ROOM.
|
|---|
| 54 | S RAQI=$P($G(^RAMIS(71.2,RAQI,0)),U,2) S:RAQI="b" RABILAT="" S:RAQI="p" RAPORT="" S:RAQI="o" RAOR=""
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | DESDT(RAPRI) ; Obtain 'Date Desired (NOT appt date)' by DIR call.
|
|---|
| 58 | ; Input: IEN of procedure
|
|---|
| 59 | ; The 'Date Desired' is passed back in internal format.
|
|---|
| 60 | ; 75.1 -> Rad Orders File Fld 21 -> Date desired
|
|---|
| 61 | N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
|
|---|
| 62 | I '$D(RAPKG),($D(ORVP)),($D(ORL)),($D(ORNP)) D PROCMSG^RAUTL5(RAPRI)
|
|---|
| 63 | F D Q:Y'=""
|
|---|
| 64 | .S DIR("?",1)="The 'Date Desired' field contains the date for which the rad/nuc med exam"
|
|---|
| 65 | .S DIR("?",2)="is requested. 'Date Desired' is required and should not be interpreted as"
|
|---|
| 66 | .S DIR("?")="an appointment date."
|
|---|
| 67 | .S DIR(0)="75.1,21" D ^DIR
|
|---|
| 68 | .S:$D(DTOUT)#2!($D(DUOUT)#2) Y=-1
|
|---|
| 69 | .Q
|
|---|
| 70 | Q Y
|
|---|
| 71 | ;
|
|---|
| 72 | PTLOC() ; Current patient location. Used for entry: 'CURRENT PATIENT
|
|---|
| 73 | ; LOCATION' in the Label Print Fields file. (78.7)
|
|---|
| 74 | ; 'X' is the patient's DFN. DFN must be a positive integer.
|
|---|
| 75 | N %,%H,%I,A,B,C,DFN,VAERR,VAIN,X,Y,Y1,Y2,Y3,Y4,Y5
|
|---|
| 76 | S Y=$$NOW^XLFDT(),Y1=$P(Y,"."),Y2=$E($P(Y,".",2),1,4)
|
|---|
| 77 | S Y3=$E(Y1,4,5)_"-"_$E(Y1,6,7)_"-"_(1700+$E(Y1,1,3))
|
|---|
| 78 | S Y4=$E(Y2,1,2)_":"_$E(Y2,3,4)
|
|---|
| 79 | S Y5=Y3_"@"_Y4,DFN=+$P($G(^RADPT(+$G(RADFN),0)),"^")
|
|---|
| 80 | Q:'+$G(DFN) "OP Unknown/"_Y5
|
|---|
| 81 | D INP^VADPT ; If currently an inpatient, grab the ward.
|
|---|
| 82 | I $P($G(VAIN(4)),"^",2)]"" D Q Y
|
|---|
| 83 | . S Y=$E($P($G(VAIN(4)),"^",2),1,15)_"/"_Y5
|
|---|
| 84 | . Q
|
|---|
| 85 | ; If not currently an inpatient, check if last recorded patient location
|
|---|
| 86 | ; is a ward. If it is a ward or operating room, pass back 'OP Unknown'.
|
|---|
| 87 | ; We do not have the benefit of PIMS updating our Rad/Nuc Med files.
|
|---|
| 88 | S X=+$P($G(^RADPT(+$G(RADFN),"DT",+$G(RADTI),"P",+$G(RACNI),0)),"^",11)
|
|---|
| 89 | S A=+$P($G(^RAO(75.1,X,0)),"^",22),B=$G(^SC(A,0)),C=$P(B,"^",3)
|
|---|
| 90 | Q:B']""!("WOR"[C) "OP Unknown/"_Y5
|
|---|
| 91 | Q $P(B,"^")_" (Req'g Loc)"
|
|---|
| 92 | ;
|
|---|
| 93 | IMG() ; Select one/many/all imaging types. This code will be used for ALL
|
|---|
| 94 | ; the options under the Procedure File Listings option as exported by
|
|---|
| 95 | ; Rad/Nuc Med version 5. I-Types are not screened.
|
|---|
| 96 | ; Passes back '1' if I-Type(s) are selected, '0' if nothing selected.
|
|---|
| 97 | N RADIC,RAQUIT,RAUTIL,X,Y
|
|---|
| 98 | S RADIC="^RA(79.2,",RADIC(0)="QEAMZ"
|
|---|
| 99 | S RADIC("A")="Select Imaging Type: ",RADIC("B")="All"
|
|---|
| 100 | S RAUTIL="RA I-TYPE" W !! D EN1^RASELCT(.RADIC,RAUTIL)
|
|---|
| 101 | Q $S($D(^TMP($J,"RA I-TYPE"))\10:1,1:0)
|
|---|
| 102 | ;
|
|---|
| 103 | LOC(RAX) ; Select one/many/all imaging locations. L-Types are not
|
|---|
| 104 | ; screened. Passes back '1' if L-Type(s) are selected, '0' if nothing
|
|---|
| 105 | ; selected. Used for the option: 'Location Parameter List' (4^RASYS)
|
|---|
| 106 | N RADIC,RAQUIT,RAUTIL,X,Y
|
|---|
| 107 | S RADIC="^RA(79.1,",RADIC(0)="QEFAMZ"
|
|---|
| 108 | S RADIC("A")="Select Imaging Location: ",RADIC("B")="All"
|
|---|
| 109 | S:'RAX RADIC("S")="N RADT S RADT=$P(^(0),""^"",19) I $S('RADT:1,RADT>DT:1,1:0)"
|
|---|
| 110 | S RAUTIL="RA L-TYPE" W !! D EN1^RASELCT(.RADIC,RAUTIL)
|
|---|
| 111 | Q $S($D(^TMP($J,"RA L-TYPE"))\10:1,1:0)
|
|---|
