AQAOPC24.m

AQAOPC24 ; IHS/ORDC/LJF - PRINT OCC BY INDICATOR W/ ICD ;

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

 ;

 ;This rtn contains an entry point called by ^AQAOPC22 to print the

 ;summary page for the trending report by dx and procedure.

 ;

SUMMARY ;ENTRY POINT to print summary page(s)

 ;called by ^AQAOPC22

 I $D(AQAODLM) D HDGDLM I 1

 E  D HDG

 ;

 F I="D","P","V","F" Q:AQAOSTOP=U  D

 .W !!,"Subtotals by ",$S(I="F":"FINDING",I="V":"PROVIDER CODE",I="D":"DIAGNOSIS",1:"PROCEDURE"),": "

 .S AQAOSUB=0 I '$D(AQAOXSN) D SUM1 Q  ;no spec sort

 .F  S AQAOSUB=$O(^TMP("AQAO",$J,I,AQAOSUB)) Q:AQAOSUB=""  Q:AQAOSTOP=U  D

 ..W !!,AQAOSUB,":",! D SUM1

 Q

 ;

SUM1 ; >> SUBRTN to loop thru subtotals

 S AQAOX=0

 F  S AQAOX=$O(^TMP("AQAO",$J,I,AQAOSUB,AQAOX)) Q:AQAOX=""  Q:AQAOSTOP=U  D

 .I $D(AQAODLM) D  Q

 ..W AQAODLM,AQAOX,AQAODLM,^TMP("AQAO",$J,I,AQAOSUB,AQAOX),! ;print counts

 .W ?28,AQAOX,?70,^TMP("AQAO",$J,I,AQAOSUB,AQAOX),! ;print counts

 .I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U  D HDG2

 Q

 ;

 ;

HDG2 ; >> SUBRTN for second half of heading2    

 S X="(SUMMARY PAGE with STATISTICS)" W ?AQAOIOMX-$L(X)/2,X

 W !?AQAOIOMX-$L(AQAORG)/2,AQAORG,!,AQAOLINE,!

 Q

 ;

 ;

HDGDLM ; >> SUBRTN to print summary page(s) in ASCII format

 W !!!,"**SUMMARY DATA**" I AQAODESC]"" W !!,AQAODESC

 S X=^AQAO(2,AQAOIND,0) W !!,$P(X,U),AQAODLM,$P(X,U,2) ;ind # and name

 I $P(X,U,5)]"" W AQAODLM,"THRESHOLD/TRIGGER:  ",$P(X,U,5),"%"

 W !,"TOTAL OCCURRENCES FOR DATE RANGE:",AQAODLM,AQAOCNT

 W AQAODLM,"DENOMINATOR:  ______",AQAODLM,"SOURCE: ___________________"

 Q

 ;

 ;

HDG ;heading for paper prints

 D NEWPG^AQAOUTIL Q:AQAOSTOP=U  D HDG2

 I AQAODESC]"" W !!?AQAOIOMX-$L(AQAODESC)/2,AQAODESC

 S X=^AQAO(2,AQAOIND,0) W !!,$P(X,U),?10,$P(X,U,2) ;ind # and name

 I $P(X,U,5)]"" W ?55,"THRESHOLD/TRIGGER:  ",$P(X,U,5),"%"

 W !,"TOTAL OCCURRENCES FOR DATE RANGE:  ",AQAOCNT

 W !,"                     DENOMINATOR:  ______"

 W "  SOURCE: _____________________________"

 Q

AQAOPC24  ; IHS/ORDC/LJF - PRINT OCC BY INDICATOR W/ ICD ;

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

 +2       ;

 +3       ;This rtn contains an entry point called by ^AQAOPC22 to print the

 +4       ;summary page for the trending report by dx and procedure.

 +5       ;

SUMMARY   ;ENTRY POINT to print summary page(s)

 +1       ;called by ^AQAOPC22

 +2        IF $DATA(AQAODLM)

               DO HDGDLM

               IF 1

 +3       IF '$TEST

               DO HDG

 +4       ;

 +5        FOR I="D","P","V","F"

               IF AQAOSTOP=U

                   QUIT 

               Begin DoDot:1

 +6                WRITE !!,"Subtotals by ",$SELECT(I="F":"FINDING",I="V":"PROVIDER CODE",I="D":"DIAGNOSIS",1:"PROCEDURE"),": "

 +7       ;no spec sort

                   SET AQAOSUB=0

                   IF '$DATA(AQAOXSN)

                       DO SUM1

                       QUIT 

 +8                FOR 

                       SET AQAOSUB=$ORDER(^TMP("AQAO",$JOB,I,AQAOSUB))

                       IF AQAOSUB=""

                           QUIT 

                       IF AQAOSTOP=U

                           QUIT 

                       Begin DoDot:2

 +9                        WRITE !!,AQAOSUB,":",!

                           DO SUM1

                       End DoDot:2

               End DoDot:1

 +10       QUIT 

 +11      ;

SUM1      ; >> SUBRTN to loop thru subtotals

 +1        SET AQAOX=0

 +2        FOR 

               SET AQAOX=$ORDER(^TMP("AQAO",$JOB,I,AQAOSUB,AQAOX))

               IF AQAOX=""

                   QUIT 

               IF AQAOSTOP=U

                   QUIT 

               Begin DoDot:1

 +3                IF $DATA(AQAODLM)

                       Begin DoDot:2

 +4       ;print counts

                           WRITE AQAODLM,AQAOX,AQAODLM,^TMP("AQAO",$JOB,I,AQAOSUB,AQAOX),!

                       End DoDot:2

                       QUIT 

 +5       ;print counts

                   WRITE ?28,AQAOX,?70,^TMP("AQAO",$JOB,I,AQAOSUB,AQAOX),!

 +6                IF $Y>(IOSL-4)

                       DO NEWPG^AQAOUTIL

                       IF AQAOSTOP=U

                           QUIT 

                       DO HDG2

               End DoDot:1

 +7        QUIT 

 +8       ;

 +9       ;

HDG2      ; >> SUBRTN for second half of heading2    

 +1        SET X="(SUMMARY PAGE with STATISTICS)"

           WRITE ?AQAOIOMX-$LENGTH(X)/2,X

 +2        WRITE !?AQAOIOMX-$LENGTH(AQAORG)/2,AQAORG,!,AQAOLINE,!

 +3        QUIT 

 +4       ;

 +5       ;

HDGDLM    ; >> SUBRTN to print summary page(s) in ASCII format

 +1        WRITE !!!,"**SUMMARY DATA**"

           IF AQAODESC]""

               WRITE !!,AQAODESC

 +2       ;ind # and name

           SET X=^AQAO(2,AQAOIND,0)

           WRITE !!,$PIECE(X,U),AQAODLM,$PIECE(X,U,2)

 +3        IF $PIECE(X,U,5)]""

               WRITE AQAODLM,"THRESHOLD/TRIGGER:  ",$PIECE(X,U,5),"%"

 +4        WRITE !,"TOTAL OCCURRENCES FOR DATE RANGE:",AQAODLM,AQAOCNT

 +5        WRITE AQAODLM,"DENOMINATOR:  ______",AQAODLM,"SOURCE: ___________________"

 +6        QUIT 

 +7       ;

 +8       ;

HDG       ;heading for paper prints

 +1        DO NEWPG^AQAOUTIL

           IF AQAOSTOP=U

               QUIT 

           DO HDG2

 +2        IF AQAODESC]""

               WRITE !!?AQAOIOMX-$LENGTH(AQAODESC)/2,AQAODESC

 +3       ;ind # and name

           SET X=^AQAO(2,AQAOIND,0)

           WRITE !!,$PIECE(X,U),?10,$PIECE(X,U,2)

 +4        IF $PIECE(X,U,5)]""

               WRITE ?55,"THRESHOLD/TRIGGER:  ",$PIECE(X,U,5),"%"

 +5        WRITE !,"TOTAL OCCURRENCES FOR DATE RANGE:  ",AQAOCNT

 +6        WRITE !,"                     DENOMINATOR:  ______"

 +7        WRITE "  SOURCE: _____________________________"

 +8        QUIT