source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RASTREQ.m@ 1590

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

initial load of FOIAVistA 6/30/08 version

File size: 7.5 KB
Line 
1RASTREQ ;HISC/CAH,GJC AISC/MJK-Status Requirements Check Routine ;6/3/98 09:56
2 ;;5.0;Radiology/Nuclear Medicine;**1,10,23,40**;Mar 16, 1998
3 ; Called by
4 ; (1) Stat Track's [RA STATUS CHANGE]'s fld EXAM STATUS' input transform
5 ; (2) ASK+22^RASTED, if user "^" out of stat trk editing
6 ; (3) Cancel an Exam's [RA CANCEL]'s fld EXAM STATUS' input transform
7 ; (4) Enter Last Past Visit Before DHCP's [RA LAST PAST VISIT]'s ""
8 ;
9 ; Instead of using RAIMGTY, recalculate
10 ; the imaging type using the imaging type on the exam node because
11 ; status updating through report entry/edit, batch verify, and several
12 ; other options is NOT screened by sign-on imaging type, so does not
13 ; stay the same through a user's session.
14 ;
15 ; 'RAMES1' is used to display which Exam Status required fields are
16 ; not populated. This only applies to the 'Status Tracking Of Exams'
17 ; option.
18 ;
19 ; If tracking ^-out, this rtn would be called outside of edt tmpl,
20 ; and thus the DA vars would not be defined, so we need to set them here
21 ;
22 S:'$D(DA)#2 DA=RACNI S:'$D(DA(1))#2 DA(1)=RADTI S:'$D(DA(2))#2 DA(2)=RADFN
23 ; If Fileman enter/edit, we need to define RADFN, RADTI, RACNI so the
24 ; nuc med checks won't bomb
25 S:'$D(RACNI)#2 RACNI=DA S:'$D(RADTI)#2 RADTI=DA(1) S:'$D(RADFN)#2 RADFN=DA(2)
26 ;
27 S RAIMGTYI=+$P($G(^RADPT(DA(2),"DT",DA(1),0)),U,2),RAIMGTYJ=$P($G(^RA(79.2,+RAIMGTYI,0)),U,1),RASAVTYJ=RAIMGTYJ
28 S RAMES1="W:$G(K)=$P($G(^RA(72,+$G(RANXT72),0)),U,3)&('$D(ZTQUEUED)#2) !?3,""No '"",RAZ,""'"",?35,"" entered for this exam.""" ; display if at the ranext exm stat level
29 S RAXX=+$G(X)
30 I '$D(^RA(72,RAXX,0))!(RAIMGTYJ']"") D Q
31 . K X W:'$D(ZTQUEUED)#2 !?3,"Error: cannot determine Imaging Type of exam. Contact IRM."
32 . K RAMES1,RAXX
33 . Q
34 N RA,RASN,RASTI,RADES,RAOKAY,RA3
35 ; RADES = order seq. desired, RAOKAY= actual order seq. okay'd
36 S X1=$G(^RA(72,RAXX,0)),RADES=$P(X1,U,3)
37 I $$LKUP^XPDKEY(+$P(X1,"^",4))]"",'$D(^XUSEC($$LKUP^XPDKEY(+$P(X1,"^",4)),DUZ)) K X W:'$D(ZTQUEUED)#2 !?3,"You do not have the proper access privileges to ",!?3,"change this exam to this status" Q
38 S RAJ=^RADPT(DA(2),"DT",DA(1),"P",DA,0),RAOR=-1
39 S RABEFORE=$P($G(^RA(72,+$P(RAJ,U,3),0)),U,3) ; current order seq
40 ; Don't need to set RAORDIFN,RACS,RAPRIT,RAF5
41 I '$D(^RA(72,"AA",RAIMGTYJ,0,RAXX)) D LOOP^RASTREQ1 S RAIMGTYJ=RASAVTYJ
42 I $D(^RA(72,"AA",RAIMGTYJ,0,RAXX)) D CANCEL^RASTREQ1
43 S RAIMGTYJ=RASAVTYJ
44 ; Can't use X to determine if status change to next was successful
45 ; due to looping thru all status levels for this img type
46 ; chk if calculated order is at NEXT or higher level
47 ; RAAFTER is set in rastreq1; it has 2 meanings :
48 ; upon return from rastreq1, RAAFTER means highest seq order qualified
49 ; upon exit from this rtn, RAAFTER means actual seq order used
50 I RABEFORE<RAAFTER D G MSG
51 . I RADES<RAAFTER S RAOKAY=RADES
52 . E S RAOKAY=RAAFTER
53 . Q
54 I RAAFTER<RABEFORE D G MSG
55 . I RADES<RAAFTER S RAOKAY=RADES
56 . E S RAOKAY=RAAFTER
57 . Q
58 ; at this point RAAFTER=RABEFORE
59 I RADES<RAAFTER S RAOKAY=RADES
60 E S RAOKAY=RABEFORE
61MSG I RAOKAY=RABEFORE K X W:'$D(ZTQUEUED)#2 !?5," ...exam status not changed" G KOUT2
62 S X=$O(^RA(72,"AA",RAIMGTYJ,RAOKAY,0))
63 S:$D(RANEXT) RANEXT=^RA(72,+X,0) ;set existing RANEXT to ok'd status
64 I RAOKAY<RABEFORE W:'$D(ZTQUEUED)#2 !?5," ...exam status backed down to '",$P($G(^RA(72,+X,0)),U),"'" G KOUT2
65 I RAOKAY<RADES W:'$D(ZTQUEUED)#2 !!?5," ...though upgraded, new status level (",$P($G(^RA(72,+$O(^RA(72,"AA",RAIMGTYJ,RAOKAY,0)),0)),U),")",!?5,"is not as high as the desired level (",$P($G(^RA(72,+$O(^RA(72,"AA",RAIMGTYJ,RADES,0)),0)),U),")",!
66KOUT1 ; check for higher qualifying status(es)
67 G:RAOKAY'<RAAFTER!(RAOKAY=9) KOUT2 S RA3=RAOKAY
68 W !!,"This case also qualifies for higher status(es) :",!
69 F S RA3=$O(^RA(72,"AA",RAIMGTYJ,RA3)) Q:RA3="" Q:RA3>RAAFTER W:'$D(ZTQUEUED)#2 ?$X+4,$P($G(^RA(72,$O(^(RA3,0)),0)),U)
70 W:'$D(ZTQUEUED)#2 !!,"Since Status Tracking can only upgrade one status at a time,",!,"please edit this exam again.",!
71KOUT2 S RAAFTER=RAOKAY ;return as actual seq order used, not nec. highest
72 K RAIMGTYI,RAIMGTYJ,RAMES1,RAZ,RAXX,RAJ,RAS,RAK,RAE,X1,RASAVTYJ
73 Q
74 ;
751 ;Technologist Check
76 S RA("TECH")="" I $O(^RADPT(DA(2),"DT",DA(1),"P",DA,"TC",0))>0,$D(^VA(200,+^($O(^(0)),0),0)) S RA("TECH")=$P(^(0),"^")
77 I RA("TECH")']"" K X S RAZ="technologist" X:$D(RAMES1) RAMES1
78 K RA("TECH") Q
79 ;
802 ;Interpreting Physician Check
81 I '$D(^VA(200,+$P(RAJ,"^",12),0)),'$D(^VA(200,+$P(RAJ,"^",15),0)) K X S RAZ="interpreting staff or resident" X:$D(RAMES1) RAMES1
82 Q
83 ;
843 ;Detailed Procedure Check
85 S RAZ="detailed procedure" I '$D(^RAMIS(71,+$P(RAJ,"^",2),0)) K X X:$D(RAMES1) RAMES1 Q
86 S RAJ1=$G(^RAMIS(71,+$P(RAJ,"^",2),0)) I "DS"'[$P(RAJ1,"^",6) K X X:$D(RAMES1) RAMES1 Q
87 S RAZ="detailed procedure (no CPT code)" I $P(RAJ1,"^",9)']"" K X X:$D(RAMES1) RAMES1 Q
88 Q
89 ;
904 ;Film Data Check
91 I '$O(^RADPT(DA(2),"DT",DA(1),"P",DA,"F",0)) K X S RAZ="film data" X:$D(RAMES1) RAMES1
92 Q
93 ;
945 ;Diagnostic Code Check
95 I '$D(^RA(78.3,+$P(RAJ,"^",13),0)) K X S RAZ="diagnostic code" X:$D(RAMES1) RAMES1
96 Q
97 ;
986 ;Camera/Equipment/Room Check
99 S RAE=$S($D(RAMDV):$P(RAMDV,"^",9),1:1) I RAE,'$D(^RA(78.6,+$P(RAJ,"^",18),0)) K X S RAZ="camera/equip/room" X:$D(RAMES1) RAMES1
100 Q
101 ;
10211 ;Report Entered and not just a stub rec for Img/PACS Check
103 I '$D(^RARPT(+$P(RAJ,"^",17),0)) G NORPT
104 ; since there's a rpt ptr, must check if the rpt is just a stub rpt
105 N RA17,RA0 ; use logic from RAREG
106 S RA17=+$P(RAJ,"^",17)
107 I $$STUB^RAEDCN1(RA17) G NORPT ; rpt is an image stub
108 Q
109NORPT ; either no report yet, or report is stub
110 K X S RAZ="report" X:$D(RAMES1) RAMES1
111 Q
112 ;
11312 ;Report Verified Check
114 D 11:$P(RAS,"^",11)'="Y" I $D(^RARPT(+$P(RAJ,"^",17),0)),$P(^(0),"^",5)'="V" K X S RAZ="report verification" X:$D(RAMES1) RAMES1
115 Q
116 ;
11716 ;Impression Entry Check
118 I $O(^RARPT(+$P(RAJ,"^",17),"I",0))'>0 K X S RAZ="impression" X:$D(RAMES1) RAMES1
119 Q
12013 ;Procedure Modifers Check
121 I '$O(^RADPT(DA(2),"DT",DA(1),"P",DA,"M",0)) K X S RAX="procedure modifier" X:$D(RAMES1) RAMES1
122 Q
12314 ;CPT Modifiers Check
124 I '$O(^RADPT(DA(2),"DT",DA(1),"P",DA,"CMOD",0)) K X S RAZ="CPT modifiers" X:$D(RAMES1) RAMES1
125 Q
126 ;
127HELP ; Called from 'Help Text' node in DD(70.03,3,4).
128 N E,RA
129 S RAJ=$G(^RADPT(DA(2),"DT",DA(1),"P",DA,0))
130 S RAIMGTYI=+$P($G(^RADPT(DA(2),"DT",DA(1),0)),U,2),RAIMGTYJ=$P($G(^RA(79.2,+RAIMGTYI,0)),U,1)
131 I RAIMGTYJ']"" W !,"ERROR: Cannot determine imaging type of exam!" K FL,K,N,RAIMGTYI,RAIMGTYJ,RAS,RAJ Q
132 W !,"This exam meets the requirements for the following statuses:"
133 F K=0:0 S K=$O(^RA(72,"AA",RAIMGTYJ,K)) Q:K'>0 D
134 . S X="",E=+$O(^RA(72,"AA",RAIMGTYJ,K,0)) Q:E'>0
135 . I $D(^RA(72,E,0)) D
136 .. S RA(0)=$G(^RA(72,E,0)),N=$P(RA(0),U),RAS=$G(^RA(72,E,.1))
137 .. I $L(RAS) D HELP1 D:$D(X)&($P(RAS,"^",3)'="Y")&($D(^RA(72,"AA",RAIMGTYJ,9,E))) 3 I $D(X) W !?10,N S FL=""
138 .. Q
139 . Q
140 W:'$D(FL) !?10,"Does not meet the requirements of any status."
141 W ! K RAS,RAJ,N,K,FL,RAIMGTYI,RAIMGTYJ
142 Q
143HELP1 ; Called from 'HELP' above and 'STUFF^RASTREQ1'
144 ; 'RAJ' -> 0 node of the examination
145 ; 'E' -> ien of the examination status
146 ; Both 'RAJ' & 'E' set in 'HELP' & 'STUFF^RASTREQ1'
147 N RADIO,RADIOUZD S RADIO=$S($G(^RA(72,E,.5))]"":$G(^(.5)),1:"N")
148 S:$P($G(^RA(79.2,+RAIMGTYI,0)),"^",5)="Y" RADIOUZD=""
149 F RAK=1:1 Q:$P(RAS,"^",RAK,99)']"" D:$P(RAS,"^",RAK)="Y" @RAK
150 I $D(X),$P(RAS,"^",3)'="Y",$D(^RA(72,"AA",RAIMGTYJ,9,E)) D 3
151 I $D(X),$P(RAS,"^",16)'="Y",$D(^RA(72,"AA",RAIMGTYJ,9,E)),$D(^RA(79,+$P(^RADPT(DA(2),"DT",DA(1),0),"^",3),.1)),$P(^(.1),"^",16)="Y" D 16
152 I $D(RADIOUZD),($D(X)) D
153 . D EN1^RASTREQN(RADIO,RAJ)
154 . I $D(X),($$UP^XLFSTR($P($G(^RA(72,E,.6)),"^",11)="Y")) D EN1^RADOSTIK(RADFN,RADTI,RACNI)
155 . Q
156 Q
Note: See TracBrowser for help on using the repository browser.