APCLAP1P.m

APCLAP1P ; 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 APCLSORT=0 K APCLQUIT

 F I=0:0 S APCLSORT=$O(^XTMP("APCLAP1",APCLJOB,APCLBTH,APCLSORT)) Q:APCLSORT=""!($D(APCLQUIT))  D P

 G:$D(APCLQUIT) DONE

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

 W !?61,"-------",!

 W ?52,"Total:",?60,$J(APCLTOT,8),!

DONE ;

 D DONE^APCLOSUT

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

 Q

P ;

 S APCLSRT2=0 F  S APCLSRT2=$O(^XTMP("APCLAP1",APCLJOB,APCLBTH,APCLSORT,APCLSRT2)) Q:APCLSRT2=""!($D(APCLQUIT))  D

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

 .;S APCLSRT2=$O(^XTMP("APCLAP1",APCLJOB,APCLBTH,APCLSORT,""))

 .S APCLPRNT=APCLSORT I APCLPROC="DATE" S Y=APCLPRNT D DD^%DT S APCLPRNT=Y

 .W !?5,$E(APCLPRNT,1,25),?35,$E(APCLSRT2,1,20),?60,$J(^XTMP("APCLAP1",APCLJOB,APCLBTH,APCLSORT,APCLSRT2),8)

 .S APCLTOT=APCLTOT+^XTMP("APCLAP1",APCLJOB,APCLBTH,APCLSORT,APCLSRT2)

 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),?58,APCLDT,?72,"Page ",APCLPG,?78,"*",!

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

 S APCLLENG=24+$L(APCLTITL)

 W "*",?((80-APCLLENG)/2),"NUMBER OF APC VISITS BY ",APCLTITL,?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 ?5,APCLHD1,?35,APCLHD2,?60,"# VISITS",!

 Q

APCLAP1P  ; 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 APCLSORT=0

           KILL APCLQUIT

 +6        FOR I=0:0

               SET APCLSORT=$ORDER(^XTMP("APCLAP1",APCLJOB,APCLBTH,APCLSORT))

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

                   QUIT 

               DO P

 +7        IF $DATA(APCLQUIT)

               GOTO DONE

 +8        IF $Y>(IOSL-5)

               DO HEAD

               IF $DATA(APCLQUIT)

                   GOTO DONE

 +9        WRITE !?61,"-------",!

 +10       WRITE ?52,"Total:",?60,$JUSTIFY(APCLTOT,8),!

DONE      ;

 +1        DO DONE^APCLOSUT

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

 +3        QUIT 

P         ;

 +1        SET APCLSRT2=0

           FOR 

               SET APCLSRT2=$ORDER(^XTMP("APCLAP1",APCLJOB,APCLBTH,APCLSORT,APCLSRT2))

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

                   QUIT 

               Begin DoDot:1

 +2                IF $Y>(IOSL-5)

                       DO HEAD

                       IF $DATA(APCLQUIT)

                           QUIT 

 +3       ;S APCLSRT2=$O(^XTMP("APCLAP1",APCLJOB,APCLBTH,APCLSORT,""))

 +4                SET APCLPRNT=APCLSORT

                   IF APCLPROC="DATE"

                       SET Y=APCLPRNT

                       DO DD^%DT

                       SET APCLPRNT=Y

 +5                WRITE !?5,$EXTRACT(APCLPRNT,1,25),?35,$EXTRACT(APCLSRT2,1,20),?60,$JUSTIFY(^XTMP("APCLAP1",APCLJOB,APCLBTH,APCLSORT,APCLSRT2),8)

 +6                SET APCLTOT=APCLTOT+^XTMP("APCLAP1",APCLJOB,APCLBTH,APCLSORT,APCLSRT2)

               End DoDot:1

 +7        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),?58,APCLDT,?72,"Page ",APCLPG,?78,"*",!

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

 +5        SET APCLLENG=24+$LENGTH(APCLTITL)

 +6        WRITE "*",?((80-APCLLENG)/2),"NUMBER OF APC VISITS BY ",APCLTITL,?78,"*",!

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

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

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

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

 +11       WRITE APCL80S,!

 +12       WRITE !!

 +13       WRITE ?5,APCLHD1,?35,APCLHD2,?60,"# VISITS",!

 +14       QUIT