- APCLAP2P ; IHS/CMI/LAB - print all visit report ;
- ;;2.0;IHS PCC SUITE;**7,20**;MAY 14, 2009;Build 25
- 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("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC)) Q:APCLVLOC=""!($D(APCLQUIT)) D SORT
- I APCLTOTL,APCLPROC'="LOS" D
- .S APCLGTOT=0
- .S APCLLTT="ALL LOCATIONS COMBINED"
- .I $Y>(IOSL-6) D HEAD Q:$D(APCLQUIT)
- .W !,APCLLTT W:APCLPROC'="LOS" !
- .S APCLSORT="" F S APCLSORT=$O(^XTMP("APCLAP2",APCLJOB,APCLBTH,"ALLLOC",APCLSORT)) Q:APCLSORT=""!($D(APCLQUIT)) D
- ..S APCLSRT2="" F S APCLSRT2=$O(^XTMP("APCLAP2",APCLJOB,APCLBTH,"ALLLOC",APCLSORT,APCLSRT2)) Q:APCLSRT2=""!($D(APCLQUIT)) D
- ...I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
- ...S APCLPRNT=APCLSORT I APCLPROC="DATE" S Y=APCLPRNT D DD^%DT S APCLPRNT=Y
- ...W:APCLPROC'="LOS" !?5,$E(APCLPRNT,1,25) W ?35,$E(APCLSRT2,1,20),?60,$J(^XTMP("APCLAP2",APCLJOB,APCLBTH,"ALLLOC",APCLSORT,APCLSRT2),8)
- ...S APCLGTOT=APCLGTOT+^XTMP("APCLAP2",APCLJOB,APCLBTH,"ALLLOC",APCLSORT,APCLSRT2)
- .Q:APCLPROC="LOS"
- .;W !?60,"--------",!
- .;W ?50,"TOTAL:",?60,$J(APCLGTOT,8),!
- 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("APCLAP2",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("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT)) Q:APCLSORT=""!($D(APCLQUIT)) D P
- Q:APCLPROC="LOS"
- W !?60,"--------",!
- W ?50,"Subtotal:",?60,$J(^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC),8),!
- Q
- P ;
- S APCLSRT2="" F S APCLSRT2=$O(^XTMP("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2)) Q:APCLSRT2=""!($D(APCLQUIT)) D
- .S:'$D(^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)) ^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)=0
- .I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
- .;S APCLSRT2=$O(^XTMP("APCLAP2",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) W ?35,$E(APCLSRT2,1,20),?60,$J(^XTMP("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2),8)
- .S APCLTOT=APCLTOT+^XTMP("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2)
- .S ^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)=^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)+^XTMP("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,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 !
- 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=0:"ALL",1:"SELECTED")
- S APCLLENG=21+$L(APCLLOCT)
- W ?((80-APCLLENG)/2),"LOCATION OF VISITS: ",APCLLOCT,!
- S X="Chart Reviews are "_$S('APCLCRYN:"not ",1:"")_"included." W $$CTR(X,80),!
- W ?18,"VISIT DATES: ",APCLBDD," TO ",APCLEDD,!
- W !,"LOCATION OF VISIT"
- W !?5,APCLHD1,?35,APCLHD2,?60,"# VISITS",!
- W APCL80S,!
- Q
- ;
- CTR(X,Y) ;EP - Center X in a field Y wide.
- Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
- ;----------
- APCLAP2P ; IHS/CMI/LAB - print all visit report ;
- +1 ;;2.0;IHS PCC SUITE;**7,20**;MAY 14, 2009;Build 25
- 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("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC))
- IF APCLVLOC=""!($DATA(APCLQUIT))
- QUIT
- DO SORT
- +7 IF APCLTOTL
- IF APCLPROC'="LOS"
- Begin DoDot:1
- +8 SET APCLGTOT=0
- +9 SET APCLLTT="ALL LOCATIONS COMBINED"
- +10 IF $Y>(IOSL-6)
- DO HEAD
- IF $DATA(APCLQUIT)
- QUIT
- +11 WRITE !,APCLLTT
- IF APCLPROC'="LOS"
- WRITE !
- +12 SET APCLSORT=""
- FOR
- SET APCLSORT=$ORDER(^XTMP("APCLAP2",APCLJOB,APCLBTH,"ALLLOC",APCLSORT))
- IF APCLSORT=""!($DATA(APCLQUIT))
- QUIT
- Begin DoDot:2
- +13 SET APCLSRT2=""
- FOR
- SET APCLSRT2=$ORDER(^XTMP("APCLAP2",APCLJOB,APCLBTH,"ALLLOC",APCLSORT,APCLSRT2))
- IF APCLSRT2=""!($DATA(APCLQUIT))
- QUIT
- Begin DoDot:3
- +14 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(APCLQUIT)
- QUIT
- +15 SET APCLPRNT=APCLSORT
- IF APCLPROC="DATE"
- SET Y=APCLPRNT
- DO DD^%DT
- SET APCLPRNT=Y
- +16 IF APCLPROC'="LOS"
- WRITE !?5,$EXTRACT(APCLPRNT,1,25)
- WRITE ?35,$EXTRACT(APCLSRT2,1,20),?60,$JUSTIFY(^XTMP("APCLAP2",APCLJOB,APCLBTH,"ALLLOC",APCLSORT,APCLSRT2),8)
- +17 SET APCLGTOT=APCLGTOT+^XTMP("APCLAP2",APCLJOB,APCLBTH,"ALLLOC",APCLSORT,APCLSRT2)
- End DoDot:3
- End DoDot:2
- +18 IF APCLPROC="LOS"
- QUIT
- +19 ;W !?60,"--------",!
- +20 ;W ?50,"TOTAL:",?60,$J(APCLGTOT,8),!
- End DoDot:1
- +21 IF $DATA(APCLQUIT)
- GOTO DONE
- +22 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(APCLQUIT)
- GOTO DONE
- +23 WRITE !?60,"--------",!
- +24 WRITE ?52,"Total:",?60,$JUSTIFY(APCLTOT,8),!
- DONE ;
- +1 DO DONE^APCLOSUT
- +2 KILL ^XTMP("APCLAP2",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("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT))
- IF APCLSORT=""!($DATA(APCLQUIT))
- QUIT
- DO P
- +4 IF APCLPROC="LOS"
- QUIT
- +5 WRITE !?60,"--------",!
- +6 WRITE ?50,"Subtotal:",?60,$JUSTIFY(^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC),8),!
- +7 QUIT
- P ;
- +1 SET APCLSRT2=""
- FOR
- SET APCLSRT2=$ORDER(^XTMP("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2))
- IF APCLSRT2=""!($DATA(APCLQUIT))
- QUIT
- Begin DoDot:1
- +2 IF '$DATA(^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC))
- SET ^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)=0
- +3 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(APCLQUIT)
- QUIT
- +4 ;S APCLSRT2=$O(^XTMP("APCLAP2",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)
- WRITE ?35,$EXTRACT(APCLSRT2,1,20),?60,$JUSTIFY(^XTMP("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2),8)
- +7 SET APCLTOT=APCLTOT+^XTMP("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2)
- +8 SET ^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)=^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)+^XTMP("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2)
- End DoDot:1
- +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 !
- +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=0:"ALL",1:"SELECTED")
- +7 SET APCLLENG=21+$LENGTH(APCLLOCT)
- +8 WRITE ?((80-APCLLENG)/2),"LOCATION OF VISITS: ",APCLLOCT,!
- +9 SET X="Chart Reviews are "_$SELECT('APCLCRYN:"not ",1:"")_"included."
- WRITE $$CTR(X,80),!
- +10 WRITE ?18,"VISIT DATES: ",APCLBDD," TO ",APCLEDD,!
- +11 WRITE !,"LOCATION OF VISIT"
- +12 WRITE !?5,APCLHD1,?35,APCLHD2,?60,"# VISITS",!
- +13 WRITE APCL80S,!
- +14 QUIT
- +15 ;
- CTR(X,Y) ;EP - Center X in a field Y wide.
- +1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
- +2 ;----------
