APCL1H.m

APCL1H ; IHS/CMI/LAB - print hospital discharges by ;

 ;;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 report: ",%DT("B")=$E(DT,2,3) D ^%DT I $D(DTOUT) G XIT

 I X="^" G XIT

 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"

A ;

 S DIC("A")="Run for which IHS AREA: ",DIC="^AUTTAREA(",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 FY

 S APCLAREA=+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 XBRC="^APCL1H1",XBRP="^APCL1HP",XBNS="APCL",XBRX="EOJ^APCL1H"

 D ^XBDBQUE

XIT ;

EOJ K APCL132,APCLAREC,APCLDT,APCLAREA,APCLFY,APCLFYD,APCLFYE,APCLGRAN,APCLJ,APCLLOC,APCLLOCN,APCLMOL,APCLMOS,APCLODAT,APCLPG,APCLSD,APCLT,APCLTAB,APCLVDFN,APCLVINP,APCLMON,APCLQUIT,APCLBT,APCLX,APCLJOB

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

 Q

 ;

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

INFORM ;

 W:$D(IOF) @IOF

 W !,"**********  PCC HOSPITAL DISCHARGE REPORT  **********",!

 W !,"This report will print Fiscal Year to Date Hospital Discharge Counts for",!,"all Facilities in the Area that select.  The counts by month are for",!,"month of discharge.",!

 Q

 ;

 ;

APCL1H    ; IHS/CMI/LAB - print hospital discharges by ;

 +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 report: "

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

           DO ^%DT

           IF $DATA(DTOUT)

               GOTO XIT

 +1        IF X="^"

               GOTO XIT

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

A         ;

 +1        SET DIC("A")="Run for which IHS AREA: "

           SET DIC="^AUTTAREA("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA

           IF Y<0

               GOTO FY

 +2        SET APCLAREA=+Y

 +3        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 XBRC="^APCL1H1"

           SET XBRP="^APCL1HP"

           SET XBNS="APCL"

           SET XBRX="EOJ^APCL1H"

 +2        DO ^XBDBQUE

XIT       ;

EOJ        KILL APCL132,APCLAREC,APCLDT,APCLAREA,APCLFY,APCLFYD,APCLFYE,APCLGRAN,APCLJ,APCLLOC,APCLLOCN,APCLMOL,APCLMOS,APCLODAT,APCLPG,APCLSD,APCLT,APCLTAB,APCLVDFN,APCLVINP,APCLMON,APCLQUIT,APCLBT,APCLX,APCLJOB

 +1        KILL X,X1,X2,IO("Q"),%,Y,%DT,%Y,%W,%T,%H,POP,C,DUOUT,DTOUT,DIRUT,ZTSK,H,S,TS,M,J,K

 +2        QUIT 

 +3       ;

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

           QUIT 

INFORM    ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !,"**********  PCC HOSPITAL DISCHARGE REPORT  **********",!

 +3        WRITE !,"This report will print Fiscal Year to Date Hospital Discharge Counts for",!,"all Facilities in the Area that select.  The counts by month are for",!,"month of discharge.",!

 +4        QUIT 

 +5       ;

 +6       ;