- APCLCZPP ; IHS/CMI/LAB - print all visit report ;
- ;;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
- F S APCLVLOC=$O(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC)) Q:APCLVLOC=""!($D(APCLQUIT)) D SORT
- G:$D(APCLQUIT) DONE
- I $Y>(IOSL-5) D HEAD G:$D(APCLQUIT) DONE
- W !?60,"--------",!
- W ?52,"Total:",?60,$J(APCLTOT,8),!
- DONE ;
- D DONE^APCLOSUT
- K ^XTMP("APCLCZP",APCLJOB,APCLBTH)
- Q
- SORT ;
- I $Y>(IOSL-6) D HEAD Q:$D(APCLQUIT)
- W !,$P(^DIC(4,APCLVLOC,0),U) W:APCLPROC'="LOS" !
- S APCLSORT="" F S APCLSORT=$O(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT)) Q:APCLSORT=""!($D(APCLQUIT)) D P
- Q:$D(APCLQUIT)
- Q:APCLPROC="LOS"
- W !?60,"--------",!
- W ?40,"Location Subtotal:",?60,$J(^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC),8),!
- Q
- P ;
- S APCLCLNT=0
- S:'$D(^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)) ^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)=0
- I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
- S APCLSRT2=$O(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,""))
- S APCLPRNT=APCLSORT I APCLPROC="DATE" S Y=APCLPRNT D DD^%DT S APCLPRNT=Y
- W:APCLPROC'="LOS" !?5,$E(APCLPRNT,1,25)," (",APCLSRT2,")"
- S APCLCZP="" F S APCLCZP=$O(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP)) Q:APCLCZP="" D
- .W !?35,APCLCZP,?60,$J(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP),8)
- .S APCLCLNT=APCLCLNT+^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP)
- .S APCLTOT=APCLTOT+^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP)
- .S ^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)=^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)+^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP)
- W !!?40,"Clinic Total:",?60,$J(APCLCLNT,8)
- 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 !
- W ?58,APCLDT,?72,"Page ",APCLPG,!
- S APCLLENG=31+$L(APCLTITL)
- W ?((80-APCLLENG)/2),"NUMBER OF AMBULATORY VISITS BY ",APCLTITL,!
- S APCLLOCT=$S(APCLLOC="":"ALL",1:$P(^DIC(4,APCLLOC,0),U))
- S APCLLENG=21+$L(APCLLOCT)
- W ?((80-APCLLENG)/2),"LOCATION OF VISITS: ",APCLLOCT,!
- W ?18,"VISIT DATES: ",APCLBDD," TO ",APCLEDD,!
- W !,"LOCATION OF VISIT"
- W !?5,APCLHD1," (CODE)",?35,"ZIP CODE",?60,"# VISITS",!
- W APCL80S,!
- Q
- APCLCZPP ; IHS/CMI/LAB - print all visit report ;
- +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 FOR
- SET APCLVLOC=$ORDER(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC))
- IF APCLVLOC=""!($DATA(APCLQUIT))
- QUIT
- DO SORT
- +7 IF $DATA(APCLQUIT)
- GOTO DONE
- +8 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(APCLQUIT)
- GOTO DONE
- +9 WRITE !?60,"--------",!
- +10 WRITE ?52,"Total:",?60,$JUSTIFY(APCLTOT,8),!
- DONE ;
- +1 DO DONE^APCLOSUT
- +2 KILL ^XTMP("APCLCZP",APCLJOB,APCLBTH)
- +3 QUIT
- SORT ;
- +1 IF $Y>(IOSL-6)
- DO HEAD
- IF $DATA(APCLQUIT)
- QUIT
- +2 WRITE !,$PIECE(^DIC(4,APCLVLOC,0),U)
- IF APCLPROC'="LOS"
- WRITE !
- +3 SET APCLSORT=""
- FOR
- SET APCLSORT=$ORDER(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT))
- IF APCLSORT=""!($DATA(APCLQUIT))
- QUIT
- DO P
- +4 IF $DATA(APCLQUIT)
- QUIT
- +5 IF APCLPROC="LOS"
- QUIT
- +6 WRITE !?60,"--------",!
- +7 WRITE ?40,"Location Subtotal:",?60,$JUSTIFY(^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC),8),!
- +8 QUIT
- P ;
- +1 SET APCLCLNT=0
- +2 IF '$DATA(^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC))
- SET ^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)=0
- +3 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(APCLQUIT)
- QUIT
- +4 SET APCLSRT2=$ORDER(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,""))
- +5 SET APCLPRNT=APCLSORT
- IF APCLPROC="DATE"
- SET Y=APCLPRNT
- DO DD^%DT
- SET APCLPRNT=Y
- +6 IF APCLPROC'="LOS"
- WRITE !?5,$EXTRACT(APCLPRNT,1,25)," (",APCLSRT2,")"
- +7 SET APCLCZP=""
- FOR
- SET APCLCZP=$ORDER(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP))
- IF APCLCZP=""
- QUIT
- Begin DoDot:1
- +8 WRITE !?35,APCLCZP,?60,$JUSTIFY(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP),8)
- +9 SET APCLCLNT=APCLCLNT+^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP)
- +10 SET APCLTOT=APCLTOT+^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP)
- +11 SET ^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)=^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)+^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP)
- End DoDot:1
- +12 WRITE !!?40,"Clinic Total:",?60,$JUSTIFY(APCLCLNT,8)
- +13 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 !
- +3 WRITE ?58,APCLDT,?72,"Page ",APCLPG,!
- +4 SET APCLLENG=31+$LENGTH(APCLTITL)
- +5 WRITE ?((80-APCLLENG)/2),"NUMBER OF AMBULATORY VISITS BY ",APCLTITL,!
- +6 SET APCLLOCT=$SELECT(APCLLOC="":"ALL",1:$PIECE(^DIC(4,APCLLOC,0),U))
- +7 SET APCLLENG=21+$LENGTH(APCLLOCT)
- +8 WRITE ?((80-APCLLENG)/2),"LOCATION OF VISITS: ",APCLLOCT,!
- +9 WRITE ?18,"VISIT DATES: ",APCLBDD," TO ",APCLEDD,!
- +10 WRITE !,"LOCATION OF VISIT"
- +11 WRITE !?5,APCLHD1," (CODE)",?35,"ZIP CODE",?60,"# VISITS",!
- +12 WRITE APCL80S,!
- +13 QUIT
