source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAUTL13.m@ 1328

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1RAUTL13 ;HISC/CAH-Utility OMA Loc selector, Pt Loc change, Submit-to loc scrn ;9/5/96 07:52
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3IPOP ;Determine if current pt loc is different than requesting loc
4 ;INPUT VARIABLES:
5 ; RAORD0=Zeroeth node of order record from file 75.1
6 ;OUTPUT VARIABLES:
7 ; RALOCN=Name of current loc (or 'UNKNOWN' if not definable)
8 ; RARLOCN=Defined only if requesting loc different from current loc.
9 ; Value is Name of requesting loc
10 ;To update pt loc, get requesting loc, determine if IP or OP
11 ;RARLOC=IEN of req'g loc in File 44, RARLOCN=Req'g loc name
12 ;RARIPOP="I" if inpatient req. loc, "O" if outpatient req. loc
13 S RARLOC=+$P(RAORD0,U,22),RARLOCN=$S($D(^SC(RARLOC,0)):$P(^(0),"^"),1:"UNKNOWN")
14 K RARIPOP S X=$G(^SC(RARLOC,42)) S RARIPOP=$S($L($G(^DIC(42,+X,0))):"I",1:"O")
15 ;RAIPLOC=IEN of Inp Loc in File 42, RAIPLOCN=Name of Inp Loc
16 ;RACIPOP="I" if currently inpatient, or "O" if currently Outpatient
17 S DFN=RADFN D INP^VADPT S RAIPLOC=$P($G(VAIN(4)),U,1),RAIPLOCN=$P($G(VAIN(4)),U,2),RACIPOP=$S($L(RAIPLOC):"I",1:"O"),RAIN44=+$G(^DIC(42,+RAIPLOC,44))
18 I '$L(RAIPLOC) D OP G IPOPQ ;If pt currently outp
19 ;Continue only if patient currently inp.
20 I RAIN44'=RARLOC S RALOCN=RAIPLOCN G IPOPQ ;if loc change
21 I RAIN44=RARLOC S RALOCN=RAIPLOCN K RARLOCN G IPOPQ ;if no change
22 Q
23OP I RARIPOP="O",RACIPOP="O" S RALOCN=RARLOCN K RAIPLOCN,RAIPLOC,RARLOCN Q
24 I RARIPOP="I",RACIPOP="O" S RALOCN="DISCHARGED"
25 Q
26IPOPQ K RAIN44,RAIPLOC,VAIN,RAIPLOCN,RACIPOP,RARIPOP,RARLOC,RALOC,X
27 Q
28 ;
29OMA ;Select One/Many/All locations within current imaging type
30 ;INPUT VARIABLES: RACCESS array must be defined if imaging location
31 ; access is to be screened. Otherwise, use gets to choose from
32 ; all imaging locations
33 ; RAIMGTY must be defined if imaging locations access is to be
34 ; screened by sign-on imaging type
35 ; RANOSCRN - if defned no screening is done regardless of whether
36 ; RAIMGTY and RACCESS are defined
37 ;OUTPUT VARIABLES: RALOC(Rad loc name, IEN of 79.1) array
38 ;
39 ;I '$D(RACCESS(DUZ,"LOC")) W !,"You do not have access to any Imaging Locations. See your ADPAC." K DIR S DIR(0)="E" D ^DIR K DIR S RAQUIT=1 G Q
40 K ^TMP($J,"RADLOCS")
41 ;If user can access more than one loc of current imaging type,
42 ;prompt user to select loc(s)
43 I '$G(RALOC1) D
44 . N RAARRY,RADIC,RAUTIL
45 . S RADIC="^RA(79.1,",(RAARRY,RAUTIL)="RADLOCS",RADIC(0)="QEAMZ"
46 . S RADIC("A")="Select Imaging Location(s): "
47 . I $D(RAIMGTY),'$D(RANOSCRN) S RADIC("S")="I (+$P(^(0),""^"",6)=+$O(^RA(79.2,""B"",RAIMGTY,0)))"
48 . D EN1^RASELCT(.RADIC,RAUTIL,RAARRY)
49 . Q
50 S I="" F S I=$O(^TMP($J,"RADLOCS",I)) Q:I="" S J="" F S J=$O(^TMP($J,"RADLOCS",I,J)) Q:J="" S RALOC(I,J)=""
51Q K I,J,RADIC,RAUTIL,RAARRY,^TMP($J,"RADLOCS")
52 Q
53SUBMIT(DA,Y) ;Called from file 75.1, field 20 (imaging location) screen
54 ; returns 1 if location being screened has same imaging type as
55 ; procedure ordered.
56 ; DA is the IEN of file 75.1, Y is the IEN of the entry in file
57 ; 79.1 that is being screened.
58 Q:$P($G(^RA(79.1,+Y,0)),U,19)]"" 0 ; inactive location
59 N RALOC,RALOCI,RAPROC,RAPROCI
60 S RALOC=$G(^RA(79.1,+Y,0))
61 S RALOCI=$G(^RA(79.2,$P(RALOC,U,6),0)) I '$L(RALOCI) Q 0
62 S RAPROC=+$P($G(^RAO(75.1,DA,0)),U,2),RAPROCI=+$P($G(^RAMIS(71,RAPROC,0)),U,12)
63 I RAPROCI=$P(RALOC,U,6) Q 1
64 Q 0
65SUBMITQ(DA,Y) ;Called from file 71.3, field 8 (imaging location) screen
66 ; returns 1 if location being screened has same imaging type as
67 ; the common procedure.
68 ; DA is the IEN of file 71.3, Y is the IEN of the entry in file
69 ; 79.1 that is being screened.
70 N RALOC,RALOCI,RAPROC,RAPROCI
71 S RALOC=$G(^RA(79.1,+Y,0)) Q:$P(RALOC,"^",19)]"" 0 ; inactive location
72 S RALOCI=$G(^RA(79.2,+$P(RALOC,U,6),0)) I '$L(RALOCI) Q 0
73 S RAPROC=+$P($G(^RAMIS(71.3,DA,0)),U)
74 S RAPROCI=+$P($G(^RAMIS(71,RAPROC,0)),U,12)
75 I RAPROCI=$P(RALOC,U,6) Q 1
76 Q 0
77INLO(X) ; Determine if the Imaging Location is inactive
78 ; Pass in the IEN of the Imaging Location (most of the time +RAMLC)
79 ; Pass back '1' if inactive, '0' if active.
80 Q $S($P($G(^RA(79.1,+X,0)),U,19)']"":0,1:1)
Note: See TracBrowser for help on using the repository browser.