Routine: APCL8A

APCL8A ; IHS/CMI/LAB - APC visits by primary provider ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

START ;

 D INFORM

 K DUOUT,DTOUT

FY S %DT="AE",%DT("A")="Enter the Fiscal Year for this 1A report: ",%DT("B")=$E(DT,2,3) D ^%DT I $D(DTOUT) G EOJ

 I X="^" G EOJ

 I Y=-1 D ERR G FY

 I $E(Y,4,7)'="0000" D ERR G FY

 S X1=$E(Y,1,3)_"0930",X2=-365 D C^%DTC S APCLFY=$E(X,1,3)_"1001"

F ;

 S DIC("A")="Run for which Facility of Encounter: ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 FY

 S APCLLOC=+Y

DEMO ;

 D DEMOCHK^APCLUTL(.APCLDEMO)

 I APCLDEMO=-1 G FY

ZIS ;

 S XBRP="^APCL8AP",XBRC="^APCL8A1",XBRX="EOJ^APCL8A",XBNS="APCL"

 D ^XBDBQUE

 D EOJ

ERR W $C(7),$C(7),!,"Must be a valid Year.  Enter a year only!!" Q

EOJ K APCLFY,APCLLOC,APCLSD,APCLVDFN,APCLVREC,APCLSKIP,APCLCLIN,APCL1,APCL2,APCLDISC,APCLAP,APCLPPOV,APCLX,APCLDPTR,APCLVLOC,APCLMOL,APCLFYD,APCLMOS,APCLBT,APCLJOB

 K APCLDT,APCLAREA,APCLLOCP,APCLLOC,APCLAREC,APCLSU,APCLSUC,APCLGRAN,APCLPG,APCLQUIT,APCLMON,APCLTAB,APCLJ,APCLDISN,APCLPRIM,APCLP,APCLT,APCLPRIT,APCL80,APCLFYE,APCLLOCC,APCLCOMP,APCLCOMX

 K X,X1,X2,IO("Q"),%,Y,%DT,%Y,%W,%T,%H,DUOUT,DTOUT,POP,ZTSK,ZTQUEUED,H,S,TS,M

INFORM ;

 W:$D(IOF) @IOF

 W !,"**********  PCC/APC REPORT 1A - VISITS NOT EXPORTED  **********",!

 W !,"This report will process exactly like the 1A report, except instead of ",!,"producing the 1A report it will list all visits that would be ",!,"included in the 1A that have NOT been exported to the ",!,"National Data Warehouse (NDW).",!

APCL8A    ; IHS/CMI/LAB - APC visits by primary provider ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

START     ;

 +1        DO INFORM

 +2        KILL DUOUT,DTOUT

FY         SET %DT="AE"

           SET %DT("A")="Enter the Fiscal Year for this 1A report: "

           SET %DT("B")=$EXTRACT(DT,2,3)

           DO ^%DT

           IF $DATA(DTOUT)

               GOTO EOJ

 +1        IF X="^"

               GOTO EOJ

 +2        IF Y=-1

               DO ERR

               GOTO FY

 +3        IF $EXTRACT(Y,4,7)'="0000"

               DO ERR

               GOTO FY

 +4        SET X1=$EXTRACT(Y,1,3)_"0930"

           SET X2=-365

           DO C^%DTC

           SET APCLFY=$EXTRACT(X,1,3)_"1001"

F         ;

 +1        SET DIC("A")="Run for which Facility of Encounter: "

           SET DIC="^AUTTLOC("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA

           IF Y<0

               GOTO FY

 +2        SET APCLLOC=+Y

DEMO      ;

 +1        DO DEMOCHK^APCLUTL(.APCLDEMO)

 +2        IF APCLDEMO=-1

               GOTO FY

ZIS       ;

 +1        SET XBRP="^APCL8AP"

           SET XBRC="^APCL8A1"

           SET XBRX="EOJ^APCL8A"

           SET XBNS="APCL"

 +2        DO ^XBDBQUE

 +3        DO EOJ

 +4        QUIT

ERR        WRITE $CHAR(7),$CHAR(7),!,"Must be a valid Year.  Enter a year only!!"

           QUIT

EOJ        KILL APCLFY,APCLLOC,APCLSD,APCLVDFN,APCLVREC,APCLSKIP,APCLCLIN,APCL1,APCL2,APCLDISC,APCLAP,APCLPPOV,APCLX,APCLDPTR,APCLVLOC,APCLMOL,APCLFYD,APCLMOS,APCLBT,APCLJOB

 +1        KILL APCLDT,APCLAREA,APCLLOCP,APCLLOC,APCLAREC,APCLSU,APCLSUC,APCLGRAN,APCLPG,APCLQUIT,APCLMON,APCLTAB,APCLJ,APCLDISN,APCLPRIM,APCLP,APCLT,APCLPRIT,APCL80,APCLFYE,APCLLOCC,APCLCOMP,APCLCOMX

 +2        KILL X,X1,X2,IO("Q"),%,Y,%DT,%Y,%W,%T,%H,DUOUT,DTOUT,POP,ZTSK,ZTQUEUED,H,S,TS,M

 +3        QUIT

 +4       ;

INFORM    ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !,"**********  PCC/APC REPORT 1A - VISITS NOT EXPORTED  **********",!

 +3        WRITE !,"This report will process exactly like the 1A report, except instead of ",!,"producing the 1A report it will list all visits that would be ",!,"included in the 1A that have NOT been exported to the ",!,"National Data Warehouse (NDW).",!

 +4        QUIT

 +5       ;

 +6       ;

APCL8A.m