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

AQAOPC12.m

Go to the documentation of this file.
  1. AQAOPC12 ; IHS/ORDC/LJF - PRINT OCC BY INDICATOR W/ CRIT ;
  1. ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
  1. ;
  1. ;This rtn contains the code to print the trending report by review
  1. ;criteria based on the selected indicator and date range.
  1. ;
  1. INIT ; >>> initialize variables
  1. I $D(AQAOIOMX),IOT'="HFS" D
  1. .S X=AQAOIOMX X ^%ZOSF("RM")
  1. .S X="IOPTCH16" D ENDR^%ZISS W IOPTCH16
  1. D INIT^AQAOUTIL S AQAOHCON="Patient"
  1. S AQAOTY="OCCURRENCES BY INDICATOR WITH CRITERIA VALUES"
  1. S AQAORG=$E(AQAOBD,4,5)_"/"_$E(AQAOBD,6,7)_"/"_$E(AQAOBD,2,3)_" to "
  1. S AQAORG=AQAORG_$E(AQAOED,4,5)_"/"_$E(AQAOED,6,7)_"/"_$E(AQAOED,2,3)
  1. ;
  1. ; >>> print report
  1. I AQAOTYP="L" D LISTING
  1. I AQAOSTOP'=U D SUMMARY^AQAOPC13
  1. ;
  1. END ; >>> eoj
  1. I $D(AQAODLM) W !!,*7,"*** STOP CAPTURE NOW ***",!
  1. I $D(AQAOIOMX),IOT'="HFS" S X=IOM X ^%ZOSF("RM")
  1. I $D(IOPTCH16),IOT'="HFS" S X="IOPTCH10" D ENDR^%ZISS W IOPTCH10
  1. D ^%ZISC I AQAOSTOP=U W @IOF
  1. I '$D(ZTQUEUED),AQAOSTOP="" D PRTOPT^AQAOVAR
  1. K ^TMP("AQAOPC1",$J) K ^TMP("AQAOPC11",$J)
  1. K IOPTCH10,IOPTCH16 D KILL^AQAOUTIL Q
  1. ;
  1. ;
  1. LISTING ; >>> SUBRTN to print occurrence listing if selected
  1. Q:'$D(^TMP("AQAOPC1",$J)) ;no entries
  1. I $D(AQAODLM) D DLMHDG I 1 ;ascii file heading
  1. E D HEADING^AQAOUTIL,HDG1 ;printed heading
  1. S AQAOSUB=0 I '$D(AQAOXSN) D LIST2 Q ;straight listing
  1. ; ;extra sort listing
  1. F S AQAOSUB=$O(^TMP("AQAOPC1",$J,AQAOSUB)) Q:AQAOSUB="" Q:AQAOSTOP=U D LIST2
  1. Q
  1. ;
  1. ;
  1. LIST2 ; >> SUBRTN for each AQAOSUB list occ and criteria
  1. I AQAOSUB'=0 W !!?AQAOIOMX-$L(AQAOSUB)/2,AQAOSUB,! ;extra sort headng
  1. S AQAODT=0
  1. F S AQAODT=$O(^TMP("AQAOPC1",$J,AQAOSUB,AQAODT)) Q:AQAODT="" Q:AQAOSTOP=U D
  1. .S AQAON=0
  1. .F S AQAON=$O(^TMP("AQAOPC1",$J,AQAOSUB,AQAODT,AQAON)) Q:AQAON="" Q:AQAOSTOP=U D
  1. ..S AQAOSTR=^TMP("AQAOPC1",$J,AQAOSUB,AQAODT,AQAON)
  1. ..I '$D(AQAODLM),($Y>(IOSL-4)) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG1
  1. ..S Y=AQAODT X ^DD("DD") I $D(AQAODLM) S Y=$P(Y,",")_" "_$P(Y,",",2)
  1. ..I $D(AQAODLM) W !,$P(AQAOSTR,U),AQAODLM,Y ;case & date ASCII format
  1. ..E W !,$P(AQAOSTR,U),?10,$E(Y_" ",1,11) ;print case & date
  1. ..D CRITLOOP ;loop thru criteria and print values
  1. Q
  1. ;
  1. ;
  1. CRITLOOP ; >> SUBRTN to loop thru crit values for occurrence and print
  1. K AQAOCX S (Z,AQAOSV)=1
  1. ;put criteria into print order, then print them
  1. F I=2:2 S X=$P(AQAOSTR,U,I),Y=$P(AQAOSTR,U,I+1) Q:X="" D
  1. .S Y=Y_" ",Y=$E(Y,1,6) ;make sure 6 characters long
  1. LOOPBACK .I $D(AQAOCX(Z,X)) S Z=Z+1 G LOOPBACK ;some may have more than one
  1. .S AQAOCX(Z,X)=Y ;set array=line# (Z) & value (Y)
  1. .S:(Z>AQAOSV) AQAOSV=Z S Z=1 ;update highest line #, reset Z
  1. ;
  1. G CRITPRT:AQAOSV=1 ;one line of data only
  1. S X=0 F S X=$O(AQAOCR(X)) Q:X="" D ;fill in lines #2 and above
  1. .F Z=2:1:AQAOSV I '$D(AQAOCX(Z,X)) S AQAOCX(Z,X)=" "
  1. ;
  1. CRITPRT S Z=0 F S Z=$O(AQAOCX(Z)) Q:Z="" W:Z>1 !?21 D ;print each line
  1. .S X=0 ;print each criterion value
  1. .F S X=$O(AQAOCX(Z,X)) Q:X="" D
  1. ..W $S($D(AQAODLM):AQAODLM,1:" "),AQAOCX(Z,X)
  1. Q
  1. ;
  1. ;
  1. HDG1 ; >> SUBRTN to print second half of heading
  1. S X=$P(^AQAO(2,AQAOIND,0),U)_": "_$P(^(0),U,2) ;indicatr
  1. W ?AQAOIOMX-$L(X)/2,X,!?AQAOIOMX-$L(AQAORG)/2,AQAORG
  1. W !,AQAOLINE,!,"Case #",?11,"Occ Date "
  1. S X=0 F S X=$O(AQAOCR(X)) Q:X="" S Y=" CR"_X_" ",Y=$E(Y,1,8) W Y
  1. Q
  1. ;
  1. ;
  1. DLMHDG ; >> SUBRTN to print second half of heading for ASCII format
  1. W !!!!,"***OCCURRENCE LISTINGS***",!,AQAORG,!
  1. W !,"Printed by ",AQAODUZ," Printed on " S %H=$H D YX^%DTC W Y
  1. W !,"Case #",AQAODLM,"Occ Date "
  1. S X=0 F S X=$O(AQAOCR(X)) Q:X="" W AQAODLM,"CR",X
  1. Q