source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAUTL19A.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: 4.8 KB
Line 
1RAUTL19A ;HISC/SWM-Utility Routine ;10/29/97 09:33
2 ;;5.0;Radiology/Nuclear Medicine;**21**;Mar 16, 1998
3 ;
4CKOTHER(A) N E,J,I,RALERT,RAVER,RADETAIL,RAIMPRES,RASTNAM,RANODE,RAER1,RAVER1,RAIMPR1,RATICKET,RAVER2,RAIMPR2,RAPHY
5 ;RAERR is used by RAUTL19 to signal one or more errors
6 ;RAER1 stores 5 pieces of error flags for each imaging type :
7 ; pce 1=1 if more than 1 status has GENERATE EXAM ALERT? set to Y
8 ; pce 2=1 if verfd rpt req'd, but imprsn not req'd at same/lower status
9 ; pce 3=1 if detailed proc not req'd in any status
10 ; pce 4=1 if more than 1 status had PRINT DOSAGE TICKET? set to Y
11 ; pce 5=1 if staff/resident not req'd in any status
12 ; only 1 'print dosage ticket' allowed per imaging type
13 ;
14 S I=0,E="",RAER1="",RALERT=0,RATICKET=0
15 S (RAVER1,RAVER2,RAIMPR1,RAIMPR2,RAPHY)=""
16 F S E=$O(^RA(72,"AA",A,E)) Q:E'=+E D
17 . S I=$O(^RA(72,"AA",A,E,0)) Q:'I
18 . S RASTNAM=$P(^RA(72,I,0),U),RANODE(.1)=$G(^RA(72,I,.1))
19 . S:$$UP^XLFSTR($G(^RA(72,I,"ALERT")))="Y" RALERT=RALERT+1,RALERT(E)=RASTNAM
20 . S:$$UP^XLFSTR($P($G(^RA(72,I,.6)),U,11))="Y" RATICKET=RATICKET+1,RATICKET(E)=RASTNAM
21 . S:$$UP^XLFSTR($P($G(^RA(72,I,.1)),U,3))="Y" RADETAIL(E)=""
22 . S:$$UP^XLFSTR($P($G(^RA(72,I,.1)),U,2))="Y" RAPHY(E)=""
23 . S RAIMPR1(E)=$P($G(^RA(72,I,.1)),U,16) ;actual value
24 . S RAVER1(E)=$P($G(^RA(72,I,.1)),U,12)_U_RASTNAM ; actual value
25 . S:$$UP^XLFSTR($P(RAVER1(E),U))="Y" RAVER2(E)=""
26 . S:$$UP^XLFSTR($P(RAIMPR1(E),U))="Y" RAIMPR2(E)=""
27 . Q
28 S:RALERT>1 $P(RAER1,U)=1 S:RATICKET>1 $P(RAER1,U,4)=1
29 S:$O(RAPHY(E))'>0 $P(RAER1,U,5)=1
30 I $O(RAVER2(0))>0 D
31 . I $O(RAIMPR2(0))>$O(RAVER2(0)) S $P(RAER1,U,2)=1
32 . I $O(RAIMPR2(0))="" S $P(RAER1,U,2)=1
33 . Q
34 S E=""
35 I '$O(RADETAIL(0)) S $P(RAER1,U,3)=1 ; ignore cancelled status
36 Q:RAER1="" S RAERR=1
37 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
38 I $P(RAER1,U)=1 D Q:RAOUT
39 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
40 . W !!,RADASH,"Checking total number of alerts requested",RADASH,!?11,"within : ",A,!
41 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
42 . W !?5,"Statuses requesting '",$P(^DD(72,1,.1),U),"'"
43 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
44 . S I="" F S I=$O(RALERT(I)) Q:I'=+I W !?20,RALERT(I)
45 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
46 . W !!?5,"There should be at most 1 status per imaging type where",!?5,"'",$P(^DD(72,1,.1),U),"' is Y."
47 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
48 I $P(RAER1,U,2)=1 D Q:RAOUT
49 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
50 . W !!,RADASH,"Checking verified report required and impression required",RADASH,!?11,"within : ",A,!
51 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
52 . W !?5,"'",$P(^DD(72,.112,.1),U),"' was set to 'yes'; but",!?5,"'",$P(^DD(72,.116,.1),U),"' was not set to 'yes' at this and lower status(es) :",!
53 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
54 . S E="" W !?27,"Verified Rpt req'd",?53,"Impression Required"
55 . F S E=$O(RAVER1(E)) Q:E'=+E W !?5,$P(RAVER1(E),U,2),?36,$P(RAVER1(E),U),?66,RAIMPR1(E) I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
56 . Q:RAOUT
57 . W !!?5,"If verified report is required at a particular status,",!?5,"then the impression should also be required at the same or lower status."
58 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
59 I $P(RAER1,U,3)=1 D Q:RAOUT
60 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
61 . W !!,RADASH,"Checking presence of detailed procedure required",RADASH,!?11,"within : ",A,!
62 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
63 . W !?5,"None of the statuses requires detailed procedure.",!!?5,"A detailed procedure must be required in at least one status",!?5,"for PCE crediting."
64 I $P(RAER1,U,5)=1 D Q:RAOUT
65 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
66 . W !!,RADASH,"Checking presence of resident or staff required",RADASH,!?11,"within : ",A,!
67 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
68 . W !?5,"None of the statuses requires resident or staff.",!!?5,"Resident or staff must be required in at least one status",!?5,"for PCE crediting."
69 I $P(RAER1,U,4)=1 D Q:RAOUT
70 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
71 . W !!,RADASH,"Checking total number of print dosage ticket requested",RADASH,!?11,"within : ",A,!
72 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
73 . W !?5,"Statuses requesting '",$P(^DD(72,.611,.1),U),"'"
74 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
75 . S I="" F S I=$O(RATICKET(I)) Q:I'=+I W !?20,RATICKET(I)
76 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
77 . W !!?5,"There should be at most 1 status per imaging type, where",!?5,"'",$P(^DD(72,.611,.1),U),"' is Y."
78 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
79 Q
Note: See TracBrowser for help on using the repository browser.