AQAOPC41.m

AQAOPC41 ; IHS/ORDC/LJF - CALCULATE OCC WITH FINDINGS ;

 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 ;

 ;This rtn contains the code to find occurrences for the selected

 ;indicator & date range subtotaled by finding and action.

 ;

 K ^TMP("AQAOPC4",$J)

 S AQAOCNT=0 ;initialize total count

DTLOOP ; >>> loop thru occ file by date for indicator

 S AQAODT=AQAOBD-.0001,AQAOEDT=AQAOED_.2400

 F  S AQAODT=$O(^AQAOC("AA",AQAOIND,AQAODT)) Q:AQAODT=""  Q:AQAODT>AQAOEDT  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

 ...Q:'$D(^AQAOC(AQAOIFN,0))  S AQAOSTR=^(1) Q:$P(^(1),U)=2  ;deleted

 ...Q:$P(^AQAOC(AQAOIFN,0),U,9)'=DUZ(2)  ;PATCH 3

 ...Q:$$EXCEP^AQAOLKP(AQAOIFN)

 ...I AQAOSTAT="C" Q:$P(AQAOSTR,U)=0  ;no open cases allowed

 ...I ($P(AQAOSTR,U,5)="")!($P(AQAOSTR,U,6)="") Q  ;not reviewed

 ...I $D(AQAOXSN) Q:$$CHK^AQAOPCX(AQAOXSN)=0  ;spec rev type search

 ...;                                        ;returns AQAOARS array

 ...S AQAOCNT=AQAOCNT+1 ;increment total cases

 ...;

 ...S AQAOSUB=0

 ...I '$D(AQAOXSN) S ^TMP("AQAOPC4",$J,AQAOSUB,AQAODT,AQAOIFN)="" Q

 ...F  S AQAOSUB=$O(AQAOARS(AQAOSUB)) Q:AQAOSUB=""  D

 ....S ^TMP("AQAOPC4",$J,AQAOSUB,AQAODT,AQAOIFN)=""

 ;

NEXT ; >>> go to print rtn

 G ^AQAOPC42

AQAOPC41  ; IHS/ORDC/LJF - CALCULATE OCC WITH FINDINGS ;

 +1       ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 +2       ;

 +3       ;This rtn contains the code to find occurrences for the selected

 +4       ;indicator & date range subtotaled by finding and action.

 +5       ;

 +6        KILL ^TMP("AQAOPC4",$JOB)

 +7       ;initialize total count

           SET AQAOCNT=0

DTLOOP    ; >>> loop thru occ file by date for indicator

 +1        SET AQAODT=AQAOBD-.0001

           SET AQAOEDT=AQAOED_.2400

 +2        FOR 

               SET AQAODT=$ORDER(^AQAOC("AA",AQAOIND,AQAODT))

               IF AQAODT=""

                   QUIT 

               IF AQAODT>AQAOEDT

                   QUIT 

               Begin DoDot:1

 +3                SET DFN=0

 +4                FOR 

                       SET DFN=$ORDER(^AQAOC("AA",AQAOIND,AQAODT,DFN))

                       IF DFN=""

                           QUIT 

                       Begin DoDot:2

 +5                        SET AQAOIFN=0

 +6                        FOR 

                               SET AQAOIFN=$ORDER(^AQAOC("AA",AQAOIND,AQAODT,DFN,AQAOIFN))

                               IF AQAOIFN=""

                                   QUIT 

                               Begin DoDot:3

 +7       ;deleted

                                   IF '$DATA(^AQAOC(AQAOIFN,0))

                                       QUIT 

                                   SET AQAOSTR=^(1)

                                   IF $PIECE(^(1),U)=2

                                       QUIT 

 +8       ;PATCH 3

                                   IF $PIECE(^AQAOC(AQAOIFN,0),U,9)'=DUZ(2)

                                       QUIT 

 +9                                IF $$EXCEP^AQAOLKP(AQAOIFN)

                                       QUIT 

 +10      ;no open cases allowed

                                   IF AQAOSTAT="C"

                                       IF $PIECE(AQAOSTR,U)=0

                                           QUIT 

 +11      ;not reviewed

                                   IF ($PIECE(AQAOSTR,U,5)="")!($PIECE(AQAOSTR,U,6)="")

                                       QUIT 

 +12      ;spec rev type search

                                   IF $DATA(AQAOXSN)

                                       IF $$CHK^AQAOPCX(AQAOXSN)=0

                                           QUIT 

 +13      ;                                        ;returns AQAOARS array

 +14      ;increment total cases

                                   SET AQAOCNT=AQAOCNT+1

 +15      ;

 +16                               SET AQAOSUB=0

 +17                               IF '$DATA(AQAOXSN)

                                       SET ^TMP("AQAOPC4",$JOB,AQAOSUB,AQAODT,AQAOIFN)=""

                                       QUIT 

 +18                               FOR 

                                       SET AQAOSUB=$ORDER(AQAOARS(AQAOSUB))

                                       IF AQAOSUB=""

                                           QUIT 

                                       Begin DoDot:4

 +19                                       SET ^TMP("AQAOPC4",$JOB,AQAOSUB,AQAODT,AQAOIFN)=""

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +20      ;

NEXT      ; >>> go to print rtn

 +1        GOTO ^AQAOPC42