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

APCLYV41.m

Go to the documentation of this file.
APCLYV41 ; IHS/CMI/LAB - CLINIC VISIT COUNTS (CALC) ;
 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
 ;
CALC ;find visits by date then store counts by date
 S APCLJOB=$J,APCLBT=$H
 D XTMP^APCLOSUT("APCLYV4","PCC REPORT - CLINIC VISIT COUNTS")
 ;
 S APCLVDT=APCLBD-.0001
VST S APCLVDT=$O(^AUPNVSIT("B",APCLVDT))
 G NEXT:APCLVDT="",NEXT:APCLVDT>(APCLED+.2359) S APCLVDFN=0
VST1 S APCLVDFN=$O(^AUPNVSIT("B",APCLVDT,APCLVDFN)) G VST:APCLVDFN=""
 ;
 G VST1:'$D(^AUPNVSIT(APCLVDFN,0)) S APCLSTR=^(0)
 G VST1:$P(APCLSTR,"^",11) ;screen out deleted visits
 G VST1:$P(APCLSTR,"^",6)'=DUZ(2) ;screen out other facilities
 G VST1:$P(APCLSTR,"^",7)="H" ;screen out hospitalizations
 G VST1:$$DEMO^APCLUTL($P(APCLSTR,U,5),$G(APCLDEMO))
 I APCLCL'="A" G VST1:$P(APCLSTR,"^",8)'=APCLCL
 S APCLCLX=$S(APCLCL=+APCLCL:APCLCL,1:+$P(APCLSTR,"^",8))
 S:APCLCLX=0 APCLCLX="E"
 S X=$S(APCLCLX="E":"EMPTY",$D(^DIC(40.7,APCLCLX,0)):$P(^(0),"^"),1:"??")
 S APCLVDAT=$P(APCLVDT,".")
 ;
 ;
 S ^XTMP("APCLYV4",APCLJOB,APCLBT,X,APCLCLX,APCLVDAT)=$S($D(^XTMP("APCLYV4",APCLJOB,APCLBT,X,APCLCLX,APCLVDAT)):^(APCLVDAT)+1,1:1)
 G VST1
 ;
NEXT ;
 S APCLET=$H
 Q