AQAOPQ1.m

AQAOPQ1 ; IHS/ORDC/LJF - QIK REF-OUTCOME LEVELS ;

 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 ;

 ;This rtn prints the quick reference for outcome levels as defined

 ;by your facility.

 ;

DEV ; >> get print device

 W !! S %ZIS="QP" D ^%ZIS G EXIT:POP

 I '$D(IO("Q")) U IO G LOOP

 K IO("Q") S ZTRTN="LOOP^AQAOPQ1",ZTDESC="QR-OUTCOME LEVELS"

 D ^%ZTLOAD D HOME^%ZIS G EXIT

 ;

 ;

 ;

LOOP ; >> loop thru qi outcome file and set array

 S AQAOX=0

 F  S AQAOX=$O(^AQAO1(3,AQAOX)) Q:AQAOX'=+AQAOX  D

 .S AQAOS=$G(^AQAO1(3,AQAOX,0)) Q:AQAOS=""

 .S X=$P(AQAOS,U)

 .S AQAOAR(1,"POTENTIAL FOR ADVERSE OUTCOME",X)=$P(AQAOS,U,2)

 .S AQAOAR(2,"     OCCURRENCE OUTCOME LEVEL",X)=$P(AQAOS,U,4)

 .S AQAOAR(3,"     ULTIMATE PATIENT OUTCOME",X)=$P(AQAOS,U,5)

 .S AQAOAR(4,"PERFORMANCE LEVEL",X)=$P(AQAOS,U,6)

 ;

INIT ; >>> initialize variables

 I $D(AQAOIOMX),IOT'="HFS" S X=AQAOIOMX X ^%ZOSF("RM")

 D INIT^AQAOUTIL

 S AQAOTY="QUICK REFERENCE - OUTCOME/PERFORMANCE LEVELS"

 D HEADING^AQAOUTIL W !,AQAOLINE,!

 ;

PRINT ;

 S AQAOX=0

 F  S AQAOX=$O(AQAOAR(AQAOX)) Q:AQAOX=""  Q:AQAOSTOP=U  D

 .S AQAOY=0 W !

 .F  S AQAOY=$O(AQAOAR(AQAOX,AQAOY)) Q:AQAOY=""  Q:AQAOSTOP=U  D

 ..S AQAOZ=""

 ..F  S AQAOZ=$O(AQAOAR(AQAOX,AQAOY,AQAOZ)) Q:AQAOZ=""  Q:AQAOSTOP=U  D

 ...I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U  W !,AQAOLINE,!

 ...I AQAOX=4 W !,AQAOY,?20,AQAOZ,"  =  ",AQAOAR(AQAOX,AQAOY,AQAOZ) Q

 ...W !,AQAOY,?35,AQAOZ,"   =   ",AQAOAR(AQAOX,AQAOY,AQAOZ)

 ;

 ;

EXIT ; >> eoj

 I '$D(ZTQUEUED),IOST["C-" D PRTOPT^AQAOVAR

 D ^%ZISC D KILL^AQAOUTIL

 Q

AQAOPQ1   ; IHS/ORDC/LJF - QIK REF-OUTCOME LEVELS ;

 +1       ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 +2       ;

 +3       ;This rtn prints the quick reference for outcome levels as defined

 +4       ;by your facility.

 +5       ;

DEV       ; >> get print device

 +1        WRITE !!

           SET %ZIS="QP"

           DO ^%ZIS

           IF POP

               GOTO EXIT

 +2        IF '$DATA(IO("Q"))

               USE IO

               GOTO LOOP

 +3        KILL IO("Q")

           SET ZTRTN="LOOP^AQAOPQ1"

           SET ZTDESC="QR-OUTCOME LEVELS"

 +4        DO ^%ZTLOAD

           DO HOME^%ZIS

           GOTO EXIT

 +5       ;

 +6       ;

 +7       ;

LOOP      ; >> loop thru qi outcome file and set array

 +1        SET AQAOX=0

 +2        FOR 

               SET AQAOX=$ORDER(^AQAO1(3,AQAOX))

               IF AQAOX'=+AQAOX

                   QUIT 

               Begin DoDot:1

 +3                SET AQAOS=$GET(^AQAO1(3,AQAOX,0))

                   IF AQAOS=""

                       QUIT 

 +4                SET X=$PIECE(AQAOS,U)

 +5                SET AQAOAR(1,"POTENTIAL FOR ADVERSE OUTCOME",X)=$PIECE(AQAOS,U,2)

 +6                SET AQAOAR(2,"     OCCURRENCE OUTCOME LEVEL",X)=$PIECE(AQAOS,U,4)

 +7                SET AQAOAR(3,"     ULTIMATE PATIENT OUTCOME",X)=$PIECE(AQAOS,U,5)

 +8                SET AQAOAR(4,"PERFORMANCE LEVEL",X)=$PIECE(AQAOS,U,6)

               End DoDot:1

 +9       ;

INIT      ; >>> initialize variables

 +1        IF $DATA(AQAOIOMX)

               IF IOT'="HFS"

                   SET X=AQAOIOMX

                   XECUTE ^%ZOSF("RM")

 +2        DO INIT^AQAOUTIL

 +3        SET AQAOTY="QUICK REFERENCE - OUTCOME/PERFORMANCE LEVELS"

 +4        DO HEADING^AQAOUTIL

           WRITE !,AQAOLINE,!

 +5       ;

PRINT     ;

 +1        SET AQAOX=0

 +2        FOR 

               SET AQAOX=$ORDER(AQAOAR(AQAOX))

               IF AQAOX=""

                   QUIT 

               IF AQAOSTOP=U

                   QUIT 

               Begin DoDot:1

 +3                SET AQAOY=0

                   WRITE !

 +4                FOR 

                       SET AQAOY=$ORDER(AQAOAR(AQAOX,AQAOY))

                       IF AQAOY=""

                           QUIT 

                       IF AQAOSTOP=U

                           QUIT 

                       Begin DoDot:2

 +5                        SET AQAOZ=""

 +6                        FOR 

                               SET AQAOZ=$ORDER(AQAOAR(AQAOX,AQAOY,AQAOZ))

                               IF AQAOZ=""

                                   QUIT 

                               IF AQAOSTOP=U

                                   QUIT 

                               Begin DoDot:3

 +7                                IF $Y>(IOSL-4)

                                       DO NEWPG^AQAOUTIL

                                       IF AQAOSTOP=U

                                           QUIT 

                                       WRITE !,AQAOLINE,!

 +8                                IF AQAOX=4

                                       WRITE !,AQAOY,?20,AQAOZ,"  =  ",AQAOAR(AQAOX,AQAOY,AQAOZ)

                                       QUIT 

 +9                                WRITE !,AQAOY,?35,AQAOZ,"   =   ",AQAOAR(AQAOX,AQAOY,AQAOZ)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +10      ;

 +11      ;

EXIT      ; >> eoj

 +1        IF '$DATA(ZTQUEUED)

               IF IOST["C-"

                   DO PRTOPT^AQAOVAR

 +2        DO ^%ZISC

           DO KILL^AQAOUTIL

 +3        QUIT