AQAOPC72 ; IHS/ORDC/LJF - PRINT SINGLE CRIT REPORT ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This routine contains the code to print the report of criterion
;values by month for a particular indicator.
;
; >> initialize variables
D MONTHS ;set array for all months included in report
;use wide margin if date range more than 7 months
S AQAOIOMX=80
I Y>7 S AQAOIOM=IOM,(AQAOIOMX,X)=132 X:IOT'="HFS" ^%ZOSF("RM")
S AQAOLIN3="",$P(AQAOLIN3,"-",AQAOIOMX-10)=""
D INIT^AQAOUTIL S AQAOHCON="Patient"
;S X=$O(AQAOCR(0)),AQAOTY="CRITERION: "_AQAOCR(X)
;S AQAOTY=$E(AQAOTY,1,59)
S AQAOTY="TRENDS BY MONTH FOR A CRITERION"
S Y=AQAOBD X ^DD("DD") S AQAORNG="("_Y,Y=AQAOED-31 X ^DD("DD")
S AQAORNG=AQAORNG_" - "_Y_")" ;date range
;
LOOP ; >> loop thru ^tmp to get data then print it
S AQAOM=$$INDNAME ;set indicator heading
I AQAOPAGE=0 D HEADING^AQAOUTIL
I AQAOTYPE="L" D HDG2
I '$D(AQAOCNT) D G EXIT
.W !?10,">> NO OCCURRENCES FOUND FOR THIS INDICATOR <<"
I AQAOTYPE="L" D G EXIT:AQAOSTOP=U D NEWPG^AQAOUTIL G EXIT:AQAOSTOP=U
.D LIST
D HDG3,COUNTP ;print counts by month
;
;
EXIT ; >>> eoj
I IOST["C-" D PRTOPT^AQAOVAR
I $D(AQAOIOM),IOT'="HFS" S X=AQAOIOM X ^%ZOSF("RM")
D ^%ZISC D KILL^AQAOUTIL
K ^TMP("AQAOPC7",$J),^TMP("AQAOPC7A",$J),^TMP("AQAOPC7B",$J)
K ^UTILITY("DIQ1",$J)
Q
;
;
LIST ; >> SUBRTN to list occurrences
S AQAOSUB=0 I '$D(AQAOXSN) D PRINT Q
F S AQAOSUB=$O(^TMP("AQAOPC7A",$J,AQAOSUB)) Q:AQAOSUB="" Q:AQAOSTOP=U D
.W !!?AQAOIOMX-$L(AQAOSUB)\2,AQAOSUB,! D PRINT
Q
;
PRINT ; >> SUBRTN to print each occurrence
S AQAODT=0
F S AQAODT=$O(^TMP("AQAOPC7A",$J,AQAOSUB,AQAODT)) Q:AQAODT="" Q:AQAOSTOP=U D
.S AQAOID=0
.F S AQAOID=$O(^TMP("AQAOPC7A",$J,AQAOSUB,AQAODT,AQAOID)) Q:AQAOID="" Q:AQAOSTOP=U D
..I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG2
..S X=^TMP("AQAOPC7A",$J,AQAOSUB,AQAODT,AQAOID)
..W !,AQAOID S Y=AQAODT X ^DD("DD") W ?10,Y
..W ?25,$P(X,U),?35,$P(X,U,2),?45,$P(X,U,3)
Q
;
;
COUNTP ; >> SUBRTN to to loop thru extra sort then print line
S AQAOSUB=0 I '$D(AQAOXSN) D VALUES Q
F S AQAOSUB=$O(^TMP("AQAOPC7",$J,AQAOSUB)) Q:AQAOSUB="" Q:AQAOSTOP=U D
.W !!?AQAOIOMX-$L(AQAOSUB)\2,AQAOSUB,! D VALUES
Q
;
VALUES ; >> SUBRTN to print criteria values by month
D MONTHS ;set array for all months included in report
S AQAOVAL=0
F S AQAOVAL=$O(^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL)) Q:AQAOVAL="" Q:AQAOSTOP=U D
.S AQAOSUBT=^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL) ;value subtl
.I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG3
.W !!,AQAOVAL,?8
.;
.;fill in counts for all months
.S AQAOMON=0
.F S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON="" Q:AQAOSTOP=U D
..I '$D(^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL,AQAOMON)) D Q
...S X=$X+9 W ?X
..S X=^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL,AQAOMON)
..W ?($X+1),$J(X,8) ; print count for month
..S AQAOARM(AQAOMON)=AQAOARM(AQAOMON)+X ;increment total
.W ?AQAOIOMX-11,$J(AQAOSUBT,8)
.I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG3
.;
.;fill in percentages for all months for this criterion value
.W !?8 S AQAOMON=0
.F S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON="" Q:AQAOSTOP=U D
..I '$D(^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL,AQAOMON)) D Q
...S X=$X+9 W ?X
..S X=^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL,AQAOMON)
..S X=(X/^TMP("AQAOPC7B",$J,AQAOSUB,AQAOMON)*100)_"%"
..W ?($X+1),$J(X,8,2) ; print % for month
.W ?AQAOIOMX-10,$J(AQAOSUBT/AQAOCNT(AQAOSUB)*100,8,2),"%"
Q:AQAOSTOP=U
;
;
;print monthly totals for this indicator
I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG3
W !?9,AQAOLIN3,!,"Monthly:" S AQAOMON=0
F S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON="" Q:AQAOSTOP=U D
.W ?($X+1),$J(AQAOARM(AQAOMON),8) ;# of occ by month
W ?AQAOIOMX-11,$J(+$G(AQAOCNT(AQAOSUB)),8),! ;PATCH 3
Q
;
;
MONTHS ; >> SUBRTN to create array for months in report&init their counts
S X=AQAOBD,Y=0 F Q:X>AQAOED D
.I $E(X,4,5)=13 S X=($E(X,1,3)+1)_"0100"
.S AQAOARM($E(X,1,5))=0
.S X=X+100,Y=Y+1
Q
;
;
HDG2 ; >> SUBRTN to print 2nd half of heading for listing
W ?AQAOIOMX-$L(AQAORNG)/2,AQAORNG,!
W ?AQAOIOMX-$L(AQAOM)/2,AQAOM,!,AQAOLIN2,!
S X=$O(AQAOCR(0)) W ?3,"CRITERION: "_AQAOCR(X)
W !,"Case ID",?10,"Occ Date",?25,"Age",?35,"Sex",?45,"Value"
W !,AQAOLINE
Q
;
HDG3 ; >> SUBRTN to print 2nd half of heading for stats pages
W ?AQAOIOMX-$L(AQAORNG)/2,AQAORNG,!
W ?AQAOIOMX-$L(AQAOM)/2,AQAOM,!,AQAOLIN2,!
S X=$O(AQAOCR(0)) W ?3,"CRITERION: "_AQAOCR(X)
W !,"Values " S X=0
F S X=$O(AQAOARM(X)) Q:X="" W ?($X+2),$E(X,4,5),"/",1700+$E(X,1,3)
W ?AQAOIOMX-9," Totals",!,AQAOLINE
Q
;
;
INDNAME() ;ENTRY POINT EXTR VAR - sets the indicator heading variable
S AQAOT=^AQAO(2,AQAOIND,0),AQAOM=$P(AQAOT,U)_"-"_$P(AQAOT,U,2)
S Y=$P(AQAOT,U,3),C=$P(^DD(9002168.2,.03,0),U,2) D Y^DIQ
S AQAOZ=" ("_Y ;add on process vs. outcome
S Y=$P(AQAOT,U,4),C=$P(^DD(9002168.2,.04,0),U,2) D Y^DIQ
S AQAOZ=AQAOZ_"/"_Y ;add on sentinel vs. rate-based
S Y=$P(AQAOT,U,5) I Y]"" S C=$P(^DD(9002168.2,.05,0),U,2) D Y^DIQ
S AQAOZ=$S(Y="":AQAOZ_")",1:AQAOZ_"/"_Y_")"),AQAOM=AQAOM_AQAOZ
S AQAOM="*** "_AQAOM_" ***"
Q AQAOM
AQAOPC72 ; IHS/ORDC/LJF - PRINT SINGLE CRIT REPORT ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This routine contains the code to print the report of criterion
+4 ;values by month for a particular indicator.
+5 ;
+6 ; >> initialize variables
+7 ;set array for all months included in report
DO MONTHS
+8 ;use wide margin if date range more than 7 months
+9 SET AQAOIOMX=80
+10 IF Y>7
SET AQAOIOM=IOM
SET (AQAOIOMX,X)=132
IF IOT'="HFS"
XECUTE ^%ZOSF("RM")
+11 SET AQAOLIN3=""
SET $PIECE(AQAOLIN3,"-",AQAOIOMX-10)=""
+12 DO INIT^AQAOUTIL
SET AQAOHCON="Patient"
+13 ;S X=$O(AQAOCR(0)),AQAOTY="CRITERION: "_AQAOCR(X)
+14 ;S AQAOTY=$E(AQAOTY,1,59)
+15 SET AQAOTY="TRENDS BY MONTH FOR A CRITERION"
+16 SET Y=AQAOBD
XECUTE ^DD("DD")
SET AQAORNG="("_Y
SET Y=AQAOED-31
XECUTE ^DD("DD")
+17 ;date range
SET AQAORNG=AQAORNG_" - "_Y_")"
+18 ;
LOOP ; >> loop thru ^tmp to get data then print it
+1 ;set indicator heading
SET AQAOM=$$INDNAME
+2 IF AQAOPAGE=0
DO HEADING^AQAOUTIL
+3 IF AQAOTYPE="L"
DO HDG2
+4 IF '$DATA(AQAOCNT)
Begin DoDot:1
+5 WRITE !?10,">> NO OCCURRENCES FOUND FOR THIS INDICATOR <<"
End DoDot:1
GOTO EXIT
+6 IF AQAOTYPE="L"
Begin DoDot:1
+7 DO LIST
End DoDot:1
IF AQAOSTOP=U
GOTO EXIT
DO NEWPG^AQAOUTIL
IF AQAOSTOP=U
GOTO EXIT
+8 ;print counts by month
DO HDG3
DO COUNTP
+9 ;
+10 ;
EXIT ; >>> eoj
+1 IF IOST["C-"
DO PRTOPT^AQAOVAR
+2 IF $DATA(AQAOIOM)
IF IOT'="HFS"
SET X=AQAOIOM
XECUTE ^%ZOSF("RM")
+3 DO ^%ZISC
DO KILL^AQAOUTIL
+4 KILL ^TMP("AQAOPC7",$JOB),^TMP("AQAOPC7A",$JOB),^TMP("AQAOPC7B",$JOB)
+5 KILL ^UTILITY("DIQ1",$JOB)
+6 QUIT
+7 ;
+8 ;
LIST ; >> SUBRTN to list occurrences
+1 SET AQAOSUB=0
IF '$DATA(AQAOXSN)
DO PRINT
QUIT
+2 FOR
SET AQAOSUB=$ORDER(^TMP("AQAOPC7A",$JOB,AQAOSUB))
IF AQAOSUB=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+3 WRITE !!?AQAOIOMX-$LENGTH(AQAOSUB)\2,AQAOSUB,!
DO PRINT
End DoDot:1
+4 QUIT
+5 ;
PRINT ; >> SUBRTN to print each occurrence
+1 SET AQAODT=0
+2 FOR
SET AQAODT=$ORDER(^TMP("AQAOPC7A",$JOB,AQAOSUB,AQAODT))
IF AQAODT=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+3 SET AQAOID=0
+4 FOR
SET AQAOID=$ORDER(^TMP("AQAOPC7A",$JOB,AQAOSUB,AQAODT,AQAOID))
IF AQAOID=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:2
+5 IF $Y>(IOSL-4)
DO NEWPG^AQAOUTIL
IF AQAOSTOP=U
QUIT
DO HDG2
+6 SET X=^TMP("AQAOPC7A",$JOB,AQAOSUB,AQAODT,AQAOID)
+7 WRITE !,AQAOID
SET Y=AQAODT
XECUTE ^DD("DD")
WRITE ?10,Y
+8 WRITE ?25,$PIECE(X,U),?35,$PIECE(X,U,2),?45,$PIECE(X,U,3)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
+11 ;
COUNTP ; >> SUBRTN to to loop thru extra sort then print line
+1 SET AQAOSUB=0
IF '$DATA(AQAOXSN)
DO VALUES
QUIT
+2 FOR
SET AQAOSUB=$ORDER(^TMP("AQAOPC7",$JOB,AQAOSUB))
IF AQAOSUB=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+3 WRITE !!?AQAOIOMX-$LENGTH(AQAOSUB)\2,AQAOSUB,!
DO VALUES
End DoDot:1
+4 QUIT
+5 ;
VALUES ; >> SUBRTN to print criteria values by month
+1 ;set array for all months included in report
DO MONTHS
+2 SET AQAOVAL=0
+3 FOR
SET AQAOVAL=$ORDER(^TMP("AQAOPC7",$JOB,AQAOSUB,AQAOVAL))
IF AQAOVAL=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+4 ;value subtl
SET AQAOSUBT=^TMP("AQAOPC7",$JOB,AQAOSUB,AQAOVAL)
+5 IF $Y>(IOSL-4)
DO NEWPG^AQAOUTIL
IF AQAOSTOP=U
QUIT
DO HDG3
+6 WRITE !!,AQAOVAL,?8
+7 ;
+8 ;fill in counts for all months
+9 SET AQAOMON=0
+10 FOR
SET AQAOMON=$ORDER(AQAOARM(AQAOMON))
IF AQAOMON=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:2
+11 IF '$DATA(^TMP("AQAOPC7",$JOB,AQAOSUB,AQAOVAL,AQAOMON))
Begin DoDot:3
+12 SET X=$X+9
WRITE ?X
End DoDot:3
QUIT
+13 SET X=^TMP("AQAOPC7",$JOB,AQAOSUB,AQAOVAL,AQAOMON)
+14 ; print count for month
WRITE ?($X+1),$JUSTIFY(X,8)
+15 ;increment total
SET AQAOARM(AQAOMON)=AQAOARM(AQAOMON)+X
End DoDot:2
+16 WRITE ?AQAOIOMX-11,$JUSTIFY(AQAOSUBT,8)
+17 IF $Y>(IOSL-4)
DO NEWPG^AQAOUTIL
IF AQAOSTOP=U
QUIT
DO HDG3
+18 ;
+19 ;fill in percentages for all months for this criterion value
+20 WRITE !?8
SET AQAOMON=0
+21 FOR
SET AQAOMON=$ORDER(AQAOARM(AQAOMON))
IF AQAOMON=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:2
+22 IF '$DATA(^TMP("AQAOPC7",$JOB,AQAOSUB,AQAOVAL,AQAOMON))
Begin DoDot:3
+23 SET X=$X+9
WRITE ?X
End DoDot:3
QUIT
+24 SET X=^TMP("AQAOPC7",$JOB,AQAOSUB,AQAOVAL,AQAOMON)
+25 SET X=(X/^TMP("AQAOPC7B",$JOB,AQAOSUB,AQAOMON)*100)_"%"
+26 ; print % for month
WRITE ?($X+1),$JUSTIFY(X,8,2)
End DoDot:2
+27 WRITE ?AQAOIOMX-10,$JUSTIFY(AQAOSUBT/AQAOCNT(AQAOSUB)*100,8,2),"%"
End DoDot:1
+28 IF AQAOSTOP=U
QUIT
+29 ;
+30 ;
+31 ;print monthly totals for this indicator
+32 IF $Y>(IOSL-4)
DO NEWPG^AQAOUTIL
IF AQAOSTOP=U
QUIT
DO HDG3
+33 WRITE !?9,AQAOLIN3,!,"Monthly:"
SET AQAOMON=0
+34 FOR
SET AQAOMON=$ORDER(AQAOARM(AQAOMON))
IF AQAOMON=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+35 ;# of occ by month
WRITE ?($X+1),$JUSTIFY(AQAOARM(AQAOMON),8)
End DoDot:1
+36 ;PATCH 3
WRITE ?AQAOIOMX-11,$JUSTIFY(+$GET(AQAOCNT(AQAOSUB)),8),!
+37 QUIT
+38 ;
+39 ;
MONTHS ; >> SUBRTN to create array for months in report&init their counts
+1 SET X=AQAOBD
SET Y=0
FOR
IF X>AQAOED
QUIT
Begin DoDot:1
+2 IF $EXTRACT(X,4,5)=13
SET X=($EXTRACT(X,1,3)+1)_"0100"
+3 SET AQAOARM($EXTRACT(X,1,5))=0
+4 SET X=X+100
SET Y=Y+1
End DoDot:1
+5 QUIT
+6 ;
+7 ;
HDG2 ; >> SUBRTN to print 2nd half of heading for listing
+1 WRITE ?AQAOIOMX-$LENGTH(AQAORNG)/2,AQAORNG,!
+2 WRITE ?AQAOIOMX-$LENGTH(AQAOM)/2,AQAOM,!,AQAOLIN2,!
+3 SET X=$ORDER(AQAOCR(0))
WRITE ?3,"CRITERION: "_AQAOCR(X)
+4 WRITE !,"Case ID",?10,"Occ Date",?25,"Age",?35,"Sex",?45,"Value"
+5 WRITE !,AQAOLINE
+6 QUIT
+7 ;
HDG3 ; >> SUBRTN to print 2nd half of heading for stats pages
+1 WRITE ?AQAOIOMX-$LENGTH(AQAORNG)/2,AQAORNG,!
+2 WRITE ?AQAOIOMX-$LENGTH(AQAOM)/2,AQAOM,!,AQAOLIN2,!
+3 SET X=$ORDER(AQAOCR(0))
WRITE ?3,"CRITERION: "_AQAOCR(X)
+4 WRITE !,"Values "
SET X=0
+5 FOR
SET X=$ORDER(AQAOARM(X))
IF X=""
QUIT
WRITE ?($X+2),$EXTRACT(X,4,5),"/",1700+$EXTRACT(X,1,3)
+6 WRITE ?AQAOIOMX-9," Totals",!,AQAOLINE
+7 QUIT
+8 ;
+9 ;
INDNAME() ;ENTRY POINT EXTR VAR - sets the indicator heading variable
+1 SET AQAOT=^AQAO(2,AQAOIND,0)
SET AQAOM=$PIECE(AQAOT,U)_"-"_$PIECE(AQAOT,U,2)
+2 SET Y=$PIECE(AQAOT,U,3)
SET C=$PIECE(^DD(9002168.2,.03,0),U,2)
DO Y^DIQ
+3 ;add on process vs. outcome
SET AQAOZ=" ("_Y
+4 SET Y=$PIECE(AQAOT,U,4)
SET C=$PIECE(^DD(9002168.2,.04,0),U,2)
DO Y^DIQ
+5 ;add on sentinel vs. rate-based
SET AQAOZ=AQAOZ_"/"_Y
+6 SET Y=$PIECE(AQAOT,U,5)
IF Y]""
SET C=$PIECE(^DD(9002168.2,.05,0),U,2)
DO Y^DIQ
+7 SET AQAOZ=$SELECT(Y="":AQAOZ_")",1:AQAOZ_"/"_Y_")")
SET AQAOM=AQAOM_AQAOZ
+8 SET AQAOM="*** "_AQAOM_" ***"
+9 QUIT AQAOM
