APCLAP7P.m

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

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

 ;to tally average number of visit per day of week by clinic

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,APCLCLN="" D HEAD

 K APCLQUIT

 F  S APCLCLN=$O(^XTMP("APCLAP7",APCLJOB,APCLBTH,"DOW #",APCLCLN)) Q:APCLCLN=""!($D(APCLQUIT))  D

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

 .W !,$E(APCLCLN,1,20) S J=24 F APCLDAY="MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","SUNDAY" Q:$D(APCLQUIT)  D

 ..I '$D(^XTMP("APCLAP7",APCLJOB,APCLBTH,"DOW #",APCLCLN,APCLDAY)) S APCLTOT=0,APCLTOT=$J(APCLTOT,6,0) W ?J,APCLTOT S J=J+8 Q

 ..S APCLTOT=^XTMP("APCLAP7",APCLJOB,APCLBTH,"VISITS DOW",APCLCLN,APCLDAY)/^XTMP("APCLAP7",APCLJOB,APCLBTH,"DOW #",APCLCLN,APCLDAY) S APCLTOT=$J(APCLTOT,6,0) W ?J,APCLTOT S J=J+8

 ..Q

 .Q

DONE ;

 D DONE^APCLOSUT

 K ^XTMP("APCLAP7",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 "*",?17,"AVERAGE DAILY OUTPATIENT (APC) VISITS BY CLINIC",?78,"*",!

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

 S APCLLENG=21+$L(APCLLOCT)

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

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

 W APCL80S,!

 W !!

 W ?10,"CLINIC",?24,"MONDAY  TUESDAY WEDNESD THURSDA FRIDAY  SATURDA SUNDAY  "

 Q

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

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

 +2       ;to tally average number of visit per day of week by clinic

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

           SET APCLCLN=""

           DO HEAD

 +5        KILL APCLQUIT

 +6        FOR 

               SET APCLCLN=$ORDER(^XTMP("APCLAP7",APCLJOB,APCLBTH,"DOW #",APCLCLN))

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

                   QUIT 

               Begin DoDot:1

 +7                IF $Y>(IOSL-4)

                       DO HEAD

                       IF $DATA(APCLQUIT)

                           QUIT 

 +8                WRITE !,$EXTRACT(APCLCLN,1,20)

                   SET J=24

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

                       IF $DATA(APCLQUIT)

                           QUIT 

                       Begin DoDot:2

 +9                        IF '$DATA(^XTMP("APCLAP7",APCLJOB,APCLBTH,"DOW #",APCLCLN,APCLDAY))

                               SET APCLTOT=0

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

                               WRITE ?J,APCLTOT

                               SET J=J+8

                               QUIT 

 +10                       SET APCLTOT=^XTMP("APCLAP7",APCLJOB,APCLBTH,"VISITS DOW",APCLCLN,APCLDAY)/^XTMP("APCLAP7",APCLJOB,APCLBTH,"DOW #",APCLCLN,APCLDAY)

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

                           WRITE ?J,APCLTOT

                           SET J=J+8

 +11                       QUIT 

                       End DoDot:2

 +12               QUIT 

               End DoDot:1

DONE      ;

 +1        DO DONE^APCLOSUT

 +2        KILL ^XTMP("APCLAP7",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 "*",?17,"AVERAGE DAILY OUTPATIENT (APC) VISITS BY CLINIC",?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        WRITE "*",?18,"REPORT DATE:  ",APCLBDD,"  TO  ",APCLEDD,?78,"*",!

 +10       WRITE APCL80S,!

 +11       WRITE !!

 +12       WRITE ?10,"CLINIC",?24,"MONDAY  TUESDAY WEDNESD THURSDA FRIDAY  SATURDA SUNDAY  "

 +13       QUIT