Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AQAOPC73

AQAOPC73.m

Go to the documentation of this file. 
  1. AQAOPC73 ; IHS/ORDC/LJF - PRINT SINGLE CRIT RPRT-ASCII ;
  1.  ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
  1.  ;
  1.  ;This routine prints the single criterion report in ASCII format
  1.  ;using the delimiter the user has chosen.
  1.  ;
  1.  ; >> initialize variables
  1.  D MONTHS ;set array for all months included in report
  1.  ;use wide margin if date range has more than 7 months
  1.  S AQAOIOMX=80
  1.  I Y>7 S AQAOIOM=IOM,(AQAOIOMX,X)=132 X:IOT'="HFS" ^%ZOSF("RM")
  1.  S AQAOLIN3="",$P(AQAOLIN3,"-",AQAOIOMX-10)=""
  1.  D INIT^AQAOUTIL S AQAOHCON="Patient"
  1.  ;S X=$O(AQAOCR(0)),AQAOTY="TRENDS BY CRITERIA: "_AQAOCR(X) ;PATCH 3
  1.  ;S AQAOTY=$E(AQAOTY,1,60) ;PATCH 3
  1.  S AQAOTY="TRENDS BY MONTH FOR A CRITERION" ;PATCH 3
  1.  S Y=AQAOBD X ^DD("DD") S AQAORNG="("_Y,Y=AQAOED-31 X ^DD("DD")
  1.  S AQAORNG=AQAORNG_" - "_Y_")" ;date range
  1.  ;
  1. LOOP ; >> loop thru ^tmp to get data then print it
  1.  S AQAOM=$$INDNAME ;set indicator heading
  1.  D DLMHDG^AQAOUTIL,HDG2
  1.  I '$D(AQAOCNT) W !,">> NO OCCURRENCES FOUND FOR THIS INDICATOR <<" Q  ;PATCH 3
  1.  I AQAOTYPE="L" D LIST
  1.  D HDG3,COUNTP ;print counts by month
  1.  ;
  1.  ;
  1. EXIT ; >>> eoj        
  1.  W !!,*7,"*** STOP CAPTURE NOW ***"
  1.  I IOST["C-" D PRTOPT^AQAOVAR
  1.  I $D(AQAOIOM),IOT'="HFS" S X=AQAOIOM X ^%ZOSF("RM")
  1.  D ^%ZISC D KILL^AQAOUTIL
  1.  K ^TMP("AQAOPC7",$J),^TMP("AQAOPC7A",$J),^UTILITY("DIQ1",$J)
  1.  K ^TMP("AQAOPC7B",$J) ;PATCH 3
  1.  Q
  1.  ;
  1. LIST ; >> SUBRTN to list occurrences
  1.  S AQAOSUB=0 I '$D(AQAOXSN) D PRINT Q
  1.  F  S AQAOSUB=$O(^TMP("AQAOPC7A",$J,AQAOSUB)) Q:AQAOSUB=""  D
  1.  .W !!?AQAOIOMX-$L(AQAOSUB)\2,AQAOSUB,! D PRINT
  1.  Q
  1.  ;
  1. PRINT ; >> SUBRTN to print each occurrence
  1.  S AQAODT=0
  1.  F  S AQAODT=$O(^TMP("AQAOPC7A",$J,AQAOSUB,AQAODT)) Q:AQAODT=""  D
  1.  .S AQAOID=0
  1.  .F  S AQAOID=$O(^TMP("AQAOPC7A",$J,AQAOSUB,AQAODT,AQAOID)) Q:AQAOID=""  D
  1.  ..S X=^TMP("AQAOPC7A",$J,AQAOSUB,AQAODT,AQAOID)
  1.  ..S Y=AQAODT X ^DD("DD") ;PATCH 3
  1.  ..S X(",")=" ",Y=$$REPLACE^XLFSTR(Y,.X) ;PATCH 3
  1.  ..W !,AQAOID,AQAODLM,Y,AQAODLM,$P(X,U) ;PATCH 3
  1.  ..W AQAODLM,$P(X,U,2),AQAODLM,$P(X,U,3)
  1.  Q
  1.  ;
  1.  ;
  1. COUNTP ; >> SUBRTN to to loop thru extra sort then print line
  1.  S AQAOSUB=0  I '$D(AQAOXSN) D VALUES Q
  1.  F  S AQAOSUB=$O(^TMP("AQAOPC7",$J,AQAOSUB)) Q:AQAOSUB=""  D
  1.  .W !!,AQAOSUB,! D VALUES
  1.  Q
  1.  ;
  1. VALUES ; >> SUBRTN to print criteria values by month
  1.  D MONTHS ;PATCH 3
  1.  S AQAOVAL=0
  1.  F  S AQAOVAL=$O(^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL)) Q:AQAOVAL=""  D
  1.  .S AQAOSUBT=^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL) ;value subtl
  1.  .W !,AQAOVAL
  1.  .;
  1.  .;fill in counts for all months
  1.  .S AQAOMON=0
  1.  .F  S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON=""  D
  1.  ..W AQAODLM
  1.  ..I '$D(^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL,AQAOMON)) Q
  1.  ..S X=^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL,AQAOMON) ;cnt 4 month;PATCH 3
  1.  ..W X ;PATCH 3
  1.  ..S AQAOARM(AQAOMON)=AQAOARM(AQAOMON)+X ;increment total
  1.  .W AQAODLM,AQAOSUBT
  1.  .;
  1.  .;fill in percentages for all months for this criterion value
  1.  .;W !,AQAODLM,(AQAOSUBT/AQAOCNT*100),"%" ;value as % of total;PATCH 3
  1.  .W !,AQAODLM S AQAOMON=0 ;PATCH 3
  1.  .F  S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON=""  D  ;PATCH 3
  1.  ..I '$D(^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL,AQAOMON)) W AQAODLM Q  ;PATCH 3
  1.  ..S X=^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL,AQAOMON) ;PATCH 3
  1.  ..W $J((X/^TMP("AQAOPC7B",$J,AQAOSUB,AQAOMON)*100),8,2),"%" ;PATCH 3
  1.  ..W AQAODLM
  1.  .W $J((AQAOSUBT/AQAOCNT(AQAOSUB)*100),8,2),"%" ;PATCH 3
  1.  ;
  1.  ;print monthly totals for this indicator
  1.  W !,AQAOLIN3,!,"Monthly:" S AQAOMON=0
  1.  F  S AQAOMON=$O(AQAOARM(AQAOMON))  Q:AQAOMON=""  D
  1.  .W AQAODLM,AQAOARM(AQAOMON) ;# of occ by month
  1.  W AQAODLM,+AQAOCNT(AQAOSUB) ;PATCH 3
  1.  ;                                 ;print % for each month for ind
  1.  ;S AQAOMON=0 W ! ;PATCH 3
  1.  ;F  S AQAOMON=$O(AQAOARM(AQAOMON))  Q:AQAOMON=""  D  ;PATCH 3
  1.  ;.W AQAODLM ;PATCH 3
  1.  ;.W:AQAOCNT>0 (AQAOARM(AQAOMON)/AQAOCNT*100),"%" ;% of occ;PATCH 3
  1.  W ! Q
  1.  ;
  1.  ;
  1. MONTHS ; >> SUBRTN to create array for months in report&init their counts
  1.  S X=AQAOBD,Y=0 F  Q:X>AQAOED  D
  1.  .I $E(X,4,5)=13 S X=($E(X,1,3)+1)_"0100"
  1.  .S AQAOARM($E(X,1,5))=0
  1.  .S X=X+100,Y=Y+1
  1.  Q
  1.  ;
  1.  ;
  1. HDG2 ; >> SUBRTN to print 2nd half of heading for listing
  1.  W !,AQAORNG,!,AQAOM,!,AQAOLIN2 ;PATCH 3
  1.  W !,"Case ID",AQAODLM,"Occ Date",AQAODLM,"Age",AQAODLM
  1.  W "Sex",AQAODLM,"Value",!!
  1.  Q
  1.  ;
  1. HDG3 ; >> SUBRTN to print 2nd half of heading for stats section
  1.  W !,AQAORNG,!,AQAOM,!!,"Values  " ;PATCH 3
  1.  S X=0
  1.  F  S X=$O(AQAOARM(X)) Q:X=""  W AQAODLM,1700+$E(X,1,3),"/",$E(X,4,5)
  1.  W AQAODLM," Totals",!
  1.  Q
  1.  ;
  1.  ;
  1. INDNAME()          ;ENTRY POINT EXTR VAR - sets the indicator heading variable
  1.  S AQAOT=^AQAO(2,AQAOIND,0),AQAOM=$P(AQAOT,U)_"-"_$P(AQAOT,U,2)
  1.  S Y=$P(AQAOT,U,3),C=$P(^DD(9002168.2,.03,0),U,2) D Y^DIQ
  1.  S AQAOZ=" ("_Y ;add on process vs. outcome
  1.  S Y=$P(AQAOT,U,4),C=$P(^DD(9002168.2,.04,0),U,2) D Y^DIQ
  1.  S AQAOZ=AQAOZ_"/"_Y ;add on sentinel vs. rate-based
  1.  S Y=$P(AQAOT,U,5) I Y]"" S C=$P(^DD(9002168.2,.05,0),U,2) D Y^DIQ
  1.  S AQAOZ=$S(Y="":AQAOZ_")",1:AQAOZ_"/"_Y_")"),AQAOM=AQAOM_AQAOZ
  1.  Q AQAOM