APCLYV62 ; IHS/CMI/LAB - VISIT COUNTS BY PROV PRINT ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
INIT ;initialize variables
I '$D(^XTMP("APCLYV6",APCLJOB,APCLBT)) S APCLPAGE=0 D HEAD W !,"No data to report." G END
S APCLSTOP="",APCLPAGE=0
S APCLTOT=0 ;total count
;
SET ;set up print fields
S APCLCS=0
SET1 S APCLCS=$O(^XTMP("APCLYV6",APCLJOB,APCLBT,APCLCS)) G FINAL:APCLCS=""
S APCLPRN=0
SET2 S APCLPRN=$O(^XTMP("APCLYV6",APCLJOB,APCLBT,APCLCS,APCLPRN)) G SET1:APCLPRN=""
S APCLPR=0
SET3 S APCLPR=$O(^XTMP("APCLYV6",APCLJOB,APCLBT,APCLCS,APCLPRN,APCLPR)) G SET2:APCLPR=""
S (APCLVDAT,APCLPCNT)=0 D HEAD
SET4 S APCLVDAT=$O(^XTMP("APCLYV6",APCLJOB,APCLBT,APCLCS,APCLPRN,APCLPR,APCLVDAT))
I APCLVDAT="" D TOTALS G END:APCLSTOP="^" G SET3
S (APCLCL,APCLFLG)=0
SET5 S APCLCL=$O(^XTMP("APCLYV6",APCLJOB,APCLBT,APCLCS,APCLPRN,APCLPR,APCLVDAT,APCLCL)) G SET4:APCLCL="" S APCLCNT=^(APCLCL),APCLPCNT=APCLPCNT+APCLCNT
I $Y>(IOSL-5) D PAGE
G:APCLSTOP="^" END
I 'APCLFLG W !,$E(APCLVDAT,4,5),"/",$E(APCLVDAT,6,7),"/",$E(APCLVDAT,2,3)
W:APCLFLG ! W ?15,APCLCL,?60,$J(APCLCNT,5) S APCLFLG=1 G SET5
;
FINAL ;print grand totals
I $Y>(IOSL-5) D PAGE
W !!?30,"TOTAL PROVIDER ENTRIES: ",?60,$J(APCLTOT,5),!!
END ;
D DONE^APCLOSUT
K APCLPCNT,APCLTOT,APCLCL,APCLVDAT,APCLPAGE,APCLSTOP,APCLCNT
K APCLCS,APCLPRN,APCLPR,APCLPCNT,APCLBD,APCLED,APCLFLG,APCLS
K APCLPDFN,APCLPRV,APCLSTR
K ^XTMP("APCLYV6",APCLJOB,APCLBT)
Q
;
TOTALS ;print totals
I $Y>(IOSL-5) D PAGE
W !!?21,"TOTAL VISITS FOR PROVIDER:",?60,$J(APCLPCNT,5)
S APCLTOT=APCLTOT+APCLPCNT
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="E" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLSTOP="^" Q
Q
;
HEAD W:$D(IOF) @IOF S X=$P(^DIC(4,DUZ(2),0),"^"),APCLPAGE=APCLPAGE+1
W !!,$P(^VA(200,DUZ,0),"^",2),?(80-$L(X)/2),X,?70,"Page ",APCLPAGE
S X=$P($H,",",2) D TIME W !,Y
S:'$D(APCLPRN) APCLPRN="" S X="VISIT COUNTS FOR "_APCLPRN W ?(80-$L(X)/2),X
S:'$D(APCLCS) APCLCS="" S Y=DT X ^DD("DD") W !,Y,?80-$L(APCLCS)\2,"(",APCLCS,")"
S X="Service Categories: " S Y="" F S Y=$O(APCLSCAT(Y)) Q:Y="" S X=X_Y_";"
W !,$$CTR(X,80)
W !?28,"for ",$E(APCLBD,4,5),"/",$E(APCLBD,6,7),"/",$E(APCLBD,2,3)
W " to ",$E(APCLED,4,5),"/",$E(APCLED,6,7),"/",$E(APCLED,2,3)
W !!,"VISIT DATES",?15,"CLINIC",?60,"NUMBER OF VISITS"
W !,"-----------",?15,"------",?60,"----------------"
Q
;
PAGE ;form feed to new page
I IOST'?1"C-".E D HEAD Q
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="E" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLSTOP="^" Q
I APCLSTOP'="^" D HEAD
Q
TIME NEW %A,%B,%C S Y="" Q:'$D(X) Q:X<0!(X>86400)
S %A=X\60,%B=%A\60 S:%B>12 %B=%B-12 S:%B=0 %B=12 S:%B<10 %B=" "_%B
S %C=$S(%A=0:"M ",%A=720:"N ",%A=1440:"M ",%A<720:"am",1:"pm")
S Y=%B_":"_$E(%A#60+100,2,3)_" "_%C K %A,%B,%C Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
APCLYV62 ; IHS/CMI/LAB - VISIT COUNTS BY PROV PRINT ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
INIT ;initialize variables
+1 IF '$DATA(^XTMP("APCLYV6",APCLJOB,APCLBT))
SET APCLPAGE=0
DO HEAD
WRITE !,"No data to report."
GOTO END
+2 SET APCLSTOP=""
SET APCLPAGE=0
+3 ;total count
SET APCLTOT=0
+4 ;
SET ;set up print fields
+1 SET APCLCS=0
SET1 SET APCLCS=$ORDER(^XTMP("APCLYV6",APCLJOB,APCLBT,APCLCS))
IF APCLCS=""
GOTO FINAL
+1 SET APCLPRN=0
SET2 SET APCLPRN=$ORDER(^XTMP("APCLYV6",APCLJOB,APCLBT,APCLCS,APCLPRN))
IF APCLPRN=""
GOTO SET1
+1 SET APCLPR=0
SET3 SET APCLPR=$ORDER(^XTMP("APCLYV6",APCLJOB,APCLBT,APCLCS,APCLPRN,APCLPR))
IF APCLPR=""
GOTO SET2
+1 SET (APCLVDAT,APCLPCNT)=0
DO HEAD
SET4 SET APCLVDAT=$ORDER(^XTMP("APCLYV6",APCLJOB,APCLBT,APCLCS,APCLPRN,APCLPR,APCLVDAT))
+1 IF APCLVDAT=""
DO TOTALS
IF APCLSTOP="^"
GOTO END
GOTO SET3
+2 SET (APCLCL,APCLFLG)=0
SET5 SET APCLCL=$ORDER(^XTMP("APCLYV6",APCLJOB,APCLBT,APCLCS,APCLPRN,APCLPR,APCLVDAT,APCLCL))
IF APCLCL=""
GOTO SET4
SET APCLCNT=^(APCLCL)
SET APCLPCNT=APCLPCNT+APCLCNT
+1 IF $Y>(IOSL-5)
DO PAGE
+2 IF APCLSTOP="^"
GOTO END
+3 IF 'APCLFLG
WRITE !,$EXTRACT(APCLVDAT,4,5),"/",$EXTRACT(APCLVDAT,6,7),"/",$EXTRACT(APCLVDAT,2,3)
+4 IF APCLFLG
WRITE !
WRITE ?15,APCLCL,?60,$JUSTIFY(APCLCNT,5)
SET APCLFLG=1
GOTO SET5
+5 ;
FINAL ;print grand totals
+1 IF $Y>(IOSL-5)
DO PAGE
+2 WRITE !!?30,"TOTAL PROVIDER ENTRIES: ",?60,$JUSTIFY(APCLTOT,5),!!
END ;
+1 DO DONE^APCLOSUT
+2 KILL APCLPCNT,APCLTOT,APCLCL,APCLVDAT,APCLPAGE,APCLSTOP,APCLCNT
+3 KILL APCLCS,APCLPRN,APCLPR,APCLPCNT,APCLBD,APCLED,APCLFLG,APCLS
+4 KILL APCLPDFN,APCLPRV,APCLSTR
+5 KILL ^XTMP("APCLYV6",APCLJOB,APCLBT)
+6 QUIT
+7 ;
TOTALS ;print totals
+1 IF $Y>(IOSL-5)
DO PAGE
+2 WRITE !!?21,"TOTAL VISITS FOR PROVIDER:",?60,$JUSTIFY(APCLPCNT,5)
+3 SET APCLTOT=APCLTOT+APCLPCNT
+4 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLSTOP="^"
QUIT
+5 QUIT
+6 ;
HEAD IF $DATA(IOF)
WRITE @IOF
SET X=$PIECE(^DIC(4,DUZ(2),0),"^")
SET APCLPAGE=APCLPAGE+1
+1 WRITE !!,$PIECE(^VA(200,DUZ,0),"^",2),?(80-$LENGTH(X)/2),X,?70,"Page ",APCLPAGE
+2 SET X=$PIECE($HOROLOG,",",2)
DO TIME
WRITE !,Y
+3 IF '$DATA(APCLPRN)
SET APCLPRN=""
SET X="VISIT COUNTS FOR "_APCLPRN
WRITE ?(80-$LENGTH(X)/2),X
+4 IF '$DATA(APCLCS)
SET APCLCS=""
SET Y=DT
XECUTE ^DD("DD")
WRITE !,Y,?80-$LENGTH(APCLCS)\2,"(",APCLCS,")"
+5 SET X="Service Categories: "
SET Y=""
FOR
SET Y=$ORDER(APCLSCAT(Y))
IF Y=""
QUIT
SET X=X_Y_";"
+6 WRITE !,$$CTR(X,80)
+7 WRITE !?28,"for ",$EXTRACT(APCLBD,4,5),"/",$EXTRACT(APCLBD,6,7),"/",$EXTRACT(APCLBD,2,3)
+8 WRITE " to ",$EXTRACT(APCLED,4,5),"/",$EXTRACT(APCLED,6,7),"/",$EXTRACT(APCLED,2,3)
+9 WRITE !!,"VISIT DATES",?15,"CLINIC",?60,"NUMBER OF VISITS"
+10 WRITE !,"-----------",?15,"------",?60,"----------------"
+11 QUIT
+12 ;
PAGE ;form feed to new page
+1 IF IOST'?1"C-".E
DO HEAD
QUIT
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLSTOP="^"
QUIT
+3 IF APCLSTOP'="^"
DO HEAD
+4 QUIT
TIME NEW %A,%B,%C
SET Y=""
IF '$DATA(X)
QUIT
IF X<0!(X>86400)
QUIT
+1 SET %A=X\60
SET %B=%A\60
IF %B>12
SET %B=%B-12
IF %B=0
SET %B=12
IF %B<10
SET %B=" "_%B
+2 SET %C=$SELECT(%A=0:"M ",%A=720:"N ",%A=1440:"M ",%A<720:"am",1:"pm")
+3 SET Y=%B_":"_$EXTRACT(%A#60+100,2,3)_" "_%C
KILL %A,%B,%C
QUIT
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 ;----------
