AQAOPR22 ; IHS/ORDC/LJF - PRINT REVIEW WORKSHEET CONT. ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn prints the review worksheet which lists the possible
;answers for an occurrence review based on review level.
;
INIT ; >>> initialize variables
S AQAOLINE="",$P(AQAOLINE,"=",80)=""
S AQAOLIN2="",$P(AQAOLIN2,"_",20)=""
S AQAOSTOP=""
;
HEADING ; >>> print worksheet heading & top section
S IOP=AQAODEV D ^%ZIS U IO
W !,"REVIEW WORKSHEET FOR QAI OCCURRENCE"
S Y=DT X ^DD("DD") W ?60,Y D TIME^AQAOUTIL S AQAOSTR=^AQAOC(AQAOIFN,0)
S AQAONAM=$P($G(^DPT($P(AQAOSTR,U,2),0)),U)
W !,"Case ID: ",AQAOCID W ?40,"Patient: ",$E(AQAONAM,1,20)
S X=$P(AQAOSTR,U,2) W " #",$P(^AUPNPAT(X,41,DUZ(2),0),U,2) ;chart #
W !,"Occurrence Date: " S Y=$P(AQAOSTR,U,4) X ^DD("DD") W Y
W ?40,"Visit Date: "
S (AQAOV,Y)=$P(AQAOSTR,U,3)
I Y]"" S Y=$P(^AUPNVSIT(Y,0),U) X ^DD("DD") W Y
I AQAOV D
.S Y=$P(^AUPNVSIT(AQAOV,0),U,7),C=$P(^DD(9000010,.07,0),U,2) D Y^DIQ
.W "(",$E(Y,1,4),")" ;visit service category
S Y=$P(AQAOSTR,U,7),C=$P(^DD(9002167,.07,0),U,2) D Y^DIQ
W !,"Service/Ward or Clinic: ",$E(Y,1,25),"/"
S Y=$P(AQAOSTR,U,6),C=$P(^DD(9002167,.06,0),U,2) D Y^DIQ W $E(Y,1,25)
W !,"Indicator: "
S Y=$P(AQAOSTR,U,8) I Y]"" W $P(^AQAO(2,Y,0),U),?25,$P(^(0),U,2)
W !,AQAOLINE,!
;
REVIEW ; >>> print review level data
S X="*** "_$P(AQAORLEV,U,2)_" REVIEW ***" W !?(80-$L(X))/2,X,!
W !,"REVIEWER/TEAM NAME: " W AQAOLIN2,?47,"REVIEW DATE: ",AQAOLIN2
;
;
RISK ; >>> print all risk of outcomes in file
G COMMENT:(+AQAORLEV=1) ;no outcome levels at non-clin review level
F AQAOI=2,4,5 D Q:AQAOSTOP=U
.W !!,$S(AQAOI=2:"POTENTIAL OF ADVERSE OUTCOME:",AQAOI=4:"ADVERSE OUTCOME OF OCCURRENCE:",1:"ULTIMATE PATIENT OUTCOME (Only asked when closing occurrence)"),!
.S AQAOX=0 F S AQAOX=$O(^AQAO1(3,AQAOX)) Q:AQAOX'=+AQAOX Q:AQAOSTOP=U D
..Q:'$D(^AQAO1(3,AQAOX,0)) S AQAOX1=^(0)
..Q:$P(AQAOX1,U,3)="I" Q:$P(AQAOX1,U,AQAOI)="" ;inactive/othr scale
..W !?5,"_____ ",$P(AQAOX1,U)," ",$P(AQAOX1,U,AQAOI)
..I $Y>(IOSL-4) D NEWPG
G END:AQAOSTOP=U
;
;preformance levels by provider
W !!,"PERFORMANCE LEVELS BY PROVIDER (Only asked when closing occurrence)",!
S AQAOX=0 F S AQAOX=$O(^AQAO1(3,AQAOX)) Q:AQAOX'=+AQAOX Q:AQAOSTOP=U D
.Q:'$D(^AQAO1(3,AQAOX,0)) S AQAOX1=^(0)
.Q:$P(AQAOX1,U,3)="I" Q:$P(AQAOX1,U,6)="" ;inactive/othr scale
.W !?5,$P(AQAOX1,U)," ",$P(AQAOX1,U,6)
.I $Y>(IOSL-4) D NEWPG
G END:AQAOSTOP=U
F I=1:1:4 D
.I $Y>(IOSL-4) D NEWPG
.W !,"PROVIDER: _______ LEVEL: _____",!
G END:AQAOSTOP=U
;
FIND ; >>> print findings available for this review level
W !!,"FINDING:",!
S AQAOX=0 F S AQAOX=$O(^AQAO(8,AQAOX)) Q:AQAOX'=+AQAOX Q:AQAOSTOP=U D
.Q:'$D(^AQAO(8,AQAOX,0)) S AQAOX1=^(0) Q:$P(AQAOX1,U,4)="I" ;inactiv
.Q:$P(AQAOX1,U,3)'[+AQAORLEV ;not for this review level
.W !?5,"_____ ",$P(AQAOX1,U,2),?20,$P(AQAOX1,U)
.I $Y>(IOSL-4) D NEWPG
G END:AQAOSTOP=U
;
ACTION ; >>> print actions available for this review level
W !!,"ACTION:",!
S AQAOX=0 F S AQAOX=$O(^AQAO(6,AQAOX)) Q:AQAOX'=+AQAOX Q:AQAOSTOP=U D
.Q:'$D(^AQAO(6,AQAOX,0)) S AQAOX1=^(0) Q:$P(AQAOX1,U,5)="I" ;inactiv
.Q:$P(AQAOX1,U,3)'[+AQAORLEV ;not for this review level
.W !?5,"_____ ",$P(AQAOX1,U,2),?20,$P(AQAOX1,U)
.I $Y>(IOSL-4) D NEWPG
G END:AQAOSTOP=U
;
I $Y>(IOSL-4) D NEWPG G END:AQAOSTOP=U
W !,"COMMENTS: "
;
END ; >>> eoj
I '$D(ZTQUEUED),'$D(AQAOSLV) D PRTOPT^AQAOVAR
D ^%ZISC Q
;
;
NEWPG ; >>> SUBRTN for end of page control
I IOST?1"C-".E K DIR S DIR(0)="E" D ^DIR S AQAOSTOP=X
I AQAOSTOP=U Q
W @IOF,!,"Case ID: ",AQAOCID W ?40,"Patient: ",$E(AQAONAM,1,20)
S X=$P(AQAOSTR,U,2) W " #",$P(^AUPNPAT(X,41,DUZ(2),0),U,2) ;chart #
W !,AQAOLINE,!!
Q
AQAOPR22 ; IHS/ORDC/LJF - PRINT REVIEW WORKSHEET CONT. ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn prints the review worksheet which lists the possible
+4 ;answers for an occurrence review based on review level.
+5 ;
INIT ; >>> initialize variables
+1 SET AQAOLINE=""
SET $PIECE(AQAOLINE,"=",80)=""
+2 SET AQAOLIN2=""
SET $PIECE(AQAOLIN2,"_",20)=""
+3 SET AQAOSTOP=""
+4 ;
HEADING ; >>> print worksheet heading & top section
+1 SET IOP=AQAODEV
DO ^%ZIS
USE IO
+2 WRITE !,"REVIEW WORKSHEET FOR QAI OCCURRENCE"
+3 SET Y=DT
XECUTE ^DD("DD")
WRITE ?60,Y
DO TIME^AQAOUTIL
SET AQAOSTR=^AQAOC(AQAOIFN,0)
+4 SET AQAONAM=$PIECE($GET(^DPT($PIECE(AQAOSTR,U,2),0)),U)
+5 WRITE !,"Case ID: ",AQAOCID
WRITE ?40,"Patient: ",$EXTRACT(AQAONAM,1,20)
+6 ;chart #
SET X=$PIECE(AQAOSTR,U,2)
WRITE " #",$PIECE(^AUPNPAT(X,41,DUZ(2),0),U,2)
+7 WRITE !,"Occurrence Date: "
SET Y=$PIECE(AQAOSTR,U,4)
XECUTE ^DD("DD")
WRITE Y
+8 WRITE ?40,"Visit Date: "
+9 SET (AQAOV,Y)=$PIECE(AQAOSTR,U,3)
+10 IF Y]""
SET Y=$PIECE(^AUPNVSIT(Y,0),U)
XECUTE ^DD("DD")
WRITE Y
+11 IF AQAOV
Begin DoDot:1
+12 SET Y=$PIECE(^AUPNVSIT(AQAOV,0),U,7)
SET C=$PIECE(^DD(9000010,.07,0),U,2)
DO Y^DIQ
+13 ;visit service category
WRITE "(",$EXTRACT(Y,1,4),")"
End DoDot:1
+14 SET Y=$PIECE(AQAOSTR,U,7)
SET C=$PIECE(^DD(9002167,.07,0),U,2)
DO Y^DIQ
+15 WRITE !,"Service/Ward or Clinic: ",$EXTRACT(Y,1,25),"/"
+16 SET Y=$PIECE(AQAOSTR,U,6)
SET C=$PIECE(^DD(9002167,.06,0),U,2)
DO Y^DIQ
WRITE $EXTRACT(Y,1,25)
+17 WRITE !,"Indicator: "
+18 SET Y=$PIECE(AQAOSTR,U,8)
IF Y]""
WRITE $PIECE(^AQAO(2,Y,0),U),?25,$PIECE(^(0),U,2)
+19 WRITE !,AQAOLINE,!
+20 ;
REVIEW ; >>> print review level data
+1 SET X="*** "_$PIECE(AQAORLEV,U,2)_" REVIEW ***"
WRITE !?(80-$LENGTH(X))/2,X,!
+2 WRITE !,"REVIEWER/TEAM NAME: "
WRITE AQAOLIN2,?47,"REVIEW DATE: ",AQAOLIN2
+3 ;
+4 ;
RISK ; >>> print all risk of outcomes in file
+1 ;no outcome levels at non-clin review level
IF (+AQAORLEV=1)
GOTO COMMENT
+2 FOR AQAOI=2,4,5
Begin DoDot:1
+3 WRITE !!,$SELECT(AQAOI=2:"POTENTIAL OF ADVERSE OUTCOME:",AQAOI=4:"ADVERSE OUTCOME OF OCCURRENCE:",1:"ULTIMATE PATIENT OUTCOME (Only asked when closing occurrence)"),!
+4 SET AQAOX=0
FOR
SET AQAOX=$ORDER(^AQAO1(3,AQAOX))
IF AQAOX'=+AQAOX
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:2
+5 IF '$DATA(^AQAO1(3,AQAOX,0))
QUIT
SET AQAOX1=^(0)
+6 ;inactive/othr scale
IF $PIECE(AQAOX1,U,3)="I"
QUIT
IF $PIECE(AQAOX1,U,AQAOI)=""
QUIT
+7 WRITE !?5,"_____ ",$PIECE(AQAOX1,U)," ",$PIECE(AQAOX1,U,AQAOI)
+8 IF $Y>(IOSL-4)
DO NEWPG
End DoDot:2
End DoDot:1
IF AQAOSTOP=U
QUIT
+9 IF AQAOSTOP=U
GOTO END
+10 ;
+11 ;preformance levels by provider
+12 WRITE !!,"PERFORMANCE LEVELS BY PROVIDER (Only asked when closing occurrence)",!
+13 SET AQAOX=0
FOR
SET AQAOX=$ORDER(^AQAO1(3,AQAOX))
IF AQAOX'=+AQAOX
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+14 IF '$DATA(^AQAO1(3,AQAOX,0))
QUIT
SET AQAOX1=^(0)
+15 ;inactive/othr scale
IF $PIECE(AQAOX1,U,3)="I"
QUIT
IF $PIECE(AQAOX1,U,6)=""
QUIT
+16 WRITE !?5,$PIECE(AQAOX1,U)," ",$PIECE(AQAOX1,U,6)
+17 IF $Y>(IOSL-4)
DO NEWPG
End DoDot:1
+18 IF AQAOSTOP=U
GOTO END
+19 FOR I=1:1:4
Begin DoDot:1
+20 IF $Y>(IOSL-4)
DO NEWPG
+21 WRITE !,"PROVIDER: _______ LEVEL: _____",!
End DoDot:1
+22 IF AQAOSTOP=U
GOTO END
+23 ;
FIND ; >>> print findings available for this review level
+1 WRITE !!,"FINDING:",!
+2 SET AQAOX=0
FOR
SET AQAOX=$ORDER(^AQAO(8,AQAOX))
IF AQAOX'=+AQAOX
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+3 ;inactiv
IF '$DATA(^AQAO(8,AQAOX,0))
QUIT
SET AQAOX1=^(0)
IF $PIECE(AQAOX1,U,4)="I"
QUIT
+4 ;not for this review level
IF $PIECE(AQAOX1,U,3)'[+AQAORLEV
QUIT
+5 WRITE !?5,"_____ ",$PIECE(AQAOX1,U,2),?20,$PIECE(AQAOX1,U)
+6 IF $Y>(IOSL-4)
DO NEWPG
End DoDot:1
+7 IF AQAOSTOP=U
GOTO END
+8 ;
ACTION ; >>> print actions available for this review level
+1 WRITE !!,"ACTION:",!
+2 SET AQAOX=0
FOR
SET AQAOX=$ORDER(^AQAO(6,AQAOX))
IF AQAOX'=+AQAOX
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+3 ;inactiv
IF '$DATA(^AQAO(6,AQAOX,0))
QUIT
SET AQAOX1=^(0)
IF $PIECE(AQAOX1,U,5)="I"
QUIT
+4 ;not for this review level
IF $PIECE(AQAOX1,U,3)'[+AQAORLEV
QUIT
+5 WRITE !?5,"_____ ",$PIECE(AQAOX1,U,2),?20,$PIECE(AQAOX1,U)
+6 IF $Y>(IOSL-4)
DO NEWPG
End DoDot:1
+7 IF AQAOSTOP=U
GOTO END
+8 ;
+1 IF $Y>(IOSL-4)
DO NEWPG
IF AQAOSTOP=U
GOTO END
+2 WRITE !,"COMMENTS: "
+3 ;
END ; >>> eoj
+1 IF '$DATA(ZTQUEUED)
IF '$DATA(AQAOSLV)
DO PRTOPT^AQAOVAR
+2 DO ^%ZISC
QUIT
+3 ;
+4 ;
NEWPG ; >>> SUBRTN for end of page control
+1 IF IOST?1"C-".E
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET AQAOSTOP=X
+2 IF AQAOSTOP=U
QUIT
+3 WRITE @IOF,!,"Case ID: ",AQAOCID
WRITE ?40,"Patient: ",$EXTRACT(AQAONAM,1,20)
+4 ;chart #
SET X=$PIECE(AQAOSTR,U,2)
WRITE " #",$PIECE(^AUPNPAT(X,41,DUZ(2),0),U,2)
+5 WRITE !,AQAOLINE,!!
+6 QUIT
