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

APCLYV42.m

Go to the documentation of this file.
  1. APCLYV42 ; IHS/CMI/LAB - CLINIC VISIT COUNTS PRINT ;
  1. ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1. ;
  1. INIT ;initialize variables
  1. I APCLBD=APCLED,(APCLCL="A") G ^APCLYV43 ;print rtn for one date & all clinics
  1. I '$D(^XTMP("APCLYV4",APCLJOB,APCLBT)) S APCLPAGE=0,APCLSTOP="" D HEAD0
  1. S APCLPAGE=0,APCLSTOP="",APCLTOT=0 ;total count
  1. ;
  1. SET ;set up print fields
  1. S APCLCLP=0
  1. SET0 S APCLCLP=$O(^XTMP("APCLYV4",APCLJOB,APCLBT,APCLCLP)) G FINAL:APCLCLP=""
  1. S APCLCLX=0
  1. SET1 S APCLCLX=$O(^XTMP("APCLYV4",APCLJOB,APCLBT,APCLCLP,APCLCLX)) G SET0:APCLCLX=""
  1. S (APCLVDT,APCLCTOT)=0 D HEAD
  1. SET2 S APCLVDT=$O(^XTMP("APCLYV4",APCLJOB,APCLBT,APCLCLP,APCLCLX,APCLVDT))
  1. I APCLVDT="" D TOTALS G END:APCLSTOP="^",SET1
  1. S APCLCNT=^XTMP("APCLYV4",APCLJOB,APCLBT,APCLCLP,APCLCLX,APCLVDT),APCLCTOT=APCLCTOT+APCLCNT
  1. I $Y>(IOSL-5) D PAGE G:APCLSTOP="^" END
  1. W !?21,$E(APCLVDT,4,5),"/",$E(APCLVDT,6,7),"/",$E(APCLVDT,2,3)
  1. W ?45,$J(APCLCNT,5) G SET2
  1. ;
  1. FINAL ;print grand totals
  1. G END:APCLCL'="A"
  1. I $Y>(IOSL-5) D PAGE G:APCLSTOP="^" END
  1. W !!?30,"TOTAL VISITS: ",$J(APCLTOT,5),!!
  1. END ;
  1. D DONE^APCLOSUT
  1. K APCLCTOT,APCLTOT,APCLCLX,APCLVDT,APCLPAGE,APCLSTOP,APCLCNT,APCLCLP
  1. W:IOST'?1"C-".E @IOF
  1. K ^XTMP("APCLYV4",APCLJOB,APCLBT)
  1. Q
  1. ;
  1. TOTALS ;print totals
  1. I $Y>(IOSL-5) D PAGE G:APCLSTOP="^" END
  1. W !!?21,"TOTAL VISITS FOR CLINIC:",?45,$J(APCLCTOT,5)
  1. S APCLTOT=APCLTOT+APCLCTOT
  1. ;
  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 Y="" I $G(APCLCLX)]"" S Y=$S($D(^DIC(40.7,APCLCLX,0)):$P(^(0),"^",2),1:"??") ;clinic code
  1. S X="VISIT COUNTS FOR "_APCLCLP_" ("_Y_") "_"CLINIC"
  1. W ?(80-$L(X)/2),X
  1. S Y=DT X ^DD("DD") W !,Y
  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 !!?20,"VISIT DATES",?41,"NUMBER OF VISITS"
  1. Q
  1. ;
  1. HEAD0 ;EP
  1. W:$D(IOF) @IOF S X=$P(^DIC(4,DUZ(2),0),"^"),APCLPAGE=APCLPAGE+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 Y="" I $G(APCLCLX)]"" S Y=$S($D(^DIC(40.7,APCLCLX,0)):$P(^(0),"^",2),1:"??") ;clinic code
  1. S Y=DT X ^DD("DD") W !,Y
  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 !!!!,"NUMBER OF VISITS: ","No visits to report." G END
  1. PAGE ;form feed to new page
  1. I IOST'?1"C-".E D HEAD Q
  1. ;
  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 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