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

APCLADAP.m

Go to the documentation of this file. 
  1. APCLADAP ; IHS/CMI/LAB - PRINT CLINIC VISITS ;
  1.  ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
  1.  ;
  1. INIT ;initialize variables
  1.  S APCLSTOP="",APCLPAGE=0
  1.  I '$D(^XTMP("APCLADA",APCLJOB,APCLBT)) D HEAD W !,"No visits to report."  G END
  1.  S (APCLPGRD,APCLVGRA)=0
  1. SET ;
  1.  S APCLCLX=0
  1.  F  S APCLCLX=$O(^XTMP("APCLADA",APCLJOB,APCLBT,APCLCLX)) Q:APCLCLX=""!(APCLSTOP="^")  D SET2
  1.  G:APCLSTOP="^" END
  1.  D FINAL
  1. END ;
  1.  D DONE^APCLOSUT
  1.  K ^XTMP("APCLADA",APCLJOB,APCLBT)
  1.  Q
  1. SET2 ;
  1.  S (APCLNAME,APCLPTOT,APCLVTOT)=0 D HEAD
  1.  F  S APCLNAME=$O(^XTMP("APCLADA",APCLJOB,APCLBT,APCLCLX,APCLNAME)) Q:APCLNAME=""!(APCLSTOP="^")  S APCLDFN=0 D SET3
  1.  Q:APCLSTOP=U
  1.  D TOTALS
  1.  Q
  1. SET3 F  S APCLDFN=$O(^XTMP("APCLADA",APCLJOB,APCLBT,APCLCLX,APCLNAME,APCLDFN)) Q:APCLDFN=""!(APCLSTOP="^")  D SET4
  1.  Q
  1. SET4 ;
  1.  S (APCLVDT,APCLFVS)=0 ;visit date & first visit flag for line feed
  1.  ;set and print demographic data
  1.  S APCLPTOT=APCLPTOT+1 ;increment patient count for clinic
  1.  I $G(APCLLOC)]"",$D(^AUPNPAT(APCLDFN,41,APCLLOC,0)) S APCLHRCN=$P(^AUPNPAT(APCLDFN,41,APCLLOC,0),U,2) G SET41
  1.  S APCLHRCN=$P($G(^AUPNPAT(APCLDFN,41,DUZ(2),0)),U,2)
  1. SET41 K ^UTILITY("DIQ1",$J) S DIC=9000001,DA=APCLDFN,DR=1102.99 D EN^DIQ1
  1.  S APCLAGE=$G(^UTILITY("DIQ1",$J,9000001,APCLDFN,1102.99)) K ^UTILITY("DIQ1",$J)
  1.  I $Y>(IOSL-5) D PAGE Q:APCLSTOP="^"
  1.  W !,$E(APCLNAME,1,13),?15,$J(APCLHRCN,6),?23,$J(APCLAGE,2)
  1.  ;
  1.  ;find visit
  1.  F  S APCLVDT=$O(^XTMP("APCLADA",APCLJOB,APCLBT,APCLCLX,APCLNAME,APCLDFN,APCLVDT)) Q:APCLVDT=""  S APCLVDFN=0 D SET5
  1.  Q
  1. SET5 ;
  1.  F  S APCLVDFN=$O(^XTMP("APCLADA",APCLJOB,APCLBT,APCLCLX,APCLNAME,APCLDFN,APCLVDT,APCLVDFN)) Q:APCLVDFN=""!(APCLSTOP="^")  D PRNT
  1.  Q
  1. PRNT ;
  1.  S APCLVTOT=APCLVTOT+1 ;increment visit count
  1.  I APCLFVS W ! I $Y>(IOSL-5) D PAGE Q:APCLSTOP="^"
  1.  S APCLPOVC=0,APCLFVS=1,APCLFPV=0
  1.  W ?26,$E(APCLVDT,4,5),"/",$E(APCLVDT,6,7),"/",$E(APCLVDT,2,3)_" "_$E($P(APCLVDT,".",2)_"0000",1,4)
  1.  ;
  1.  ;set and print provider class code
  1.  S APCLPRV=0
  1. PRV S APCLPRV=$O(^AUPNVPRV("AD",APCLVDFN,APCLPRV))
  1.  I APCLPRV="" S APCLPV=0,APCLPOVC=0 K APCLNARR G POV
  1.  G PRV:'$D(^AUPNVPRV(APCLPRV,0)),PRV:$P(^(0),"^",4)'="P"
  1.  S X=+^AUPNVPRV(APCLPRV,0)
  1.  I $P(^DD(9000010.06,.01,0),U,2)[6 S X=$P(^DIC(6,X,0),"^",4),APCLCLS=$S(X="":"",'$D(^DIC(7,X,9999999)):"",1:$P(^DIC(7,X,9999999),"^"))
  1.  I $P(^DD(9000010.06,.01,0),U,2)[200 S APCLCLS=$$PROVCLSC^XBFUNC1(X)
  1.  W ?41,APCLCLS
  1.  ;
  1.  ;
  1.  S APCLPV=0,APCLPOVC=0 K APCLNARR
  1. POV S APCLPV=$O(^AUPNVPOV("AD",APCLVDFN,APCLPV))
  1.  I APCLPV="" S APCLVDEN=0,APCLPOVC=1 G ADA
  1.  G POV:'$D(^AUPNVPOV(APCLPV,0)) S APCLSTR=^(0)
  1.  S APCLNAR=$$VAL^XBDIQ1(9000010.07,APCLPV,.04)
  1.  ;S APCLNAR=$S(APCLNAR="":"",$D(^AUTNPOV(APCLNAR,0)):$P(^(0),"^"),1:"")
  1.  S APCLPOVC=APCLPOVC+1
  1.  S APCLNARR(APCLPOVC)=$E(APCLNAR,1,26)
  1.  G POV
  1.  ;
  1.  ;set and print procedures
  1. ADA S APCLVDEN=$O(^AUPNVDEN("AD",APCLVDFN,APCLVDEN))
  1.  Q:APCLVDEN=""
  1.  G ADA:'$D(^AUPNVDEN(APCLVDEN,0)) S APCLSTR=^(0)
  1.  S APCLADA=+APCLSTR
  1.  S APCLADA=$S(APCLADA="":"",1:$P(^AUTTADA(APCLADA,0),"^"))
  1.  I APCLFPV W ! I $Y>(IOSL-5) D PAGE Q:APCLSTOP="^"  W !
  1.  I 'APCLFPV S APCLFPV=1
  1.  W ?45,APCLADA,?53,$S($D(APCLNARR(APCLPOVC)):APCLNARR(APCLPOVC),1:"") S APCLPOVC=APCLPOVC+1
  1.  G ADA
  1.  ;
  1. FINAL ;print grand totals
  1.  G END:APCLCL'="A"
  1.  D HEAD
  1.  W !!?39,"TOTAL PATIENTS:  ",APCLPGRD
  1.  W !!?41,"TOTAL VISITS:  ",APCLVGRA
  1.  Q
  1.  ;
  1. TOTALS ;print totals
  1.  I $Y>(IOSL-5) D PAGE
  1.  W !!?28,"TOTAL PATIENTS FOR CLINIC:  ",APCLPTOT
  1.  W !!?30,"TOTAL VISITS FOR CLINIC:  ",APCLVTOT
  1.  S APCLPGRD=APCLPGRD+APCLPTOT,APCLVGRA=APCLVGRA+APCLVTOT
  1.  Q:IOST'?1"C-".E
  1.  ;R !!,"Enter <return> to continue or '^' to stop",APCLSTOP:DTIME
  1.  I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I $D(DIRUT) S APCLSTOP="^" Q
  1.  Q
  1.  ;
  1.  W:$D(IOF) @IOF,!?11,"*****Confidential Patient Data Covered by Privacy Act*****",!
  1.  S X=$P(^DIC(4,DUZ(2),0),"^"),APCLPAGE=APCLPAGE+1
  1.  W !!,$P(^VA(200,DUZ,0),"^",2),?(80-$L(X)/2),X,?72,"Page ",APCLPAGE
  1.  S X=$P($H,",",2) D TIME W !,Y
  1.  I $G(APCLCLX)="" S X="No Clinic data to report" G HD1
  1.  I APCLCLX="E" S X="VISITS WITH NO ASSIGNED CLINIC CODE" G HD1
  1.  I APCLCLX]"" S X="CLINIC VISITS FOR "_$P(^DIC(40.7,APCLCLX,0),"^")_" ("_$P(^(0),"^",2)_")" W ?(80-$L(X)/2),X
  1. HD1 S Y=DT X ^DD("DD") W !,Y
  1.  ;begin Y2K
  1.  ;W ?28,"for ",$E(APCLBD,4,5),"/",$E(APCLBD,6,7),"/",$E(APCLBD,2,3) ;Y2000
  1.  ;W " to ",$E(APCLED,4,5),"/",$E(APCLED,6,7),"/",$E(APCLED,2,3) ;Y2000
  1.  W ?23,"for ",$$FMTE^XLFDT(APCLBD)," to ",$$FMTE^XLFDT(APCLED) ;Y2000
  1.  ;end Y2K
  1.  W !!,"NAME",?16,"HRCN",?22,"AGE",?27,"VISIT DATE",?41,"PRV",?46,"ADA",?53,"PROV NARRATIVE",!
  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 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