AQAOPR6 ; IHS/ORDC/LJF - PRINT OCC WORKSHEET ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn contains the user interface and DIP call to print occ
;worksheets based on an indicator. It contains an entry point called
;by the print template to list initial review questions and possible
;answers.
;
INDCTR ; >>> ask user which indicator to print worksheet for
S AQAOIND=$$IND^AQAOLKP G END:AQAOIND=U,INDCTR:AQAOIND=-1
S AQAOIND=+AQAOIND
;
LEVEL ; >>> ask user which review level will be used for inital review
I $P(^AQAO(2,AQAOIND,0),U,4)="R",$P(^(1),U,4)]"",$P(^(1),U,5)]"",$P(^(1),U,6)]"" G PRINT ;don't print review questions for ind with default revw answers
W !! K DIR S DIR(0)="PO^9002168.7:EMZ"
S DIR("A")="Select REVIEW STAGE for the worksheets" D ^DIR
G END:$D(DIRUT),END:Y=-1 S AQAORLEV=Y
;
PRINT ; >>> set print varialbes and call dip
W !! S L=0,DIC="^AQAO(2,",FLDS="[AQAO WORKSHEET]"
S BY="@NUMBER",(FR,TO)=AQAOIND
S DIS(0)="D INDCHK^AQAOSEC I $D(AQAOCHK(""OK""))"
S DIOEND="D:Y'=U REVIEW^AQAOPR6" D EN1^DIP
;
END ; >>> eoj
I '$D(ZTQUEUED),$G(AQAOSTOP)'=U D PRTOPT^AQAOVAR
D KILL^AQAOUTIL Q
;
;
REVIEW ;EP; >>> print review level data
I $P(^AQAO(2,AQAOIND,0),U,4)="R",$P(^(1),U,4)]"",$P(^(1),U,5)]"",$P(^(1),U,6)]"" Q ;don't print review questions for ind with default revw answers
S AQAOLINE="",$P(AQAOLINE,"=",80)=""
S AQAOLIN2="",$P(AQAOLIN2,"_",20)=""
S AQAOSTOP="" D NEWPG Q:AQAOSTOP=U
S X=$P(AQAORLEV,U,2)_" REVIEW QUESTIONS"
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 FIND:(+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
Q: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)
.I $Y>(IOSL-4) D NEWPG
Q: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)
.I $Y>(IOSL-4) D NEWPG
Q: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
;
I $Y>(IOSL-4) D NEWPG Q:AQAOSTOP=U
W !!,"COMMENTS: "
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,!,"QI OCCURRENCE WORKSHEET"
W !,AQAOLINE,!
Q
AQAOPR6 ; IHS/ORDC/LJF - PRINT OCC WORKSHEET ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn contains the user interface and DIP call to print occ
+4 ;worksheets based on an indicator. It contains an entry point called
+5 ;by the print template to list initial review questions and possible
+6 ;answers.
+7 ;
INDCTR ; >>> ask user which indicator to print worksheet for
+1 SET AQAOIND=$$IND^AQAOLKP
IF AQAOIND=U
GOTO END
IF AQAOIND=-1
GOTO INDCTR
+2 SET AQAOIND=+AQAOIND
+3 ;
LEVEL ; >>> ask user which review level will be used for inital review
+1 ;don't print review questions for ind with default revw answers
IF $PIECE(^AQAO(2,AQAOIND,0),U,4)="R"
IF $PIECE(^(1),U,4)]""
IF $PIECE(^(1),U,5)]""
IF $PIECE(^(1),U,6)]""
GOTO PRINT
+2 WRITE !!
KILL DIR
SET DIR(0)="PO^9002168.7:EMZ"
+3 SET DIR("A")="Select REVIEW STAGE for the worksheets"
DO ^DIR
+4 IF $DATA(DIRUT)
GOTO END
IF Y=-1
GOTO END
SET AQAORLEV=Y
+5 ;
PRINT ; >>> set print varialbes and call dip
+1 WRITE !!
SET L=0
SET DIC="^AQAO(2,"
SET FLDS="[AQAO WORKSHEET]"
+2 SET BY="@NUMBER"
SET (FR,TO)=AQAOIND
+3 SET DIS(0)="D INDCHK^AQAOSEC I $D(AQAOCHK(""OK""))"
+4 SET DIOEND="D:Y'=U REVIEW^AQAOPR6"
DO EN1^DIP
+5 ;
END ; >>> eoj
+1 IF '$DATA(ZTQUEUED)
IF $GET(AQAOSTOP)'=U
DO PRTOPT^AQAOVAR
+2 DO KILL^AQAOUTIL
QUIT
+3 ;
+4 ;
REVIEW ;EP; >>> print review level data
+1 ;don't print review questions for ind with default revw answers
IF $PIECE(^AQAO(2,AQAOIND,0),U,4)="R"
IF $PIECE(^(1),U,4)]""
IF $PIECE(^(1),U,5)]""
IF $PIECE(^(1),U,6)]""
QUIT
+2 SET AQAOLINE=""
SET $PIECE(AQAOLINE,"=",80)=""
+3 SET AQAOLIN2=""
SET $PIECE(AQAOLIN2,"_",20)=""
+4 SET AQAOSTOP=""
DO NEWPG
IF AQAOSTOP=U
QUIT
+5 SET X=$PIECE(AQAORLEV,U,2)_" REVIEW QUESTIONS"
+6 WRITE !!?(80-$LENGTH(X))/2,X,!
+7 WRITE !,"REVIEWER/TEAM NAME: "
WRITE AQAOLIN2,?47,"REVIEW DATE: ",AQAOLIN2
+8 ;
RISK ; >>> print all risk of outcomes in file
+1 ;no outcome levels at non-clin review level
IF (+AQAORLEV=1)
GOTO FIND
+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
QUIT
+10 ;
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)
+6 IF $Y>(IOSL-4)
DO NEWPG
End DoDot:1
+7 IF AQAOSTOP=U
QUIT
+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)
+6 IF $Y>(IOSL-4)
DO NEWPG
End DoDot:1
+7 IF AQAOSTOP=U
QUIT
+8 ;
+9 ;preformance levels by provider
+10 WRITE !!,"PERFORMANCE LEVELS BY PROVIDER (Only asked when closing occurrence)",!
+11 SET AQAOX=0
FOR
SET AQAOX=$ORDER(^AQAO1(3,AQAOX))
IF AQAOX'=+AQAOX
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+12 IF '$DATA(^AQAO1(3,AQAOX,0))
QUIT
SET AQAOX1=^(0)
+13 ;inactive/othr scale
IF $PIECE(AQAOX1,U,3)="I"
QUIT
IF $PIECE(AQAOX1,U,6)=""
QUIT
+14 WRITE !?5,$PIECE(AQAOX1,U)," ",$PIECE(AQAOX1,U,6)
+15 IF $Y>(IOSL-4)
DO NEWPG
End DoDot:1
+16 IF AQAOSTOP=U
GOTO END
+17 FOR I=1:1:4
Begin DoDot:1
+18 IF $Y>(IOSL-4)
DO NEWPG
+19 WRITE !,"PROVIDER: _______ LEVEL: _____",!
End DoDot:1
+20 IF AQAOSTOP=U
GOTO END
+21 ;
+1 IF $Y>(IOSL-4)
DO NEWPG
IF AQAOSTOP=U
QUIT
+2 WRITE !!,"COMMENTS: "
+3 QUIT
+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,!,"QI OCCURRENCE WORKSHEET"
+4 WRITE !,AQAOLINE,!
+5 QUIT
