AQAOPC73 ; IHS/ORDC/LJF - PRINT SINGLE CRIT RPRT-ASCII ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This routine prints the single criterion report in ASCII format
;using the delimiter the user has chosen.
;
; >> initialize variables
D MONTHS ;set array for all months included in report
;use wide margin if date range has 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="TRENDS BY CRITERIA: "_AQAOCR(X) ;PATCH 3
;S AQAOTY=$E(AQAOTY,1,60) ;PATCH 3
S AQAOTY="TRENDS BY MONTH FOR A CRITERION" ;PATCH 3
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
D DLMHDG^AQAOUTIL,HDG2
I '$D(AQAOCNT) W !,">> NO OCCURRENCES FOUND FOR THIS INDICATOR <<" Q ;PATCH 3
I AQAOTYPE="L" D LIST
D HDG3,COUNTP ;print counts by month
;
;
EXIT ; >>> eoj
W !!,*7,"*** STOP CAPTURE NOW ***"
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),^UTILITY("DIQ1",$J)
K ^TMP("AQAOPC7B",$J) ;PATCH 3
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="" 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="" D
.S AQAOID=0
.F S AQAOID=$O(^TMP("AQAOPC7A",$J,AQAOSUB,AQAODT,AQAOID)) Q:AQAOID="" D
..S X=^TMP("AQAOPC7A",$J,AQAOSUB,AQAODT,AQAOID)
..S Y=AQAODT X ^DD("DD") ;PATCH 3
..S X(",")=" ",Y=$$REPLACE^XLFSTR(Y,.X) ;PATCH 3
..W !,AQAOID,AQAODLM,Y,AQAODLM,$P(X,U) ;PATCH 3
..W AQAODLM,$P(X,U,2),AQAODLM,$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="" D
.W !!,AQAOSUB,! D VALUES
Q
;
VALUES ; >> SUBRTN to print criteria values by month
D MONTHS ;PATCH 3
S AQAOVAL=0
F S AQAOVAL=$O(^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL)) Q:AQAOVAL="" D
.S AQAOSUBT=^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL) ;value subtl
.W !,AQAOVAL
.;
.;fill in counts for all months
.S AQAOMON=0
.F S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON="" D
..W AQAODLM
..I '$D(^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL,AQAOMON)) Q
..S X=^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL,AQAOMON) ;cnt 4 month;PATCH 3
..W X ;PATCH 3
..S AQAOARM(AQAOMON)=AQAOARM(AQAOMON)+X ;increment total
.W AQAODLM,AQAOSUBT
.;
.;fill in percentages for all months for this criterion value
.;W !,AQAODLM,(AQAOSUBT/AQAOCNT*100),"%" ;value as % of total;PATCH 3
.W !,AQAODLM S AQAOMON=0 ;PATCH 3
.F S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON="" D ;PATCH 3
..I '$D(^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL,AQAOMON)) W AQAODLM Q ;PATCH 3
..S X=^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL,AQAOMON) ;PATCH 3
..W $J((X/^TMP("AQAOPC7B",$J,AQAOSUB,AQAOMON)*100),8,2),"%" ;PATCH 3
..W AQAODLM
.W $J((AQAOSUBT/AQAOCNT(AQAOSUB)*100),8,2),"%" ;PATCH 3
;
;print monthly totals for this indicator
W !,AQAOLIN3,!,"Monthly:" S AQAOMON=0
F S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON="" D
.W AQAODLM,AQAOARM(AQAOMON) ;# of occ by month
W AQAODLM,+AQAOCNT(AQAOSUB) ;PATCH 3
; ;print % for each month for ind
;S AQAOMON=0 W ! ;PATCH 3
;F S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON="" D ;PATCH 3
;.W AQAODLM ;PATCH 3
;.W:AQAOCNT>0 (AQAOARM(AQAOMON)/AQAOCNT*100),"%" ;% of occ;PATCH 3
W ! 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 !,AQAORNG,!,AQAOM,!,AQAOLIN2 ;PATCH 3
W !,"Case ID",AQAODLM,"Occ Date",AQAODLM,"Age",AQAODLM
W "Sex",AQAODLM,"Value",!!
Q
;
HDG3 ; >> SUBRTN to print 2nd half of heading for stats section
W !,AQAORNG,!,AQAOM,!!,"Values " ;PATCH 3
S X=0
F S X=$O(AQAOARM(X)) Q:X="" W AQAODLM,1700+$E(X,1,3),"/",$E(X,4,5)
W AQAODLM," Totals",!
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
Q AQAOM
AQAOPC73 ; IHS/ORDC/LJF - PRINT SINGLE CRIT RPRT-ASCII ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This routine prints the single criterion report in ASCII format
+4 ;using the delimiter the user has chosen.
+5 ;
+6 ; >> initialize variables
+7 ;set array for all months included in report
DO MONTHS
+8 ;use wide margin if date range has 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="TRENDS BY CRITERIA: "_AQAOCR(X) ;PATCH 3
+14 ;S AQAOTY=$E(AQAOTY,1,60) ;PATCH 3
+15 ;PATCH 3
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 DO DLMHDG^AQAOUTIL
DO HDG2
+3 ;PATCH 3
IF '$DATA(AQAOCNT)
WRITE !,">> NO OCCURRENCES FOUND FOR THIS INDICATOR <<"
QUIT
+4 IF AQAOTYPE="L"
DO LIST
+5 ;print counts by month
DO HDG3
DO COUNTP
+6 ;
+7 ;
EXIT ; >>> eoj
+1 WRITE !!,*7,"*** STOP CAPTURE NOW ***"
+2 IF IOST["C-"
DO PRTOPT^AQAOVAR
+3 IF $DATA(AQAOIOM)
IF IOT'="HFS"
SET X=AQAOIOM
XECUTE ^%ZOSF("RM")
+4 DO ^%ZISC
DO KILL^AQAOUTIL
+5 KILL ^TMP("AQAOPC7",$JOB),^TMP("AQAOPC7A",$JOB),^UTILITY("DIQ1",$JOB)
+6 ;PATCH 3
KILL ^TMP("AQAOPC7B",$JOB)
+7 QUIT
+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
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
Begin DoDot:1
+3 SET AQAOID=0
+4 FOR
SET AQAOID=$ORDER(^TMP("AQAOPC7A",$JOB,AQAOSUB,AQAODT,AQAOID))
IF AQAOID=""
QUIT
Begin DoDot:2
+5 SET X=^TMP("AQAOPC7A",$JOB,AQAOSUB,AQAODT,AQAOID)
+6 ;PATCH 3
SET Y=AQAODT
XECUTE ^DD("DD")
+7 ;PATCH 3
SET X(",")=" "
SET Y=$$REPLACE^XLFSTR(Y,.X)
+8 ;PATCH 3
WRITE !,AQAOID,AQAODLM,Y,AQAODLM,$PIECE(X,U)
+9 WRITE AQAODLM,$PIECE(X,U,2),AQAODLM,$PIECE(X,U,3)
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
+12 ;
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
Begin DoDot:1
+3 WRITE !!,AQAOSUB,!
DO VALUES
End DoDot:1
+4 QUIT
+5 ;
VALUES ; >> SUBRTN to print criteria values by month
+1 ;PATCH 3
DO MONTHS
+2 SET AQAOVAL=0
+3 FOR
SET AQAOVAL=$ORDER(^TMP("AQAOPC7",$JOB,AQAOSUB,AQAOVAL))
IF AQAOVAL=""
QUIT
Begin DoDot:1
+4 ;value subtl
SET AQAOSUBT=^TMP("AQAOPC7",$JOB,AQAOSUB,AQAOVAL)
+5 WRITE !,AQAOVAL
+6 ;
+7 ;fill in counts for all months
+8 SET AQAOMON=0
+9 FOR
SET AQAOMON=$ORDER(AQAOARM(AQAOMON))
IF AQAOMON=""
QUIT
Begin DoDot:2
+10 WRITE AQAODLM
+11 IF '$DATA(^TMP("AQAOPC7",$JOB,AQAOSUB,AQAOVAL,AQAOMON))
QUIT
+12 ;cnt 4 month;PATCH 3
SET X=^TMP("AQAOPC7",$JOB,AQAOSUB,AQAOVAL,AQAOMON)
+13 ;PATCH 3
WRITE X
+14 ;increment total
SET AQAOARM(AQAOMON)=AQAOARM(AQAOMON)+X
End DoDot:2
+15 WRITE AQAODLM,AQAOSUBT
+16 ;
+17 ;fill in percentages for all months for this criterion value
+18 ;W !,AQAODLM,(AQAOSUBT/AQAOCNT*100),"%" ;value as % of total;PATCH 3
+19 ;PATCH 3
WRITE !,AQAODLM
SET AQAOMON=0
+20 ;PATCH 3
FOR
SET AQAOMON=$ORDER(AQAOARM(AQAOMON))
IF AQAOMON=""
QUIT
Begin DoDot:2
+21 ;PATCH 3
IF '$DATA(^TMP("AQAOPC7",$JOB,AQAOSUB,AQAOVAL,AQAOMON))
WRITE AQAODLM
QUIT
+22 ;PATCH 3
SET X=^TMP("AQAOPC7",$JOB,AQAOSUB,AQAOVAL,AQAOMON)
+23 ;PATCH 3
WRITE $JUSTIFY((X/^TMP("AQAOPC7B",$JOB,AQAOSUB,AQAOMON)*100),8,2),"%"
+24 WRITE AQAODLM
End DoDot:2
+25 ;PATCH 3
WRITE $JUSTIFY((AQAOSUBT/AQAOCNT(AQAOSUB)*100),8,2),"%"
End DoDot:1
+26 ;
+27 ;print monthly totals for this indicator
+28 WRITE !,AQAOLIN3,!,"Monthly:"
SET AQAOMON=0
+29 FOR
SET AQAOMON=$ORDER(AQAOARM(AQAOMON))
IF AQAOMON=""
QUIT
Begin DoDot:1
+30 ;# of occ by month
WRITE AQAODLM,AQAOARM(AQAOMON)
End DoDot:1
+31 ;PATCH 3
WRITE AQAODLM,+AQAOCNT(AQAOSUB)
+32 ; ;print % for each month for ind
+33 ;S AQAOMON=0 W ! ;PATCH 3
+34 ;F S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON="" D ;PATCH 3
+35 ;.W AQAODLM ;PATCH 3
+36 ;.W:AQAOCNT>0 (AQAOARM(AQAOMON)/AQAOCNT*100),"%" ;% of occ;PATCH 3
+37 WRITE !
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 ;PATCH 3
WRITE !,AQAORNG,!,AQAOM,!,AQAOLIN2
+2 WRITE !,"Case ID",AQAODLM,"Occ Date",AQAODLM,"Age",AQAODLM
+3 WRITE "Sex",AQAODLM,"Value",!!
+4 QUIT
+5 ;
HDG3 ; >> SUBRTN to print 2nd half of heading for stats section
+1 ;PATCH 3
WRITE !,AQAORNG,!,AQAOM,!!,"Values "
+2 SET X=0
+3 FOR
SET X=$ORDER(AQAOARM(X))
IF X=""
QUIT
WRITE AQAODLM,1700+$EXTRACT(X,1,3),"/",$EXTRACT(X,4,5)
+4 WRITE AQAODLM," Totals",!
+5 QUIT
+6 ;
+7 ;
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 QUIT AQAOM
