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