APCL1HP.m

APCL1HP ; IHS/CMI/LAB - print report 2A ;

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

START ;

 S APCLDT=$$FMTE^XLFDT(DT)

 S APCL132="__________________________________________________________________________________________________________________________________"

 S APCLMOL="OCT.,NOV.,DEC.,JAN.,FEB.,MAR.,APR.,MAY ,JUNE,JULY,AUG.,SEPT"

 S Y=$E(APCLFYE,1,3)_"0000" D DD^%DT S APCLFYD=Y S Y=DT D DD^%DT S APCLDT=Y

 I '$D(^AUTTAREA(APCLAREA,0)) S (APCLAREA,APCLAREC)="???" G START2

 S APCLAREC=$P(^AUTTAREA(APCLAREA,0),U,2),APCLAREA=$P(^AUTTAREA(APCLAREA,0),U)

START2 S (APCLPG,APCLLOC)=0 D HEAD

 K APCLQUIT

 I APCLGRAN=0 W !!,"NO VISITS FOR THIS FISCAL YEAR",! G DONE

 F  S APCLLOC=$O(^XTMP("APCL1H",APCLJOB,APCLBT,"MONLOCTOT",APCLLOC)) Q:APCLLOC=""!($D(APCLQUIT))  D P

 G:$D(APCLQUIT) DONE

 I $Y>(IOSL-8) D HEAD G:$D(APCLQUIT) DONE

 W !!," T O T A L",?29,$J(APCLGRAN,6)

 S APCLMON="",APCLTAB=36 F APCLJ=10,11,12,1,2,3,4,5,6,7,8,9 S APCLMON=$S($D(^XTMP("APCL1H",APCLJOB,APCLBT,"MONTOT",APCLJ)):^(APCLJ),1:0) W ?APCLTAB,$J(APCLMON,6) S APCLTAB=APCLTAB+8

 W !

DONE ;

 D DONE^APCLOSUT

 K ^XTMP("APCL1H",APCLJOB,APCLBT)

 Q

P ;

 I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)

 S APCLT=^XTMP("APCL1H",APCLJOB,APCLBT,"LOCTOT",APCLLOC)

 S APCLLOCN=$E($P(^DIC(4,APCLLOC,0),U),1,28)

 W !,APCLLOCN,?29,$J(APCLT,6)

 S APCLMON="",APCLTAB=36 F APCLJ=10,11,12,1,2,3,4,5,6,7,8,9 S APCLMON=$S($D(^XTMP("APCL1H",APCLJOB,APCLBT,"MONLOCTOT",APCLLOC,APCLJ)):^(APCLJ),1:0) W ?APCLTAB,$J(APCLMON,6) S APCLTAB=APCLTAB+8 D MONTOT

 Q

 ;

MONTOT ;set up month totals for all discharges

 S ^(APCLJ)=$S($D(^XTMP("APCL1H",APCLJOB,APCLBT,"MONTOT",APCLJ)):^(APCLJ)+APCLMON,1:APCLMON)

 Q

HEAD I 'APCLPG G HEAD1

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT="" Q

HEAD1 ;

 W:$D(IOF) @IOF S APCLPG=APCLPG+1

 W APCL132,!

 W !?25,"NUMBER OF HOSPITAL DISCHARGES BY MONTH OF DISCHARGE    FISCAL YEAR",APCLFYD

 W !,"AREA:  ",APCLAREC,"      ",APCLAREA,?105,APCLDT,?120,"Page ",APCLPG

 W !,APCL132,!

 W !,"HOSPITAL NAME",?30,"YR-TO",!

 W ?30,"DATE"

 S APCLTAB=38 F APCLX=1:1:12 W ?APCLTAB,$P(APCLMOL,",",APCLX) S APCLTAB=APCLTAB+8

 W !,APCL132

 Q

 ;

APCL1HP   ; IHS/CMI/LAB - print report 2A ;

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

START     ;

 +1        SET APCLDT=$$FMTE^XLFDT(DT)

 +2        SET APCL132="__________________________________________________________________________________________________________________________________"

 +3        SET APCLMOL="OCT.,NOV.,DEC.,JAN.,FEB.,MAR.,APR.,MAY ,JUNE,JULY,AUG.,SEPT"

 +4        SET Y=$EXTRACT(APCLFYE,1,3)_"0000"

           DO DD^%DT

           SET APCLFYD=Y

           SET Y=DT

           DO DD^%DT

           SET APCLDT=Y

 +5        IF '$DATA(^AUTTAREA(APCLAREA,0))

               SET (APCLAREA,APCLAREC)="???"

               GOTO START2

 +6        SET APCLAREC=$PIECE(^AUTTAREA(APCLAREA,0),U,2)

           SET APCLAREA=$PIECE(^AUTTAREA(APCLAREA,0),U)

START2     SET (APCLPG,APCLLOC)=0

           DO HEAD

 +1        KILL APCLQUIT

 +2        IF APCLGRAN=0

               WRITE !!,"NO VISITS FOR THIS FISCAL YEAR",!

               GOTO DONE

 +3        FOR 

               SET APCLLOC=$ORDER(^XTMP("APCL1H",APCLJOB,APCLBT,"MONLOCTOT",APCLLOC))

               IF APCLLOC=""!($DATA(APCLQUIT))

                   QUIT 

               DO P

 +4        IF $DATA(APCLQUIT)

               GOTO DONE

 +5        IF $Y>(IOSL-8)

               DO HEAD

               IF $DATA(APCLQUIT)

                   GOTO DONE

 +6        WRITE !!," T O T A L",?29,$JUSTIFY(APCLGRAN,6)

 +7        SET APCLMON=""

           SET APCLTAB=36

           FOR APCLJ=10,11,12,1,2,3,4,5,6,7,8,9

               SET APCLMON=$SELECT($DATA(^XTMP("APCL1H",APCLJOB,APCLBT,"MONTOT",APCLJ)):^(APCLJ),1:0)

               WRITE ?APCLTAB,$JUSTIFY(APCLMON,6)

               SET APCLTAB=APCLTAB+8

 +8        WRITE !

DONE      ;

 +1        DO DONE^APCLOSUT

 +2        KILL ^XTMP("APCL1H",APCLJOB,APCLBT)

 +3        QUIT 

P         ;

 +1        IF $Y>(IOSL-5)

               DO HEAD

               IF $DATA(APCLQUIT)

                   QUIT 

 +2        SET APCLT=^XTMP("APCL1H",APCLJOB,APCLBT,"LOCTOT",APCLLOC)

 +3        SET APCLLOCN=$EXTRACT($PIECE(^DIC(4,APCLLOC,0),U),1,28)

 +4        WRITE !,APCLLOCN,?29,$JUSTIFY(APCLT,6)

 +5        SET APCLMON=""

           SET APCLTAB=36

           FOR APCLJ=10,11,12,1,2,3,4,5,6,7,8,9

               SET APCLMON=$SELECT($DATA(^XTMP("APCL1H",APCLJOB,APCLBT,"MONLOCTOT",APCLLOC,APCLJ)):^(APCLJ),1:0)

               WRITE ?APCLTAB,$JUSTIFY(APCLMON,6)

               SET APCLTAB=APCLTAB+8

               DO MONTOT

 +6        QUIT 

 +7       ;

MONTOT    ;set up month totals for all discharges

 +1        SET ^(APCLJ)=$SELECT($DATA(^XTMP("APCL1H",APCLJOB,APCLBT,"MONTOT",APCLJ)):^(APCLJ)+APCLMON,1:APCLMON)

 +2        QUIT 

HEAD       IF 'APCLPG

               GOTO HEAD1

 +1        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET APCLQUIT=""

                       QUIT 

HEAD1     ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET APCLPG=APCLPG+1

 +2        WRITE APCL132,!

 +3        WRITE !?25,"NUMBER OF HOSPITAL DISCHARGES BY MONTH OF DISCHARGE    FISCAL YEAR",APCLFYD

 +4        WRITE !,"AREA:  ",APCLAREC,"      ",APCLAREA,?105,APCLDT,?120,"Page ",APCLPG

 +5        WRITE !,APCL132,!

 +6        WRITE !,"HOSPITAL NAME",?30,"YR-TO",!

 +7        WRITE ?30,"DATE"

 +8        SET APCLTAB=38

           FOR APCLX=1:1:12

               WRITE ?APCLTAB,$PIECE(APCLMOL,",",APCLX)

               SET APCLTAB=APCLTAB+8

 +9        WRITE !,APCL132

 +10       QUIT 

 +11      ;