APCLT1P ; IHS/CMI/LAB - print apc report ;
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
;IHS/TUCSON/LAB - added a header line to display appt/wi header 05/01/97
START ;
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 APCLCLN=0 K APCLQUIT
F S APCLCLN=$O(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN)) Q:APCLCLN=""!($D(APCLQUIT)) D P
G:$D(APCLQUIT) DONE
I $D(^XTMP("APCLT1",APCLJOB,APCLBTH,"OUTLIERS")) S APCLOUT=1 D HEAD
S APCLX=0 F S APCLX=$O(^XTMP("APCLT1",APCLJOB,APCLBTH,"OUTLIERS",APCLX)) Q:APCLX'=+APCLX!($D(APCLQUIT)) D
.I $Y>(IOSL-4) D HEAD Q:$D(APCLQUIT)
.S X=^XTMP("APCLT1",APCLJOB,APCLBTH,"OUTLIERS",APCLX)
.W !,$P(X,U),?16,$P(X,U,2),?47,$P(X,U,3),?62,$P(X,U,4)
.Q
DONE ;
D DONE^APCLOSUT
K ^XTMP("APCLT1",APCLJOB,APCLBTH),APCLOUT
Q
P ;
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
W !!,$P(^DIC(40.7,APCLCLN,0),U),?24,$J($P(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U),6),?32,$J($P(^(APCLCLN),U,2),6)
S T=$P(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,3),V=$P(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,2),M=$S(V:T/V/60,1:".")
W ?39,$J(M,6,1)
W:$P(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,4) ?46,$J($P(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,4)/60,6,1)
W:$P(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,5) ?53,$J($P(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,5)/60,6,1)
W ?63,$J($P(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,6),6),?71,$J($P(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,7),6)
;WRITE PROVIDER INFORMATION
S APCLX=0 F S APCLX=$O(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX)) Q:APCLX'=+APCLX!$D(APCLQUIT) D
.I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
.W !?3,$E($S($P(^DD(9000010.06,.01,0),U,2)[200:$P(^VA(200,APCLX,0),U),1:$P(^DIC(16,APCLX,0),U)),1,20),?24,$J($P(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U),6),?32,$J($P(^(APCLX),U,2),6)
.S T=$P(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U,3),V=$P(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U,2),M=$S(V:T/V/60,1:".")
.W ?39,$J(M,6,1)
.W:$P(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U,4) ?46,$J($P(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U,4)/60,6,1)
.W:$P(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U,5) ?53,$J($P(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U,5)/60,6,1)
.W ?63,$J($P(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U,6),6),?71,$J($P(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U,7),6)
.Q
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 !,$TR($J("",79)," ","*"),!
W "*",?3,$P(^DIC(4,DUZ(2),0),U),?58,APCLDT,?68,"Page ",APCLPG,?76,"*",!
W "*",?78,"*",!
W "*",?22,"WAITING TIMES BY CLINIC AND PROVIDER",?78,"*",!
S APCLLOCT=$P(^DIC(4,DUZ(2),0),U)
S APCLLENG=21+$L(APCLLOCT)
W "*",?((80-APCLLENG)/2),"LOCATION OF VISITS: ",APCLLOCT,?78,"*",!
W "*",?18,"REPORT DATE: ",APCLBDD," TO ",APCLEDD,?78,"*",!
W ?21,"Report includes ",$S(APCLAPWI="A":"APPOINTMENTS",1:"WALK INS")," only.",! ;IHS/TUCSON/LAB - patch 1 05/01/97
W $TR($J("",79)," ","*"),!!
I $G(APCLOUT) W ?10,"VISITS NOT COUNTED BECAUSE OF >240 MINUTE WAIT TIMES",!,"ARRIVAL TIME",?16,"PATIENT NAME",?47,"APPT TIME",?62,"PROV SEEN" Q
W !,"CLINIC",?24,"TOTAL",?32,"# VSTS",?41,"AVG",?48,"MIN",?55,"MAX",?61," #",?69," #",!
W ?24,"VISITS",?34,"USED",?41,"WAIT",?48,"WAIT",?55,"WAIT",?64,"EARLY",?72,"LATE",!
S X="",$P(X,"-",80)="" W X,!
Q
APCLT1P ; IHS/CMI/LAB - print apc report ;
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
+2 ;IHS/TUCSON/LAB - added a header line to display appt/wi header 05/01/97
START ;
+1 SET APCLDT=$$FMTE^XLFDT(DT)
+2 SET Y=APCLBD
DO DD^%DT
SET APCLBDD=Y
SET Y=APCLED
DO DD^%DT
SET APCLEDD=Y
+3 SET (APCLTOT,APCLPG)=0
DO HEAD
+4 SET APCLCLN=0
KILL APCLQUIT
+5 FOR
SET APCLCLN=$ORDER(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN))
IF APCLCLN=""!($DATA(APCLQUIT))
QUIT
DO P
+6 IF $DATA(APCLQUIT)
GOTO DONE
+7 IF $DATA(^XTMP("APCLT1",APCLJOB,APCLBTH,"OUTLIERS"))
SET APCLOUT=1
DO HEAD
+8 SET APCLX=0
FOR
SET APCLX=$ORDER(^XTMP("APCLT1",APCLJOB,APCLBTH,"OUTLIERS",APCLX))
IF APCLX'=+APCLX!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+9 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+10 SET X=^XTMP("APCLT1",APCLJOB,APCLBTH,"OUTLIERS",APCLX)
+11 WRITE !,$PIECE(X,U),?16,$PIECE(X,U,2),?47,$PIECE(X,U,3),?62,$PIECE(X,U,4)
+12 QUIT
End DoDot:1
DONE ;
+1 DO DONE^APCLOSUT
+2 KILL ^XTMP("APCLT1",APCLJOB,APCLBTH),APCLOUT
+3 QUIT
P ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+2 WRITE !!,$PIECE(^DIC(40.7,APCLCLN,0),U),?24,$JUSTIFY($PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U),6),?32,$JUSTIFY($PIECE(^(APCLCLN),U,2),6)
+3 SET T=$PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,3)
SET V=$PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,2)
SET M=$SELECT(V:T/V/60,1:".")
+4 WRITE ?39,$JUSTIFY(M,6,1)
+5 IF $PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,4)
WRITE ?46,$JUSTIFY($PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,4)/60,6,1)
+6 IF $PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,5)
WRITE ?53,$JUSTIFY($PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,5)/60,6,1)
+7 WRITE ?63,$JUSTIFY($PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,6),6),?71,$JUSTIFY($PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,7),6)
+8 ;WRITE PROVIDER INFORMATION
+9 SET APCLX=0
FOR
SET APCLX=$ORDER(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX))
IF APCLX'=+APCLX!$DATA(APCLQUIT)
QUIT
Begin DoDot:1
+10 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+11 WRITE !?3,$EXTRACT($SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:$PIECE(^VA(200,APCLX,0),U),1:$PIECE(^DIC(16,APCLX,0),U)),1,20),?24,$JUSTIFY($PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U),6),?32,$JUSTIFY($PIECE(^(APCLX),U
,2),6)
+12 SET T=$PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U,3)
SET V=$PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U,2)
SET M=$SELECT(V:T/V/60,1:".")
+13 WRITE ?39,$JUSTIFY(M,6,1)
+14 IF $PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U,4)
WRITE ?46,$JUSTIFY($PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U,4)/60,6,1)
+15 IF $PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U,5)
WRITE ?53,$JUSTIFY($PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U,5)/60,6,1)
+16 WRITE ?63,$JUSTIFY($PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U,6),6),?71,$JUSTIFY($PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLX),U,7),6)
+17 QUIT
End DoDot:1
+18 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 !,$TRANSLATE($JUSTIFY("",79)," ","*"),!
+3 WRITE "*",?3,$PIECE(^DIC(4,DUZ(2),0),U),?58,APCLDT,?68,"Page ",APCLPG,?76,"*",!
+4 WRITE "*",?78,"*",!
+5 WRITE "*",?22,"WAITING TIMES BY CLINIC AND PROVIDER",?78,"*",!
+6 SET APCLLOCT=$PIECE(^DIC(4,DUZ(2),0),U)
+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 ;IHS/TUCSON/LAB - patch 1 05/01/97
WRITE ?21,"Report includes ",$SELECT(APCLAPWI="A":"APPOINTMENTS",1:"WALK INS")," only.",!
+11 WRITE $TRANSLATE($JUSTIFY("",79)," ","*"),!!
+12 IF $GET(APCLOUT)
WRITE ?10,"VISITS NOT COUNTED BECAUSE OF >240 MINUTE WAIT TIMES",!,"ARRIVAL TIME",?16,"PATIENT NAME",?47,"APPT TIME",?62,"PROV SEEN"
QUIT
+13 WRITE !,"CLINIC",?24,"TOTAL",?32,"# VSTS",?41,"AVG",?48,"MIN",?55,"MAX",?61," #",?69," #",!
+14 WRITE ?24,"VISITS",?34,"USED",?41,"WAIT",?48,"WAIT",?55,"WAIT",?64,"EARLY",?72,"LATE",!
+15 SET X=""
SET $PIECE(X,"-",80)=""
WRITE X,!
+16 QUIT
