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