source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAUTL19.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: 5.5 KB
Line 
1RAUTL19 ;HISC/GJC-Utility Routine ;11/13/97 15:18
2 ;;5.0;Radiology/Nuclear Medicine;**1,31**;Mar 16, 1998
3 ;
4PRELIM(RAIMG) ; Called from '1^RAMAIN1'
5 W !!?(IOM-$L(RAHDR)\2),RAHDR K %ZIS S %ZIS="MQ" W !
6 D ^%ZIS Q:POP
7 I $D(IO("Q")) D W ! Q
8 . S ZTDESC="Rad/Nuc Med Exam Status Entry/Edit Report",ZTSAVE("RA*")=""
9 . S ZTRTN="EN1^RAUTL19" D ^%ZTLOAD
10 . W !?5,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!")
11 . Q
12 I IO'=IO(0) U IO
13 D EN1 I IO'=IO(0) D HOME^%ZIS
14 Q
15EN1 ; Check data consistency
16 D EN1^RAUTL19C
17 Q
18NOTNEED ;non-radiopharm used don't need .5n and .6n fields answered
19 Q:RANODE(.5)'["Y"&(RANODE(.6)'["Y")
20 W !!,RADASH,"Checking fields not needed by non-nucmed imaging",RADASH
21 W !!?11,"Within : ",RAIMG,!?5,"The following need not be answered :"
22 W !?5,"Exam Status '",$P(RANODE(0),"^"),"'",!?5,"order ("_RAO_") '",!
23 N RAIMG0,RAIMG1,RAIMG2
24 S RAIMG1=.50,RAIMG2=.69,RAIMG0=RAIMG1
25 F S RAIMG0=$O(RAPIECE(RAIMG0)) Q:RAIMG0>RAIMG2 Q:RAIMG0="" I RAPIECE(RAIMG0)="Y" W !,"'",$P($G(^DD(72,RAIMG0,.1)),U),"' is set to ",RAPIECE(RAIMG0)
26 W !
27 Q
28CKPRNTR ;ck that all img locations for that img type has a dosg tkt prntr
29 N RAIMG72,RA791,RA791FL
30 S RAIMG72=$P(RANODE(0),U,7),RA791=0,RA791FL=0
31 F S RA791=$O(^RA(79.1,"BIMG",RAIMG72,RA791)) Q:'RA791 I $P(^RA(79.1,RA791,0),U,23)="" D PRNTASGN Q:RAOUT
32 Q
33PRNTASGN ;
34 W:'RA791FL !!,RADASH,"Checking Dosage Ticket Printer Assignment",RADASH
35 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
36 W:'RA791FL !!?11,"Within : ",RAIMG,!?5,"Exam Status '",$P(RANODE(0),"^"),"'",!?5,"order ("_RAO_") '"_$P($G(^DD(72,.611,.1)),U)_"'",!?5,"is set to 'Yes' but",!?5,"there's no Dosage Ticket Printer assigned to :"
37 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
38 S RA791FL=1
39 W !?15,$P(^SC($P(^RA(79.1,RA791,0),U),0),U)
40 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
41 Q
42WRPAIR I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
43 W:'RACHKERR !!,RADASH,"Checking fields that are inter-related",RADASH
44 S RACHKERR=1 ;only write this once
45 Q
46CKPAIR ; when field I is Y, then field J must also be Y at current/lower status
47 D CKPAIR^RAUTL19C
48 Q
49WRWAIT W:'RAWATERR !!,RADASH,"Checking ",$P(RANODE(0),U,1),"'s 'ASK' and 'REQUIRED' fields",RADASH,!?11,"within : ",RAIMG,!
50 S RAWATERR=1 ;only write this once regardless of number of errors found
51 Q
52CKWAIT ; CKWAIT is only done for WAITING FOR EXAM and assumes order seq = 1
53 D CKWAIT^RAUTL19C
54 Q
55ASKPRI(A,B,C) ; Check all prior statuses to ensure that the specific required
56 ; data field is set to 'yes', and the field for data asked is set to
57 ; 'yes'.
58 ; 'A' is the I-Type (external) <-> 'B' is the current status order
59 ; 'C' is fld that shd be prompted <-> 'E' is the order #
60 ; 'F' is the ien of file 72. <-> 'RA' hold the entire data node
61 ; 'RAFLD' value of the field <-> 'RAPCE' where data found on node
62 N E,F,RA,RAFLD,RAPCE S E=0
63 F S E=$O(^RA(72,"AA",A,E)) Q:E'>0!(E'<B) D Q:RAFLG
64 . S F=+$O(^RA(72,"AA",A,E,0)) Q:'F
65 . S RA(0)=$G(^RA(72,F,0))
66 . I $$UP^XLFSTR($P(RA(0),"^",5))="Y" D ; if on Status Tracking
67 .. S RAPCE=$E(C,3,$L(C)) ;pce is after 2nd byte, & is 1 or 2 bytes long
68 .. S RA($E(C,1,2))=$G(^RA(72,F,$E(C,1,2))),RAFLD=$P(RA($E(C,1,2)),"^",RAPCE)
69 .. S:$$UP^XLFSTR(RAFLD)="Y" RAFLG=1
70 .. Q
71 . Q
72 Q RAFLG
73PROCTY(Y) ; Passes back the Procedure Type. 'Y' is the ien in the
74 ; Rad/Nuc Med Procedure file '^RAMIS(71,'.
75 Q $$UP^XLFSTR($P($G(^RAMIS(71,+Y,0)),"^",6))
76LK(X) ; Lock a patient record when updating orders
77 ; 'X' input in a variable pointer format: 'record_#;data_file__root'
78 ; Pass back 'Y': '0' if lock fails, '1' if successful
79 ; 'Y' defined in LK^ORX2
80 Q 1
81ULK(X) ; Unlock a patient record
82 ; 'X' input in a variable pointer format: 'record_#;data_file__root'
83 Q
84ACCVIO ; Lack of Imaging Location access for a user
85 W !?5,$C(7),"You do not have access to any Imaging Locations."
86 W !?5,"Contact your ADPAC."
87 Q
88DEV(X) ; Lookup an entry in the Device (3.5) file.
89 ; Called from the [RA LOCATION PARAMETERS] input template. File: 79.1
90 ; Input: X=IEN of Device
91 ; Output: Name of Device
92 Q:'$L(X) ""
93 I X?1N.NP Q $P($G(^%ZIS(1,X,0)),"^")
94 Q ""
95OENO(X) ; OE/RR notifications, called from: RAORR1, RAORD1 & RAO7RO
96 ; Input: 'X' -> ien of the Rad/Nuc Med Orders file (75.1)
97 N I,RA751,RADFN,RADUZ,RALOC,RAMSG,RANOTY
98 S RA751=$G(^RAO(75.1,X,0)),RADFN=+$P(RA751,"^"),RANOTY=$P(RA751,"^",6)
99 S RANOTY=$S(RANOTY=1:51,RANOTY=2:52,1:"") Q:RANOTY=""
100 S RALOC=$P(RA751,"^",20) Q:RALOC']"" ; no i-loc, no alert
101 S I=0 F S I=$O(^RA(79.1,RALOC,"REC","B",I)) Q:I'>0 D
102 . S RADUZ(I)=""
103 . Q
104 S:($D(RADUZ)\10)=0 RADUZ="" ; NOTE: if no rad/nuc med recipients, check
105 ; oe/rr to see if they have any recipients for this particular alert
106 S RAMSG="Imaging Request Urgency: "_$$XTERNAL^RAUTL5($P(RA751,"^",6),$P($G(^DD(75.1,6,0)),"^",2))
107 D EN^ORB3(RANOTY,RADFN,X,.RADUZ,RAMSG)
108 Q
109VRADE ;VistaRad Category data entry
110 I '$$IMAGE^RARIC1() W !!,"Current system is not running Vista Imaging -- nothing done.",! Q
111 S DIC="^RA(79.2,",DIC(0)="QEAMNZ",DIC("A")="Select an Imaging Type: "
112 D ^DIC K DIC G:+Y'>0 VRADQ
113 S RAOUT=0,RAIMGTYI=+Y,RAIMGTYJ=$P(Y,U,2)
114 F D Q:RAOUT
115 . K DINUM,DLAYGO,D0 W !
116 . S DIC="^RA(72,",DIC(0)="QEAZ" ; don't allow LAYGO
117 . S DIC("S")="I +$P(^(0),U,7)=RAIMGTYI"
118 . S RADICW(1)="N RA S RA(0)=^(0),RA(3)=$P(RA(0),U,3) "
119 . S RADICW(2)="W ?35,""Imaging Type: "",?49,RAIMGTYJ"
120 . S RADICW(3)=",!?35,""Order: "",?42,RA(3)"
121 . S DIC("W")=RADICW(1)_RADICW(2)_RADICW(3)
122 . D ^DIC K DIC,RADICW
123 . I +Y'>0 S RAOUT=1 Q
124 . S DA=+Y,DIE="^RA(72,",DR="9" D ^DIE
125 . Q
126VRADQ K RAIMGTYI,RAIMGTYJ,RAOUT
127 Q
Note: See TracBrowser for help on using the repository browser.