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
APCLYV41 ; IHS/CMI/LAB - CLINIC VISIT COUNTS (CALC) ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
CALC ;find visits by date then store counts by date
+1 SET APCLJOB=$JOB
SET APCLBT=$HOROLOG
+2 DO XTMP^APCLOSUT("APCLYV4","PCC REPORT - CLINIC VISIT COUNTS")
+3 ;
+4 SET APCLVDT=APCLBD-.0001
VST SET APCLVDT=$ORDER(^AUPNVSIT("B",APCLVDT))
+1 IF APCLVDT=""
GOTO NEXT
IF APCLVDT>(APCLED+.2359)
GOTO NEXT
SET APCLVDFN=0
VST1 SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLVDT,APCLVDFN))
IF APCLVDFN=""
GOTO VST
+1 ;
+2 IF '$DATA(^AUPNVSIT(APCLVDFN,0))
GOTO VST1
SET APCLSTR=^(0)
+3 ;screen out deleted visits
IF $PIECE(APCLSTR,"^",11)
GOTO VST1
+4 ;screen out other facilities
IF $PIECE(APCLSTR,"^",6)'=DUZ(2)
GOTO VST1
+5 ;screen out hospitalizations
IF $PIECE(APCLSTR,"^",7)="H"
GOTO VST1
+6 IF $$DEMO^APCLUTL($PIECE(APCLSTR,U,5),$GET(APCLDEMO))
GOTO VST1
+7 IF APCLCL'="A"
IF $PIECE(APCLSTR,"^",8)'=APCLCL
GOTO VST1
+8 SET APCLCLX=$SELECT(APCLCL=+APCLCL:APCLCL,1:+$PIECE(APCLSTR,"^",8))
+9 IF APCLCLX=0
SET APCLCLX="E"
+10 SET X=$SELECT(APCLCLX="E":"EMPTY",$DATA(^DIC(40.7,APCLCLX,0)):$PIECE(^(0),"^"),1:"??")
+11 SET APCLVDAT=$PIECE(APCLVDT,".")
+12 ;
+13 ;
+14 SET ^XTMP("APCLYV4",APCLJOB,APCLBT,X,APCLCLX,APCLVDAT)=$SELECT($DATA(^XTMP("APCLYV4",APCLJOB,APCLBT,X,APCLCLX,APCLVDAT)):^(APCLVDAT)+1,1:1)
+15 GOTO VST1
+16 ;
NEXT ;
+1 SET APCLET=$HOROLOG
+2 QUIT