- 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
