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

AQAOPC51.m

Go to the documentation of this file.
  1. AQAOPC51 ; IHS/ORDC/LJF - CALC FOR QTR PROGRESS RPT ;
  1. ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
  1. ;
  1. ;This rtn counts occ finding/action pairs by month for indicator(s)
  1. ;selected by user. It also finds action plans tied to the indicators.
  1. ;
  1. K ^TMP("AQAOPC5A",$J),^TMP("AQAOPC5B",$J) ;start with clean globals
  1. ;
  1. TMP ; >>> loop thru ^TMP to find indicators
  1. F AQAOI="SINGLE","MED STAFF F","FACILITY WIDE","KEY FUNCTION","OTHER","DIMENSION" D
  1. .S AQAOF=AQAOI
  1. .F S AQAOF=$O(^TMP("AQAOPC5",$J,1,AQAOF)) Q:AQAOF'[AQAOI D
  1. ..S AQAOIND=0
  1. ..F S AQAOIND=$O(^TMP("AQAOPC5",$J,1,AQAOF,AQAOIND)) Q:AQAOIND="" D
  1. ...;
  1. ...; >>for this indicator, find occ for date range
  1. ...S AQAODT=AQAOBD-.001
  1. ...F S AQAODT=$O(^AQAOC("AA",AQAOIND,AQAODT)) Q:AQAODT="" Q:AQAODT>(AQAOED_".24") D
  1. ....S DFN=0
  1. ....F S DFN=$O(^AQAOC("AA",AQAOIND,AQAODT,DFN)) Q:DFN="" D
  1. .....S AQAOIFN=0
  1. .....F S AQAOIFN=$O(^AQAOC("AA",AQAOIND,AQAODT,DFN,AQAOIFN)) Q:AQAOIFN="" D
  1. ......D CHECK ;check occ for validity
  1. ......Q:'$D(AQAOK) ;occ not valid for this report
  1. ......D COUNT ;increment counts
  1. ...;
  1. ...; >>for this indicator, find any action plans linked to it for dates
  1. ...D ACTION ;check if action plan linked for date range
  1. ;
  1. PRINT ; >>> go to print rtn
  1. I $D(AQAODLM) G ^AQAOPC53 ; ASCIIformat
  1. G ^AQAOPC52
  1. ;
  1. ;
  1. ;
  1. CHECK ; >> SUBRTN to check out occurrence
  1. K AQAOK ;occ okay flag
  1. I '$D(^AQAOC(AQAOIFN,0)) Q ;bad xref
  1. Q:'$D(^AQAOC(AQAOIFN,1)) Q:$P(^(1),U)'=1 ;not closed
  1. Q:$$EXCEP^AQAOLKP(AQAOIFN) ;exception to criteria
  1. Q:'$D(^AQAOC(AQAOIFN,"FINAL")) S AQAOS=^("FINAL")
  1. ;Q:$P(AQAOS,U,4)="" Q:$P(AQAOS,U,6)="" ;need final finding & action
  1. S AQAOK="" Q
  1. ;
  1. ;
  1. COUNT ; >> SUBRTN to increment counts of findings, actions by indicator
  1. ;
  1. S X=$P(AQAOS,U,4),AQAOFA=$S(X="":"??",1:$P(^AQAO(8,X,0),U,2)) ;findng
  1. S X=$P(AQAOS,U,6),AQAOAA=$S(X="":"??",1:$P(^AQAO(6,X,0),U,2)) ;action
  1. S AQAOMON=$E(AQAODT,1,5) ;month of occ
  1. ;
  1. ;increment total count for indicator
  1. S ^TMP("AQAOPC5A",$J,AQAOF,AQAOIND)=$G(^TMP("AQAOPC5A",$J,AQAOF,AQAOIND))+1
  1. ;increment count for ind for find&action
  1. S ^TMP("AQAOPC5A",$J,AQAOF,AQAOIND,AQAOFA,AQAOAA)=$G(^TMP("AQAOPC5A",$J,AQAOF,AQAOIND,AQAOFA,AQAOAA))+1
  1. ;increment for find&act&month
  1. S ^TMP("AQAOPC5A",$J,AQAOF,AQAOIND,AQAOFA,AQAOAA,AQAOMON)=$G(^TMP("AQAOPC5A",$J,AQAOF,AQAOIND,AQAOFA,AQAOAA,AQAOMON))+1
  1. Q
  1. ;
  1. ;
  1. ACTION ; >> SUBRTN to find any action plans tied to ind for date range
  1. S AQAOAC=0
  1. F S AQAOAC=$O(^AQAO(5,"C",AQAOIND,AQAOAC)) Q:AQAOAC="" D
  1. .Q:'$D(^AQAO(5,AQAOAC,0)) S AQAOS=^(0)
  1. .Q:$P(AQAOS,U,5)=9 ;deleted action plan
  1. .Q:$P(AQAOS,U,3)<AQAOBD ;implemented before those occurrences
  1. .S ^TMP("AQAOPC5B",$J,AQAOIND,AQAOAC)=""
  1. Q