AQAOCHK4 ; IHS/ORDC/LJF - PRINT TICKLER REPORT ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn is called by ^AQAOCHK2 to print each occurrence with its
;case ID, patient, indicator, ward/service and more.
;PATCH 4: rewrote routine
;
PRINT ;ENTRY POINT >>> print selected range of items
;called by AQAOCHK2
D INIT^AQAOUTIL
S AQAOHCON="Patient",AQAOTY="OCCURRENCE TICKLER REPORT"
D HEADING^AQAOUTIL D HDG1
;
F AQAOI=1:1 S AQAOX=$P(AQAOXYZ(4),",",AQAOI) Q:'AQAOX Q:AQAOSTOP=U D
.I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG1
.W !!,$P($T(MSG+AQAOX),";;",3),":" ;print section heading
.D LOOP
;
I '($D(AQAOXYZ)#2) D MAP
I '$D(ZTQUEUED),IOST["C-" D PRTOPT^AQAOVAR
D END
Q
;
;
LOOP ; -- SUBRTN to loop thru ^TMP to find cases to display
NEW AQAOIND,AQAODT,AQAOIFN
S AQAOIND=0
F S AQAOIND=$O(^TMP("AQAOCHK",$J,AQAOX,AQAOIND)) Q:AQAOIND="" Q:AQAOSTOP=U D
.S AQAODT=0
.F S AQAODT=$O(^TMP("AQAOCHK",$J,AQAOX,AQAOIND,AQAODT)) Q:AQAODT="" Q:AQAOSTOP=U D
..S AQAOIFN=0
..F S AQAOIFN=$O(^TMP("AQAOCHK",$J,AQAOX,AQAOIND,AQAODT,AQAOIFN)) Q:AQAOIFN="" Q:AQAOSTOP=U D
...I $D(AQAOXYZ)#2,((AQAOX=2)!(AQAOX=3)) D ALLREF Q ;prt all referrals
...S AQAOSTR=$G(^TMP("AQAOCHK",$J,AQAOX,AQAOIND,AQAODT,AQAOIFN)) ;PATCH 3
...I AQAOX=5 D PRINTA Q ;action plan item
...Q:AQAOSTR="" ;PATCH 3
...D OCCPRNT
Q
;
OCCPRNT ; -- SUBRTN to print out cases
I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG1
W !,"#",$P(^AQAOC(+AQAOIFN,0),U) ;case id #
I AQAOX<4 W $$OVERDUE^AQAOCHK0 ;print * if overdue for review
S Y=AQAODT X ^DD("DD") W ?10,Y ;occ or review date
S X=$P(^AQAOC(+AQAOIFN,0),U,2)
W:X]"" ?23,$J($P(^AUPNPAT(X,41,DUZ(2),0),U,2),6) ;chart #
W ?32,$P(^AQAO(2,AQAOIND,0),U) ;indicator #
;
I AQAOX=1 D Q ;no other print items for initial reviews
.W:$P(^AQAOC(+AQAOIFN,0),U,11)=1 ?43,"AUTOMATED ENTRY" W ?60
.S X=$P(^AQAOC(+AQAOIFN,0),U,6) I X]"" W $P($G(^SC(X,0)),U,2),"/"
.S X=$P(^AQAOC(+AQAOIFN,0),U,7) I X]"" W $P($G(^DIC(49,X,0)),U,2)
;
I AQAOX=4 D Q ;reviewed, not closed occ
.W ?43,"Last review: ",$E($P(^AQAO(7,$P(AQAOSTR,U,2),0),U),1,4)
.S X=$P(AQAOSTR,U,3) W:X]"" ?62,"Action: ",$P(^AQAO(6,X,0),U,2)
;
;print referred by for aqax=2 or 3
S Y=$P(AQAOSTR,U,2),C=$P(^DD(9002167,.14,0),U,2) D Y^DIQ
W ?43,"Referred by: ",$E(Y,1,23)
S Y=$P(AQAOSTR,U,3),C=$P(^DD(9002167,.19,0),U,2) D Y^DIQ
W !?43,"Referred to: ",$E(Y,1,23)
Q
;
MAP ; -- SUBRTN to print out map to find options
I $Y>(IOSL-9) D NEWPG^AQAOUTIL D HDG1
W !!,">>To find Occurrence Data Entry options, follow this path:"
W !?5,"D for Data Collection Menu;"
W !?10,"ODE for Occurrence Data Entry Menu;"
W !?15,"And then POW for Print Occurrence Worksheets;"
W !?21,"Or OCC for Enter/Edit Occurrence Record;"
W !?21,"Or PRW for Print Review Worksheets;"
W !?21,"Or REV for Enter/Edit Occurrence Review."
Q
;
;
END ;ENTRY POINT called by AQAOCHK1
K ^TMP("AQAOCHK",$J) K AQAOXYZ,AQAOALL,AQAOR1,AQAOR2
D ^%ZISC D KILL^AQAOUTIL
Q
;
;
ALLREF ; >> SUBRTN to print all referrals for qi staff user
NEW AQAON1,AQAON2
S AQAON1=-1
F S AQAON1=$O(^TMP("AQAOCHK",$J,AQAOX,AQAOIND,AQAODT,AQAOIFN,AQAON1)) Q:AQAON1="" Q:AQAOSTOP=U D
. S AQAON2=-1
. F S AQAON2=$O(^TMP("AQAOCHK",$J,AQAOX,AQAOIND,AQAODT,AQAOIFN,AQAON1,AQAON2)) Q:AQAON2="" Q:AQAOSTOP=U D
.. S AQAOSTR=^TMP("AQAOCHK",$J,AQAOX,AQAOIND,AQAODT,AQAOIFN,AQAON1,AQAON2)
.. I AQAOX=2,'$D(AQAOALL),+$P(AQAOSTR,U,3)'=DUZ Q ;only your refrls
.. I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG1
.. W !,"#",$P(^AQAOC(+AQAOIFN,0),U) ;case id #
.. I AQAOX<4 W $$OVERDUE^AQAOCHK0 ;print * if overdue for review
.. S Y=AQAODT X ^DD("DD") W ?10,Y ;occ date
.. S X=$P(^AQAOC(+AQAOIFN,0),U,2)
.. W:X]"" ?23,$J($P(^AUPNPAT(X,41,DUZ(2),0),U,2),6) ;chart #
.. W ?32,$P(^AQAO(2,AQAOIND,0),U) ;indicator #
.. S Y=$P(AQAOSTR,U,2),C=$P(^DD(9002167,.14,0),U,2) D Y^DIQ
.. W ?43,"Referred by: ",$E(Y,1,23)
.. S Y=$P(AQAOSTR,U,3),C=$P(^DD(9002167,.19,0),U,2) D Y^DIQ
.. W !?43,"Referred to: ",$E(Y,1,23)
Q
;
;
PRINTA ; >> SUBRTN to print action plan items
I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG1
W !,"#",$P(^AQAO(5,+AQAOIFN,0),U) ;action plan #
W ?12,"Indicator: ",$P(^AQAO(2,AQAOIND,0),U) ;indicator #
S Y=AQAODT,C=$P(^DD(9002168.5,.05,0),U,2) D Y^DIQ
W ?32,$E(Y,1,25) ;status
S X=$P(^AQAO(5,+AQAOIFN,0),U,2)
W:X]"" ?60,"ACTION TYPE: ",$P(^AQAO(6,X,0),U,2) ;action type
Q
;
;
HDG1 ; >> SUBRTN to print 2nd half of heading
W ?22,"(Occurrences & Action Plans Pending)"
W !?20,"[""*"" after Case ID means overdue for review]",!,AQAOLINE
W !,"Case ID",?10,"Occ/Rev Dt",?23,"Chart #",?32,"Indicator"
W ?43,"Comments",!,AQAOLIN2,!
Q
;
;
MSG ;;
;; Occurrence(s) needing INITIAL REVIEWS;;INITIAL REVIEWS
;; Occurrence(s) with PERSONAL REFERRALS;;PERSONAL REFERRALS
;; Occurrence(s) with REFERRALS TO QI TEAM;;TEAM REFERRALS
;; Occurrence(s) REVIEWED but NOT CLOSED;;OPEN OCCURRENCES
;; Pending ACTION PLAN(S);;ACTION PLANS
AQAOCHK4 ; IHS/ORDC/LJF - PRINT TICKLER REPORT ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn is called by ^AQAOCHK2 to print each occurrence with its
+4 ;case ID, patient, indicator, ward/service and more.
+5 ;PATCH 4: rewrote routine
+6 ;
PRINT ;ENTRY POINT >>> print selected range of items
+1 ;called by AQAOCHK2
+2 DO INIT^AQAOUTIL
+3 SET AQAOHCON="Patient"
SET AQAOTY="OCCURRENCE TICKLER REPORT"
+4 DO HEADING^AQAOUTIL
DO HDG1
+5 ;
+6 FOR AQAOI=1:1
SET AQAOX=$PIECE(AQAOXYZ(4),",",AQAOI)
IF 'AQAOX
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+7 IF $Y>(IOSL-4)
DO NEWPG^AQAOUTIL
IF AQAOSTOP=U
QUIT
DO HDG1
+8 ;print section heading
WRITE !!,$PIECE($TEXT(MSG+AQAOX),";;",3),":"
+9 DO LOOP
End DoDot:1
+10 ;
+11 IF '($DATA(AQAOXYZ)#2)
DO MAP
+12 IF '$DATA(ZTQUEUED)
IF IOST["C-"
DO PRTOPT^AQAOVAR
+13 DO END
+14 QUIT
+15 ;
+16 ;
LOOP ; -- SUBRTN to loop thru ^TMP to find cases to display
+1 NEW AQAOIND,AQAODT,AQAOIFN
+2 SET AQAOIND=0
+3 FOR
SET AQAOIND=$ORDER(^TMP("AQAOCHK",$JOB,AQAOX,AQAOIND))
IF AQAOIND=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+4 SET AQAODT=0
+5 FOR
SET AQAODT=$ORDER(^TMP("AQAOCHK",$JOB,AQAOX,AQAOIND,AQAODT))
IF AQAODT=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:2
+6 SET AQAOIFN=0
+7 FOR
SET AQAOIFN=$ORDER(^TMP("AQAOCHK",$JOB,AQAOX,AQAOIND,AQAODT,AQAOIFN))
IF AQAOIFN=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:3
+8 ;prt all referrals
IF $DATA(AQAOXYZ)#2
IF ((AQAOX=2)!(AQAOX=3))
DO ALLREF
QUIT
+9 ;PATCH 3
SET AQAOSTR=$GET(^TMP("AQAOCHK",$JOB,AQAOX,AQAOIND,AQAODT,AQAOIFN))
+10 ;action plan item
IF AQAOX=5
DO PRINTA
QUIT
+11 ;PATCH 3
IF AQAOSTR=""
QUIT
+12 DO OCCPRNT
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
OCCPRNT ; -- SUBRTN to print out cases
+1 IF $Y>(IOSL-4)
DO NEWPG^AQAOUTIL
IF AQAOSTOP=U
QUIT
DO HDG1
+2 ;case id #
WRITE !,"#",$PIECE(^AQAOC(+AQAOIFN,0),U)
+3 ;print * if overdue for review
IF AQAOX<4
WRITE $$OVERDUE^AQAOCHK0
+4 ;occ or review date
SET Y=AQAODT
XECUTE ^DD("DD")
WRITE ?10,Y
+5 SET X=$PIECE(^AQAOC(+AQAOIFN,0),U,2)
+6 ;chart #
IF X]""
WRITE ?23,$JUSTIFY($PIECE(^AUPNPAT(X,41,DUZ(2),0),U,2),6)
+7 ;indicator #
WRITE ?32,$PIECE(^AQAO(2,AQAOIND,0),U)
+8 ;
+9 ;no other print items for initial reviews
IF AQAOX=1
Begin DoDot:1
+10 IF $PIECE(^AQAOC(+AQAOIFN,0),U,11)=1
WRITE ?43,"AUTOMATED ENTRY"
WRITE ?60
+11 SET X=$PIECE(^AQAOC(+AQAOIFN,0),U,6)
IF X]""
WRITE $PIECE($GET(^SC(X,0)),U,2),"/"
+12 SET X=$PIECE(^AQAOC(+AQAOIFN,0),U,7)
IF X]""
WRITE $PIECE($GET(^DIC(49,X,0)),U,2)
End DoDot:1
QUIT
+13 ;
+14 ;reviewed, not closed occ
IF AQAOX=4
Begin DoDot:1
+15 WRITE ?43,"Last review: ",$EXTRACT($PIECE(^AQAO(7,$PIECE(AQAOSTR,U,2),0),U),1,4)
+16 SET X=$PIECE(AQAOSTR,U,3)
IF X]""
WRITE ?62,"Action: ",$PIECE(^AQAO(6,X,0),U,2)
End DoDot:1
QUIT
+17 ;
+18 ;print referred by for aqax=2 or 3
+19 SET Y=$PIECE(AQAOSTR,U,2)
SET C=$PIECE(^DD(9002167,.14,0),U,2)
DO Y^DIQ
+20 WRITE ?43,"Referred by: ",$EXTRACT(Y,1,23)
+21 SET Y=$PIECE(AQAOSTR,U,3)
SET C=$PIECE(^DD(9002167,.19,0),U,2)
DO Y^DIQ
+22 WRITE !?43,"Referred to: ",$EXTRACT(Y,1,23)
+23 QUIT
+24 ;
MAP ; -- SUBRTN to print out map to find options
+1 IF $Y>(IOSL-9)
DO NEWPG^AQAOUTIL
DO HDG1
+2 WRITE !!,">>To find Occurrence Data Entry options, follow this path:"
+3 WRITE !?5,"D for Data Collection Menu;"
+4 WRITE !?10,"ODE for Occurrence Data Entry Menu;"
+5 WRITE !?15,"And then POW for Print Occurrence Worksheets;"
+6 WRITE !?21,"Or OCC for Enter/Edit Occurrence Record;"
+7 WRITE !?21,"Or PRW for Print Review Worksheets;"
+8 WRITE !?21,"Or REV for Enter/Edit Occurrence Review."
+9 QUIT
+10 ;
+11 ;
END ;ENTRY POINT called by AQAOCHK1
+1 KILL ^TMP("AQAOCHK",$JOB)
KILL AQAOXYZ,AQAOALL,AQAOR1,AQAOR2
+2 DO ^%ZISC
DO KILL^AQAOUTIL
+3 QUIT
+4 ;
+5 ;
ALLREF ; >> SUBRTN to print all referrals for qi staff user
+1 NEW AQAON1,AQAON2
+2 SET AQAON1=-1
+3 FOR
SET AQAON1=$ORDER(^TMP("AQAOCHK",$JOB,AQAOX,AQAOIND,AQAODT,AQAOIFN,AQAON1))
IF AQAON1=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+4 SET AQAON2=-1
+5 FOR
SET AQAON2=$ORDER(^TMP("AQAOCHK",$JOB,AQAOX,AQAOIND,AQAODT,AQAOIFN,AQAON1,AQAON2))
IF AQAON2=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:2
+6 SET AQAOSTR=^TMP("AQAOCHK",$JOB,AQAOX,AQAOIND,AQAODT,AQAOIFN,AQAON1,AQAON2)
+7 ;only your refrls
IF AQAOX=2
IF '$DATA(AQAOALL)
IF +$PIECE(AQAOSTR,U,3)'=DUZ
QUIT
+8 IF $Y>(IOSL-4)
DO NEWPG^AQAOUTIL
IF AQAOSTOP=U
QUIT
DO HDG1
+9 ;case id #
WRITE !,"#",$PIECE(^AQAOC(+AQAOIFN,0),U)
+10 ;print * if overdue for review
IF AQAOX<4
WRITE $$OVERDUE^AQAOCHK0
+11 ;occ date
SET Y=AQAODT
XECUTE ^DD("DD")
WRITE ?10,Y
+12 SET X=$PIECE(^AQAOC(+AQAOIFN,0),U,2)
+13 ;chart #
IF X]""
WRITE ?23,$JUSTIFY($PIECE(^AUPNPAT(X,41,DUZ(2),0),U,2),6)
+14 ;indicator #
WRITE ?32,$PIECE(^AQAO(2,AQAOIND,0),U)
+15 SET Y=$PIECE(AQAOSTR,U,2)
SET C=$PIECE(^DD(9002167,.14,0),U,2)
DO Y^DIQ
+16 WRITE ?43,"Referred by: ",$EXTRACT(Y,1,23)
+17 SET Y=$PIECE(AQAOSTR,U,3)
SET C=$PIECE(^DD(9002167,.19,0),U,2)
DO Y^DIQ
+18 WRITE !?43,"Referred to: ",$EXTRACT(Y,1,23)
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
+21 ;
PRINTA ; >> SUBRTN to print action plan items
+1 IF $Y>(IOSL-4)
DO NEWPG^AQAOUTIL
IF AQAOSTOP=U
QUIT
DO HDG1
+2 ;action plan #
WRITE !,"#",$PIECE(^AQAO(5,+AQAOIFN,0),U)
+3 ;indicator #
WRITE ?12,"Indicator: ",$PIECE(^AQAO(2,AQAOIND,0),U)
+4 SET Y=AQAODT
SET C=$PIECE(^DD(9002168.5,.05,0),U,2)
DO Y^DIQ
+5 ;status
WRITE ?32,$EXTRACT(Y,1,25)
+6 SET X=$PIECE(^AQAO(5,+AQAOIFN,0),U,2)
+7 ;action type
IF X]""
WRITE ?60,"ACTION TYPE: ",$PIECE(^AQAO(6,X,0),U,2)
+8 QUIT
+9 ;
+10 ;
HDG1 ; >> SUBRTN to print 2nd half of heading
+1 WRITE ?22,"(Occurrences & Action Plans Pending)"
+2 WRITE !?20,"[""*"" after Case ID means overdue for review]",!,AQAOLINE
+3 WRITE !,"Case ID",?10,"Occ/Rev Dt",?23,"Chart #",?32,"Indicator"
+4 WRITE ?43,"Comments",!,AQAOLIN2,!
+5 QUIT
+6 ;
+7 ;
MSG ;;
+1 ;; Occurrence(s) needing INITIAL REVIEWS;;INITIAL REVIEWS
+2 ;; Occurrence(s) with PERSONAL REFERRALS;;PERSONAL REFERRALS
+3 ;; Occurrence(s) with REFERRALS TO QI TEAM;;TEAM REFERRALS
+4 ;; Occurrence(s) REVIEWED but NOT CLOSED;;OPEN OCCURRENCES
+5 ;; Pending ACTION PLAN(S);;ACTION PLANS
