| 1 | RAUTL19A ;HISC/SWM-Utility Routine ;10/29/97  09:33
 | 
|---|
| 2 |  ;;5.0;Radiology/Nuclear Medicine;**21**;Mar 16, 1998
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 | CKOTHER(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
 | 
|---|