- 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