source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAUTL12.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1RAUTL12 ;HISC/CAH,FPT,GJC-Utility Routine ;12/23/97 09:25
2 ;;5.0;Radiology/Nuclear Medicine;**75**;Mar 16, 1998;Build 4
3 ;
4IMGTY(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 ;
32LOCK(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 ;
47UNLOCK(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
51EXTRA(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 ;
57DESDT(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 ;
72PTLOC() ; 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 ;
93IMG() ; 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 ;
103LOC(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)
Note: See TracBrowser for help on using the repository browser.