APCL1A.m

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

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

 ;CMI/TUCSON/LAB - fixed FY patch 3

START ; 

 D INFORM

 K DUOUT,DTOUT

FY D ^APCLFY

 ;beginning Y2K

 ;I $D(DTOUT)!(Y=-1) G EOJ ;Y2000

 I $D(DTOUT)!(APCL("FY")=-1) G EOJ ;Y2000

 ;I $G(APCL("FY"))=$E(DT,2,3)&(DT'>APCL("FY END DATE")) W !!?6,"Current FISCAL Year date range:  ",APCL("FY PRINTABLE BDATE")," - ",APCL("FY TODAY") ;Y2000

 ;E  W !!?6,"FISCAL Year date range:  ",APCL("FY PRINTABLE BDATE")," - ",APCL("FY PRINTABLE EDATE") ;Y2000

 I APCL("FY BEG DATE")>DT W $C(7),$C(7),!!?6,"You have selected a FY with a beginning date that is in the future!!",!,?6,$$FMTE^XLFDT(APCL("FY BEG DATE")),"  Select again!",! G FY ;Y2000

 W !!?6,"FISCAL Year date range: ",$$FMTE^XLFDT(APCL("FY BEG DATE"))," - ",$S(APCL("FY END DATE")>DT:$$FMTE^XLFDT(DT),1:$$FMTE^XLFDT(APCL("FY END DATE"))) ;Y2000

 S APCLFY=APCL("FY BEG DATE")

 S APCLFYE=APCL("FY END DATE")

 S APCLSD=$P(APCL("FY WORKING DT"),".",1)

 W !

 ;S:$G(APCL("FY"))=$E(DT,2,3)&(DT'>APCL("FY END DATE")) %DT("B")=APCL("FY TODAY") ;Y2000

 ;E  S %DT("B")=APCL("FY PRINTABLE EDATE") ;Y2000

 ;end Y2K

F ;

 S X=$O(^DIC(7,0)) I $P($G(^DIC(7,X,9999999)),U,5)="" W !!,"Your provider class file does not contain the 1A workload reportable flags.",!,"This report cannot be run accurately until AUM Patch 6 is installed.",!! H 2

 W !!

 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

 W !!,$C(7),$C(7),"THIS REPORT MUST BE PRINTED ON 132 COLUMN PAPER OR ON A PRINTER THAT IS",!,"SET UP FOR CONDENSED PRINT!!!",!,"IF YOU DO NOT HAVE SUCH A PRINTER AVAILABLE - SEE YOUR SITE MANAGER.",!

DEMO ;

 D DEMOCHK^APCLUTL(.APCLDEMO)

 I APCLDEMO=-1 G FY

ZIS ;

 S XBRP="^APCL1AP",XBRC="^APCL1A1",XBRX="EOJ^APCL1A",XBNS="APCL"

 D ^XBDBQUE

 D EOJ

 Q

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,APCL132,APCLFYE,APCLLOCC,DFN,APCLPDC,APCL

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

 Q

 ;

INFORM ;

 W:$D(IOF) @IOF

 W !,"**********  PCC/APC REPORT 1A  **********",!

 W !,"This report will print Year to Date Ambulatory Visit Counts for the Facility",!,"and Fiscal Year that you select.  The counts by month are for date of"

 W !,"service.  This report will resemble, but not duplicate exactly, the",!,"APC 1A report produced at the IHS Data Warehouse in Albuquerque.",!!

 Q

 ;

 ;

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

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

 +2       ;CMI/TUCSON/LAB - fixed FY patch 3

START     ; 

 +1        DO INFORM

 +2        KILL DUOUT,DTOUT

FY         DO ^APCLFY

 +1       ;beginning Y2K

 +2       ;I $D(DTOUT)!(Y=-1) G EOJ ;Y2000

 +3       ;Y2000

           IF $DATA(DTOUT)!(APCL("FY")=-1)

               GOTO EOJ

 +4       ;I $G(APCL("FY"))=$E(DT,2,3)&(DT'>APCL("FY END DATE")) W !!?6,"Current FISCAL Year date range:  ",APCL("FY PRINTABLE BDATE")," - ",APCL("FY TODAY") ;Y2000

 +5       ;E  W !!?6,"FISCAL Year date range:  ",APCL("FY PRINTABLE BDATE")," - ",APCL("FY PRINTABLE EDATE") ;Y2000

 +6       ;Y2000

           IF APCL("FY BEG DATE")>DT

               WRITE $CHAR(7),$CHAR(7),!!?6,"You have selected a FY with a beginning date that is in the future!!",!,?6,$$FMTE^XLFDT(APCL("FY BEG DATE")),"  Select again!",!

               GOTO FY

 +7       ;Y2000

           WRITE !!?6,"FISCAL Year date range: ",$$FMTE^XLFDT(APCL("FY BEG DATE"))," - ",$SELECT(APCL("FY END DATE")>DT:$$FMTE^XLFDT(DT),1:$$FMTE^XLFDT(APCL("FY END DATE")))

 +8        SET APCLFY=APCL("FY BEG DATE")

 +9        SET APCLFYE=APCL("FY END DATE")

 +10       SET APCLSD=$PIECE(APCL("FY WORKING DT"),".",1)

 +11       WRITE !

 +12      ;S:$G(APCL("FY"))=$E(DT,2,3)&(DT'>APCL("FY END DATE")) %DT("B")=APCL("FY TODAY") ;Y2000

 +13      ;E  S %DT("B")=APCL("FY PRINTABLE EDATE") ;Y2000

 +14      ;end Y2K

F         ;

 +1        SET X=$ORDER(^DIC(7,0))

           IF $PIECE($GET(^DIC(7,X,9999999)),U,5)=""

               WRITE !!,"Your provider class file does not contain the 1A workload reportable flags.",!,"This report cannot be run accurately until AUM Patch 6 is installed.",!!

               HANG 2

 +2        WRITE !!

 +3        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

 +4        SET APCLLOC=+Y

 +5        WRITE !!,$CHAR(7),$CHAR(7),"THIS REPORT MUST BE PRINTED ON 132 COLUMN PAPER OR ON A PRINTER THAT IS",!,"SET UP FOR CONDENSED PRINT!!!",!,"IF YOU DO NOT HAVE SUCH A PRINTER AVAILABLE - SEE YOUR SITE MANAGER.",!

DEMO      ;

 +1        DO DEMOCHK^APCLUTL(.APCLDEMO)

 +2        IF APCLDEMO=-1

               GOTO FY

ZIS       ;

 +1        SET XBRP="^APCL1AP"

           SET XBRC="^APCL1A1"

           SET XBRX="EOJ^APCL1A"

           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,APCL132,APCLFYE,APCLLOCC,DFN,APCLPDC,APCL

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

 +3        QUIT 

 +4       ;

INFORM    ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !,"**********  PCC/APC REPORT 1A  **********",!

 +3        WRITE !,"This report will print Year to Date Ambulatory Visit Counts for the Facility",!,"and Fiscal Year that you select.  The counts by month are for date of"

 +4        WRITE !,"service.  This report will resemble, but not duplicate exactly, the",!,"APC 1A report produced at the IHS Data Warehouse in Albuquerque.",!!

 +5        QUIT 

 +6       ;

 +7       ;