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

AQAOPC72.m

Go to the documentation of this file. 
  1. AQAOPC72 ; IHS/ORDC/LJF - PRINT SINGLE CRIT REPORT ;
  1.  ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
  1.  ;
  1.  ;This routine contains the code to print the report of criterion
  1.  ;values by month for a particular indicator.
  1.  ;
  1.  ; >> initialize variables
  1.  D MONTHS ;set array for all months included in report
  1.  ;use wide margin if date range 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="CRITERION: "_AQAOCR(X)
  1.  ;S AQAOTY=$E(AQAOTY,1,59)
  1.  S AQAOTY="TRENDS BY MONTH FOR A CRITERION"
  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.  I AQAOPAGE=0 D HEADING^AQAOUTIL
  1.  I AQAOTYPE="L" D HDG2
  1.  I '$D(AQAOCNT) D  G EXIT
  1.  .W !?10,">> NO OCCURRENCES FOUND FOR THIS INDICATOR <<"
  1.  I AQAOTYPE="L" D  G EXIT:AQAOSTOP=U D NEWPG^AQAOUTIL G EXIT:AQAOSTOP=U
  1.  .D LIST
  1.  D HDG3,COUNTP ;print counts by month
  1.  ;
  1.  ;
  1. EXIT ; >>> eoj        
  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),^TMP("AQAOPC7B",$J)
  1.  K ^UTILITY("DIQ1",$J)
  1.  Q
  1.  ;
  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=""  Q:AQAOSTOP=U  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=""  Q:AQAOSTOP=U  D
  1.  .S AQAOID=0
  1.  .F  S AQAOID=$O(^TMP("AQAOPC7A",$J,AQAOSUB,AQAODT,AQAOID)) Q:AQAOID=""  Q:AQAOSTOP=U  D
  1.  ..I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U  D HDG2
  1.  ..S X=^TMP("AQAOPC7A",$J,AQAOSUB,AQAODT,AQAOID)
  1.  ..W !,AQAOID S Y=AQAODT X ^DD("DD") W ?10,Y
  1.  ..W ?25,$P(X,U),?35,$P(X,U,2),?45,$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=""  Q:AQAOSTOP=U  D
  1.  .W !!?AQAOIOMX-$L(AQAOSUB)\2,AQAOSUB,! D VALUES
  1.  Q
  1.  ;
  1. VALUES ; >> SUBRTN to print criteria values by month
  1.  D MONTHS ;set array for all months included in report
  1.  S AQAOVAL=0
  1.  F  S AQAOVAL=$O(^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL)) Q:AQAOVAL=""  Q:AQAOSTOP=U  D
  1.  .S AQAOSUBT=^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL) ;value subtl
  1.  .I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U  D HDG3
  1.  .W !!,AQAOVAL,?8
  1.  .;
  1.  .;fill in counts for all months
  1.  .S AQAOMON=0
  1.  .F  S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON=""  Q:AQAOSTOP=U  D
  1.  ..I '$D(^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL,AQAOMON)) D  Q
  1.  ...S X=$X+9 W ?X
  1.  ..S X=^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL,AQAOMON)
  1.  ..W ?($X+1),$J(X,8) ; print count for month
  1.  ..S AQAOARM(AQAOMON)=AQAOARM(AQAOMON)+X ;increment total
  1.  .W ?AQAOIOMX-11,$J(AQAOSUBT,8)
  1.  .I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U  D HDG3
  1.  .;
  1.  .;fill in percentages for all months for this criterion value
  1.  .W !?8 S AQAOMON=0
  1.  .F  S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON=""  Q:AQAOSTOP=U  D
  1.  ..I '$D(^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL,AQAOMON)) D  Q
  1.  ...S X=$X+9 W ?X
  1.  ..S X=^TMP("AQAOPC7",$J,AQAOSUB,AQAOVAL,AQAOMON)
  1.  ..S X=(X/^TMP("AQAOPC7B",$J,AQAOSUB,AQAOMON)*100)_"%"
  1.  ..W ?($X+1),$J(X,8,2) ; print % for month
  1.  .W ?AQAOIOMX-10,$J(AQAOSUBT/AQAOCNT(AQAOSUB)*100,8,2),"%"
  1.  Q:AQAOSTOP=U
  1.  ;
  1.  ;
  1.  ;print monthly totals for this indicator
  1.  I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U  D HDG3
  1.  W !?9,AQAOLIN3,!,"Monthly:" S AQAOMON=0
  1.  F  S AQAOMON=$O(AQAOARM(AQAOMON))  Q:AQAOMON=""  Q:AQAOSTOP=U  D
  1.  .W ?($X+1),$J(AQAOARM(AQAOMON),8) ;# of occ by month
  1.  W ?AQAOIOMX-11,$J(+$G(AQAOCNT(AQAOSUB)),8),! ;PATCH 3
  1.  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 ?AQAOIOMX-$L(AQAORNG)/2,AQAORNG,!
  1.  W ?AQAOIOMX-$L(AQAOM)/2,AQAOM,!,AQAOLIN2,!
  1.  S X=$O(AQAOCR(0)) W ?3,"CRITERION: "_AQAOCR(X)
  1.  W !,"Case ID",?10,"Occ Date",?25,"Age",?35,"Sex",?45,"Value"
  1.  W !,AQAOLINE
  1.  Q
  1.  ;
  1. HDG3 ; >> SUBRTN to print 2nd half of heading for stats pages
  1.  W ?AQAOIOMX-$L(AQAORNG)/2,AQAORNG,!
  1.  W ?AQAOIOMX-$L(AQAOM)/2,AQAOM,!,AQAOLIN2,!
  1.  S X=$O(AQAOCR(0)) W ?3,"CRITERION: "_AQAOCR(X)
  1.  W !,"Values  " S X=0
  1.  F  S X=$O(AQAOARM(X)) Q:X=""  W ?($X+2),$E(X,4,5),"/",1700+$E(X,1,3)
  1.  W ?AQAOIOMX-9," Totals",!,AQAOLINE
  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.  S AQAOM="*** "_AQAOM_" ***"
  1.  Q AQAOM