Routine: APCPDRI3

APCPDRI3 ; IHS/TUCSON/LAB - initialization part III AUGUST 14, 1992 ; [ 04/07/99 7:47 AM ]

 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1**;APR 03, 1998

INFORM ;EP - INFORM OPERATOR WHAT IS GOING TO HAPPEN

 Q:$D(ZTQUEUED)

 W !!,"This routine will generate the following transaction types:"

 ;W:$D(APCPS("APC")) !?15,"APC - AMBULATORY SYSTEM " ;IHS/CMI/LAB - per hdqrts west NO  APC records

 ;W:$D(APCPS("INPT")) !?15,"INPATIENT - DIRECT INPATIENT" ;IHS/CMI/LAB - per hdqtrs west NO inpatient txs

 ;W:$D(APCPS("CHA")) !?15,"CHA - COMMUNITY HEALTH ACTIVITY" ;per hdqtrs west, NO CHA transactions

 W !?15,"STATISTICAL DATABASE RECORDS" ;IHS/CMI/LAB - stat recs only per hdqtrs west

 W !,"for visits posted between a specified range of dates.  You may ""^"" out at any",!,"prompt and will be ask to confirm your entries prior to generating transactions."

CURRUN ;EP - COMPUTE DATES FOR CURRENT RUN

 S APCP("RUN BEGIN")=""

 I APCP("LAST LOG") S X1=$P(^APCPLOG(APCP("LAST LOG"),0),U,2),X2=1 D C^%DTC S APCP("RUN BEGIN")=X,Y=X D DD^%DT

 I APCP("RUN BEGIN")="" D FIRSTRUN

 Q:APCP("QFLG")

 S X1=DT,X2=$P(^APCPSITE(1,0),U,3)*-1 D C^%DTC S Y=X

 I Y<APCP("RUN BEGIN") W:'$D(ZTQUEUED) !!,"  Ending date cannot be before beginning date!",$C(7) S APCP("QFLG")=18 Q

 S APCP("RUN END")=Y

 S Y=APCP("RUN BEGIN") X ^DD("DD") S APCP("X")=Y

 S Y=APCP("RUN END") X ^DD("DD") S APCP("Y")=Y

 W:'$D(ZTQUEUED) !!,"The inclusive dates for this run are ",APCP("X")," through ",APCP("Y"),"."

 K %,%H,%I,APCP("RDFN"),APCP("X"),APCP("Y"),APCP("LAST LOG"),APCP("LAST BEGIN"),APCP("Z"),APCP("DATE")

FIRSTRUN ; FIRST RUN EVER (NO LOG ENTRY)

 I $D(ZTQUEUED),$D(APCPO("SCHEDULED")) S APCP("QFLG")=12 Q

 W !!,"No log entry.  First run ever assumed.",!

FRLP  ;

 S DIR(0)="D^:"_DT_":EP",DIR("A")="Enter Beginning Date for this run" K DA D ^DIR K DIR

 I $D(DIRUT)!(Y="") S APCP("QFLG")=99 Q

 S APCP("RUN BEGIN")=Y

 S APCP("FIRST RUN")=1

ERRBULL ;ENTRY POINT - ERROR BULLETIN

 S APCP("QFLG1")=$O(^APCPERRC("B",APCP("QFLG"),"")),APCP("QFLG DES")=$P(^APCPERRC(APCP("QFLG1"),0),U,2)

 S XMB(2)=APCP("QFLG"),XMB(3)=APCP("QFLG DES")

 S XMB(4)=$S($D(APCP("RUN LOG")):APCP("RUN LOG"),1:"< NONE >")

 I '$D(APCP("RUN BEGIN")) S XMB(5)="<UNKNOWN>" G ERRBULL1

 S Y=APCP("RUN BEGIN") D DD^%DT S XMB(5)=Y

ERRBULL1 S Y=DT D DD^%DT S XMB(1)=Y,XMB="APCP PCC TRANSMISSION ERROR"

 S XMDUZ=.5 D ^XMB

 K XMB,XM1,XMA,XMDT,XMM,APCP("QFLG1"),APCP("QFLG DES"),XMDUZ

APCPDRI3  ; IHS/TUCSON/LAB - initialization part III AUGUST 14, 1992 ; [ 04/07/99 7:47 AM ]

 +1       ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1**;APR 03, 1998

INFORM    ;EP - INFORM OPERATOR WHAT IS GOING TO HAPPEN

 +1        IF $DATA(ZTQUEUED)

               QUIT

 +2        WRITE !!,"This routine will generate the following transaction types:"

 +3       ;W:$D(APCPS("APC")) !?15,"APC - AMBULATORY SYSTEM " ;IHS/CMI/LAB - per hdqrts west NO  APC records

 +4       ;W:$D(APCPS("INPT")) !?15,"INPATIENT - DIRECT INPATIENT" ;IHS/CMI/LAB - per hdqtrs west NO inpatient txs

 +5       ;W:$D(APCPS("CHA")) !?15,"CHA - COMMUNITY HEALTH ACTIVITY" ;per hdqtrs west, NO CHA transactions

 +6       ;IHS/CMI/LAB - stat recs only per hdqtrs west

           WRITE !?15,"STATISTICAL DATABASE RECORDS"

 +7        WRITE !,"for visits posted between a specified range of dates.  You may ""^"" out at any",!,"prompt and will be ask to confirm your entries prior to generating transactions."

 +8        QUIT

 +9       ;

CURRUN    ;EP - COMPUTE DATES FOR CURRENT RUN

 +1        SET APCP("RUN BEGIN")=""

 +2        IF APCP("LAST LOG")

               SET X1=$PIECE(^APCPLOG(APCP("LAST LOG"),0),U,2)

               SET X2=1

               DO C^%DTC

               SET APCP("RUN BEGIN")=X

               SET Y=X

               DO DD^%DT

 +3        IF APCP("RUN BEGIN")=""

               DO FIRSTRUN

 +4        IF APCP("QFLG")

               QUIT

 +5        SET X1=DT

           SET X2=$PIECE(^APCPSITE(1,0),U,3)*-1

           DO C^%DTC

           SET Y=X

 +6        IF Y<APCP("RUN BEGIN")

               IF '$DATA(ZTQUEUED)

                   WRITE !!,"  Ending date cannot be before beginning date!",$CHAR(7)

               SET APCP("QFLG")=18

               QUIT

 +7        SET APCP("RUN END")=Y

 +8        SET Y=APCP("RUN BEGIN")

           XECUTE ^DD("DD")

           SET APCP("X")=Y

 +9        SET Y=APCP("RUN END")

           XECUTE ^DD("DD")

           SET APCP("Y")=Y

 +10       IF '$DATA(ZTQUEUED)

               WRITE !!,"The inclusive dates for this run are ",APCP("X")," through ",APCP("Y"),"."

 +11       KILL %,%H,%I,APCP("RDFN"),APCP("X"),APCP("Y"),APCP("LAST LOG"),APCP("LAST BEGIN"),APCP("Z"),APCP("DATE")

 +12       QUIT

 +13      ;

FIRSTRUN  ; FIRST RUN EVER (NO LOG ENTRY)

 +1        IF $DATA(ZTQUEUED)

               IF $DATA(APCPO("SCHEDULED"))

                   SET APCP("QFLG")=12

                   QUIT

 +2        WRITE !!,"No log entry.  First run ever assumed.",!

FRLP      ;

 +1        SET DIR(0)="D^:"_DT_":EP"

           SET DIR("A")="Enter Beginning Date for this run"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)!(Y="")

               SET APCP("QFLG")=99

               QUIT

 +3        SET APCP("RUN BEGIN")=Y

 +4        SET APCP("FIRST RUN")=1

 +5        QUIT

 +6       ;

 +7       ;

ERRBULL   ;ENTRY POINT - ERROR BULLETIN

 +1        SET APCP("QFLG1")=$ORDER(^APCPERRC("B",APCP("QFLG"),""))

           SET APCP("QFLG DES")=$PIECE(^APCPERRC(APCP("QFLG1"),0),U,2)

 +2        SET XMB(2)=APCP("QFLG")

           SET XMB(3)=APCP("QFLG DES")

 +3        SET XMB(4)=$SELECT($DATA(APCP("RUN LOG")):APCP("RUN LOG"),1:"< NONE >")

 +4        IF '$DATA(APCP("RUN BEGIN"))

               SET XMB(5)="<UNKNOWN>"

               GOTO ERRBULL1

 +5        SET Y=APCP("RUN BEGIN")

           DO DD^%DT

           SET XMB(5)=Y

ERRBULL1   SET Y=DT

           DO DD^%DT

           SET XMB(1)=Y

           SET XMB="APCP PCC TRANSMISSION ERROR"

 +1        SET XMDUZ=.5

           DO ^XMB

 +2        KILL XMB,XM1,XMA,XMDT,XMM,APCP("QFLG1"),APCP("QFLG DES"),XMDUZ

 +3        QUIT

APCPDRI3.m