- 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 ;----------