APCLAP4P.m

APCLAP4P ; IHS/CMI/LAB - print apc report ;

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

START ;

 S APCL80S="*******************************************************************************"

 S APCLDT=$$FMTE^XLFDT(DT)

 S Y=APCLBD D DD^%DT S APCLBDD=Y S Y=APCLED D DD^%DT S APCLEDD=Y

 S (APCLTOT,APCLPG)=0 D HEAD

 S APCLDAY=0 K APCLQUIT

 F APCLDAY="MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","SUNDAY" Q:$D(APCLQUIT)  D

 .I '$D(^XTMP("APCLAP4",APCLJOB,APCLBTH,"DOW #",APCLDAY)) S APCLTOT=0,APCLTOT=$J(APCLTOT,6,0) D P Q

 .S APCLTOT=^XTMP("APCLAP4",APCLJOB,APCLBTH,"VISITS DOW",APCLDAY)/^XTMP("APCLAP4",APCLJOB,APCLBTH,"DOW #",APCLDAY) S APCLTOT=$J(APCLTOT,6,0) D P

 .Q

DONE ;

 D DONE^APCLOSUT

 K ^XTMP("APCLAP4",APCLJOB,APCLBTH)

 Q

P ;

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

 W !!?10,APCLDAY,?40,APCLTOT

 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 !,APCL80S,!

 W "*",?3,$P(^DIC(4,APCLSITE,0),U),?56,APCLDT,?72,"Page ",APCLPG,?78,"*",!

 W "*",?78,"*",!

 W "*",?22,"AVERAGE DAILY OUTPATIENT (APC) VISITS",?78,"*",!

 S APCLLOCT=$S(APCLLOC=0:"ALL",1:"SELECTED")

 S APCLLENG=21+$L(APCLLOCT)

 W "*",?((80-APCLLENG)/2),"LOCATION OF VISITS:  ",APCLLOCT,?78,"*",!

 I $D(APCLCLNT) D DISPCLN

 W "*",?18,"REPORT DATE:  ",APCLBDD,"  TO  ",APCLEDD,?78,"*",!

 W APCL80S,!

 W !!

 W ?10,"DAY-OF-WEEK",?35,"AVERAGE # VISITS PER DAY"

 Q

DISPCLN ;

 NEW X S X=0 F  S X=$O(APCLCLNT(X)) Q:X'=+X  D

 .S APCLLENG=9+$L($P(^DIC(40.7,X,0),U))

 .W "*",?((80-APCLLENG)/2),"CLINIC:  ",$P(^DIC(40.7,X,0),U),?78,"*",!

 .Q

 Q

APCLAP4P  ; IHS/CMI/LAB - print apc report ;

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

START     ;

 +1        SET APCL80S="*******************************************************************************"

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

 +3        SET Y=APCLBD

           DO DD^%DT

           SET APCLBDD=Y

           SET Y=APCLED

           DO DD^%DT

           SET APCLEDD=Y

 +4        SET (APCLTOT,APCLPG)=0

           DO HEAD

 +5        SET APCLDAY=0

           KILL APCLQUIT

 +6        FOR APCLDAY="MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","SUNDAY"

               IF $DATA(APCLQUIT)

                   QUIT 

               Begin DoDot:1

 +7                IF '$DATA(^XTMP("APCLAP4",APCLJOB,APCLBTH,"DOW #",APCLDAY))

                       SET APCLTOT=0

                       SET APCLTOT=$JUSTIFY(APCLTOT,6,0)

                       DO P

                       QUIT 

 +8                SET APCLTOT=^XTMP("APCLAP4",APCLJOB,APCLBTH,"VISITS DOW",APCLDAY)/^XTMP("APCLAP4",APCLJOB,APCLBTH,"DOW #",APCLDAY)

                   SET APCLTOT=$JUSTIFY(APCLTOT,6,0)

                   DO P

 +9                QUIT 

               End DoDot:1

DONE      ;

 +1        DO DONE^APCLOSUT

 +2        KILL ^XTMP("APCLAP4",APCLJOB,APCLBTH)

 +3        QUIT 

P         ;

 +1        IF $Y>(IOSL-5)

               DO HEAD

               IF $DATA(APCLQUIT)

                   QUIT 

 +2        WRITE !!?10,APCLDAY,?40,APCLTOT

 +3        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 !,APCL80S,!

 +3        WRITE "*",?3,$PIECE(^DIC(4,APCLSITE,0),U),?56,APCLDT,?72,"Page ",APCLPG,?78,"*",!

 +4        WRITE "*",?78,"*",!

 +5        WRITE "*",?22,"AVERAGE DAILY OUTPATIENT (APC) VISITS",?78,"*",!

 +6        SET APCLLOCT=$SELECT(APCLLOC=0:"ALL",1:"SELECTED")

 +7        SET APCLLENG=21+$LENGTH(APCLLOCT)

 +8        WRITE "*",?((80-APCLLENG)/2),"LOCATION OF VISITS:  ",APCLLOCT,?78,"*",!

 +9        IF $DATA(APCLCLNT)

               DO DISPCLN

 +10       WRITE "*",?18,"REPORT DATE:  ",APCLBDD,"  TO  ",APCLEDD,?78,"*",!

 +11       WRITE APCL80S,!

 +12       WRITE !!

 +13       WRITE ?10,"DAY-OF-WEEK",?35,"AVERAGE # VISITS PER DAY"

 +14       QUIT 

DISPCLN   ;

 +1        NEW X

           SET X=0

           FOR 

               SET X=$ORDER(APCLCLNT(X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +2                SET APCLLENG=9+$LENGTH($PIECE(^DIC(40.7,X,0),U))

 +3                WRITE "*",?((80-APCLLENG)/2),"CLINIC:  ",$PIECE(^DIC(40.7,X,0),U),?78,"*",!

 +4                QUIT 

               End DoDot:1

 +5        QUIT