Routine: APCLCAWP

APCLCAWP ; IHS/CMI/LAB -print tally of walkin and appt clinic visits ;

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

START ;

 S APCL80S="-------------------------------------------------------------------------------"

 D NOW^%DTC S Y=X D DD^%DT S APCLDT=Y

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

 S (APCLTOT,APCLPG,APCLVLOC)=0 D HEAD

 K APCLQUIT

 S (APCLGTOT,APCLGTUN,APCLGTAP,APCLGTWI)=0 F  S APCLVLOC=$O(^XTMP("APCLCAW",APCLJOB,APCLBT,"LOCTOT",APCLVLOC)) Q:APCLVLOC=""!($D(APCLQUIT))  S (APCLLTOT,APCLUNLT,APCLWILT,APCLAPLT)=0 D SORT

 G:$D(APCLQUIT) DONE

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

 W !?18,"Totals:  ",?30,$J(APCLGTOT,6),?38,$J(APCLGTAP,6),?45,$J(((APCLGTAP/APCLGTOT)*100),5,1),?52,$J(APCLGTWI,6),?59,$J(((APCLGTWI/APCLGTOT)*100),5,1),?65,$J(APCLGTUN,6),?72,$J(((APCLGTUN/APCLGTOT)*100),5,1),!!

DONE ;

 D DONE^APCLOSUT

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

SORT ;

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

 W !,$P(^DIC(4,APCLVLOC,0),U),!

 S APCLSORT="" F  S APCLSORT=$O(^XTMP("APCLCAW",APCLJOB,APCLBT,"LOCTOT",APCLVLOC,APCLSORT)) Q:APCLSORT=""!($D(APCLQUIT))  D P

 Q:$D(APCLQUIT)

 W !?15,"Sub total:  ",?30,$J(APCLLTOT,6),?38,$J(APCLAPLT,6),?45,$J(((APCLAPLT/APCLLTOT)*100),5,1),?52,$J(APCLWILT,6),?59,$J(((APCLWILT/APCLLTOT)*100),5,1),?65,$J(APCLUNLT,6),?72,$J(((APCLUNLT/APCLLTOT)*100),5,1),!!

 S APCLGTOT=APCLLTOT+APCLGTOT,APCLGTAP=APCLGTAP+APCLAPLT,APCLGTUN=APCLGTUN+APCLUNLT,APCLGTWI=APCLGTWI+APCLWILT

P ;

 S (APCLCLNT,APCLUNST,APCLWIT,APCLAPPT)=0

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

 S APCLSRT2=$O(^XTMP("APCLCAW",APCLJOB,APCLBT,"LOCTOT",APCLVLOC,APCLSORT,"")),APCLPRNT=APCLSORT

 I $D(^XTMP("APCLCAW",APCLJOB,APCLBT,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,"U")) S APCLUNST=APCLUNST+^("U"),APCLCLNT=APCLCLNT+^("U")

 I $D(^XTMP("APCLCAW",APCLJOB,APCLBT,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,"W")) S APCLWIT=APCLWIT+^("W"),APCLCLNT=APCLCLNT+^("W")

 I $D(^XTMP("APCLCAW",APCLJOB,APCLBT,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,"A")) S APCLAPPT=APCLAPPT+^("A"),APCLCLNT=APCLCLNT+^("A")

 W !?2,$E(APCLPRNT,1,20),?23,APCLSRT2,?30,$J(APCLCLNT,6),?38,$J(APCLAPPT,6),?45,$J(((APCLAPPT/APCLCLNT)*100),5,1),?52,$J(APCLWIT,6),?59,$J(((APCLWIT/APCLCLNT)*100),5,1),?65,$J(APCLUNST,6),?72,$J(((APCLUNST/APCLCLNT)*100),5,1)

 S APCLLTOT=APCLCLNT+APCLLTOT,APCLUNLT=APCLUNLT+APCLUNST,APCLAPLT=APCLAPLT+APCLAPPT,APCLWILT=APCLWILT+APCLWIT

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

 W ?10,"TALLY OF CLINIC VISITS:  WALK-IN, APPOINTMENT, UNSPECIFIED",!

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

 S APCLLENG=21+$L(APCLLOCT)

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

 S APCLCLNT=$S($G(APCLCLN)="A":"ALL",1:"Selected Clinics") ;IHS/CMI/LAB

 S APCLLENG=8+$L(APCLCLNT)

 W ?((80-APCLLENG)/2),"CLINIC:  ",APCLCLNT,!

 W ?18,"VISIT DATES:  ",APCLBDD,"  TO  ",APCLEDD,!

 W !,"LOCATION OF VISIT"

 W !?22,"CLINIC",?30,"TOTAL",?39,"APPOINTMENTS",?53,"  WALK-INS",?66,"UNSPECIFIED"

 W !?5,"CLINIC",?22,"CODE",?29,"# VISITS",?42,"#     %",?56,"#     %",?69,"#     %",!

 W APCL80S,!

APCLCAWP  ; IHS/CMI/LAB -print tally of walkin and appt clinic visits ;

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

START     ;

 +1        SET APCL80S="-------------------------------------------------------------------------------"

 +2        DO NOW^%DTC

           SET Y=X

           DO DD^%DT

           SET APCLDT=Y

 +3        SET Y=APCLBD

           DO DD^%DT

           SET APCLBDD=Y

           SET Y=APCLED

           DO DD^%DT

           SET APCLEDD=Y

 +4        SET (APCLTOT,APCLPG,APCLVLOC)=0

           DO HEAD

 +5        KILL APCLQUIT

 +6        SET (APCLGTOT,APCLGTUN,APCLGTAP,APCLGTWI)=0

FOR

               SET APCLVLOC=$ORDER(^XTMP("APCLCAW",APCLJOB,APCLBT,"LOCTOT",APCLVLOC))

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

                   QUIT

               SET (APCLLTOT,APCLUNLT,APCLWILT,APCLAPLT)=0

               DO SORT

 +7        IF $DATA(APCLQUIT)

               GOTO DONE

 +8        IF $Y>(IOSL-5)

               DO HEAD

               IF $DATA(APCLQUIT)

                   GOTO DONE

 +9        WRITE !?18,"Totals:  ",?30,$JUSTIFY(APCLGTOT,6),?38,$JUSTIFY(APCLGTAP,6),?45,$JUSTIFY(((APCLGTAP/APCLGTOT)*100),5,1),?52,$JUSTIFY(APCLGTWI,6),?59,$JUSTIFY(((APCLGTWI/APCLGTOT)*100),5,1),?65,$JUSTIFY(APCLGTUN,6),?72,$JUSTIFY(((APCLGTUN/APCLGTOT)

*100),5,1),!!

DONE      ;

 +1        DO DONE^APCLOSUT

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

 +3        QUIT

SORT      ;

 +1        IF $Y>(IOSL-6)

               DO HEAD

               IF $DATA(APCLQUIT)

                   QUIT

 +2        WRITE !,$PIECE(^DIC(4,APCLVLOC,0),U),!

 +3        SET APCLSORT=""

FOR

               SET APCLSORT=$ORDER(^XTMP("APCLCAW",APCLJOB,APCLBT,"LOCTOT",APCLVLOC,APCLSORT))

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

                   QUIT

               DO P

 +4        IF $DATA(APCLQUIT)

               QUIT

 +5       WRITE !?15,"Sub total:  ",?30,$JUSTIFY(APCLLTOT,6),?38,$JUSTIFY(APCLAPLT,6),?45,$JUSTIFY(((APCLAPLT/APCLLTOT)*100),5,1),?52,$JUSTIFY(APCLWILT,6),?59,$JUSTIFY(((APCLWILT/APCLLTOT)*100),5,1),?65,$JUSTIFY(APCLUNLT,6),?72,...

           ... $JUSTIFY(((APCLUNLT/APCLLTOT)*100),5,1),!!

 +6        SET APCLGTOT=APCLLTOT+APCLGTOT

           SET APCLGTAP=APCLGTAP+APCLAPLT

           SET APCLGTUN=APCLGTUN+APCLUNLT

           SET APCLGTWI=APCLGTWI+APCLWILT

 +7        QUIT

P         ;

 +1        SET (APCLCLNT,APCLUNST,APCLWIT,APCLAPPT)=0

 +2        IF $Y>(IOSL-5)

               DO HEAD

               IF $DATA(APCLQUIT)

                   QUIT

 +3        SET APCLSRT2=$ORDER(^XTMP("APCLCAW",APCLJOB,APCLBT,"LOCTOT",APCLVLOC,APCLSORT,""))

           SET APCLPRNT=APCLSORT

 +4        IF $DATA(^XTMP("APCLCAW",APCLJOB,APCLBT,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,"U"))

               SET APCLUNST=APCLUNST+^("U")

               SET APCLCLNT=APCLCLNT+^("U")

 +5        IF $DATA(^XTMP("APCLCAW",APCLJOB,APCLBT,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,"W"))

               SET APCLWIT=APCLWIT+^("W")

               SET APCLCLNT=APCLCLNT+^("W")

 +6        IF $DATA(^XTMP("APCLCAW",APCLJOB,APCLBT,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,"A"))

               SET APCLAPPT=APCLAPPT+^("A")

               SET APCLCLNT=APCLCLNT+^("A")

 +7       WRITE !?2,$EXTRACT(APCLPRNT,1,20),?23,APCLSRT2,?30,$JUSTIFY(APCLCLNT,6),?38,$JUSTIFY(APCLAPPT,6),?45,$JUSTIFY(((APCLAPPT/APCLCLNT)*100),5,1),?52,...

           ... $JUSTIFY(APCLWIT,6),?59,$JUSTIFY(((APCLWIT/APCLCLNT)*100),5,1),?65,$JUSTIFY(APCLUNST,6),?72,$JUSTIFY(((APCLUNST/APCLCLNT)*100),5,1)

 +8        SET APCLLTOT=APCLCLNT+APCLLTOT

           SET APCLUNLT=APCLUNLT+APCLUNST

           SET APCLAPLT=APCLAPLT+APCLAPPT

           SET APCLWILT=APCLWILT+APCLWIT

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

 +3        WRITE ?10,"TALLY OF CLINIC VISITS:  WALK-IN, APPOINTMENT, UNSPECIFIED",!

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

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

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

 +7       ;IHS/CMI/LAB

           SET APCLCLNT=$SELECT($GET(APCLCLN)="A":"ALL",1:"Selected Clinics")

 +8        SET APCLLENG=8+$LENGTH(APCLCLNT)

 +9        WRITE ?((80-APCLLENG)/2),"CLINIC:  ",APCLCLNT,!

 +10       WRITE ?18,"VISIT DATES:  ",APCLBDD,"  TO  ",APCLEDD,!

 +11       WRITE !,"LOCATION OF VISIT"

 +12       WRITE !?22,"CLINIC",?30,"TOTAL",?39,"APPOINTMENTS",?53,"  WALK-INS",?66,"UNSPECIFIED"

 +13       WRITE !?5,"CLINIC",?22,"CODE",?29,"# VISITS",?42,"#     %",?56,"#     %",?69,"#     %",!

 +14       WRITE APCL80S,!

 +15       QUIT

APCLCAWP.m