Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCLYV62

APCLYV62.m

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