- 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
