- APCLYV61 ; IHS/CMI/LAB - VISIT COUNTS BY PROV (CALC) ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;
- CALC ;find provider entries by date then store counts
- S APCLJOB=$J,APCLBT=$H
- D XTMP^APCLOSUT("APCLYV6","PCC PROVIDER 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:$$DEMO^APCLUTL($P(APCLSTR,U,5),$G(APCLDEMO))
- I $G(APCLLOC),$P(APCLSTR,"^",6)'=APCLLOC G VST1 ;screen out other facilities
- G VST1:"DHXEI"[$P(APCLSTR,"^",7)
- S X=$P(APCLSTR,U,7)
- I X="" G VST1
- I '$D(APCLSCAT(X)) G VST1 ;don't want this service category
- G:"CV"[$P(APCLSTR,"^",3) VST1 ;LAB/TUCSON CHANGED CV TO C FOR VA
- S APCLPDFN=0 ;find providers for selected visits
- VST2 S APCLPDFN=$O(^AUPNVPRV("AD",APCLVDFN,APCLPDFN)) G VST1:APCLPDFN=""
- G VST2:'$D(^AUPNVPRV(APCLPDFN,0)) S APCLPR=$P(^(0),"^")
- I APCLS=1 G VST2:APCLPR'=+APCLPRV ;screen for one provider
- I $P(^DD(9000010.06,.01,0),U,2)[6 S APCLCS=$S($D(^DIC(6,APCLPR,0)):$P(^(0),"^",4),1:"")
- I $P(^DD(9000010.06,.01,0),U,2)[200 S APCLCS=$$PROVCLS^XBFUNC1(APCLPR,"I") I APCLCS="UNKNOWN" S APCLCS="" ;IHS/CMI/LAB
- I APCLS=2 G VST2:APCLCS'=+APCLPRV
- S APCLPRN=$E($S($P(^DD(9000010.06,.01,0),U,2)[200:$P(^VA(200,APCLPR,0),U),1:$P(^DIC(16,APCLPR,0),"^")),1,20) ;provider name
- S APCLCS=$S(APCLCS="":"UNKNOWN CLASS",1:$E($P(^DIC(7,APCLCS,0),"^"),1,25)) ;provider class name
- S APCLCL=$P(APCLSTR,"^",8) ;find clinic DFN
- S APCLCL=$S(APCLCL="":"??",$D(^DIC(40.7,APCLCL,0)):$E($P(^(0),"^"),1,25)_" ("_$P(^(0),"^",2)_")",1:"??") ;set clinic name with code
- S APCLVDAT=$P(APCLVDT,".") ;set visit date without time
- ;
- S ^XTMP("APCLYV6",APCLJOB,APCLBT,APCLCS,APCLPRN,APCLPR,APCLVDAT,APCLCL)=$S($D(^XTMP("APCLYV6",APCLJOB,APCLBT,APCLCS,APCLPRN,APCLPR,APCLVDAT,APCLCL)):^(APCLCL)+1,1:1)
- G VST2
- ;
- NEXT ;
- S APCLET=$H
- Q
- APCLYV61 ; IHS/CMI/LAB - VISIT COUNTS BY PROV (CALC) ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;
- CALC ;find provider entries by date then store counts
- +1 SET APCLJOB=$JOB
- SET APCLBT=$HOROLOG
- +2 DO XTMP^APCLOSUT("APCLYV6","PCC PROVIDER 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 IF $$DEMO^APCLUTL($PIECE(APCLSTR,U,5),$GET(APCLDEMO))
- GOTO VST1
- +5 ;screen out other facilities
- IF $GET(APCLLOC)
- IF $PIECE(APCLSTR,"^",6)'=APCLLOC
- GOTO VST1
- +6 IF "DHXEI"[$PIECE(APCLSTR,"^",7)
- GOTO VST1
- +7 SET X=$PIECE(APCLSTR,U,7)
- +8 IF X=""
- GOTO VST1
- +9 ;don't want this service category
- IF '$DATA(APCLSCAT(X))
- GOTO VST1
- +10 ;LAB/TUCSON CHANGED CV TO C FOR VA
- IF "CV"[$PIECE(APCLSTR,"^",3)
- GOTO VST1
- +11 ;find providers for selected visits
- SET APCLPDFN=0
- VST2 SET APCLPDFN=$ORDER(^AUPNVPRV("AD",APCLVDFN,APCLPDFN))
- IF APCLPDFN=""
- GOTO VST1
- +1 IF '$DATA(^AUPNVPRV(APCLPDFN,0))
- GOTO VST2
- SET APCLPR=$PIECE(^(0),"^")
- +2 ;screen for one provider
- IF APCLS=1
- IF APCLPR'=+APCLPRV
- GOTO VST2
- +3 IF $PIECE(^DD(9000010.06,.01,0),U,2)[6
- SET APCLCS=$SELECT($DATA(^DIC(6,APCLPR,0)):$PIECE(^(0),"^",4),1:"")
- +4 ;IHS/CMI/LAB
- IF $PIECE(^DD(9000010.06,.01,0),U,2)[200
- SET APCLCS=$$PROVCLS^XBFUNC1(APCLPR,"I")
- IF APCLCS="UNKNOWN"
- SET APCLCS=""
- +5 IF APCLS=2
- IF APCLCS'=+APCLPRV
- GOTO VST2
- +6 ;provider name
- SET APCLPRN=$EXTRACT($SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:$PIECE(^VA(200,APCLPR,0),U),1:$PIECE(^DIC(16,APCLPR,0),"^")),1,20)
- +7 ;provider class name
- SET APCLCS=$SELECT(APCLCS="":"UNKNOWN CLASS",1:$EXTRACT($PIECE(^DIC(7,APCLCS,0),"^"),1,25))
- +8 ;find clinic DFN
- SET APCLCL=$PIECE(APCLSTR,"^",8)
- +9 ;set clinic name with code
- SET APCLCL=$SELECT(APCLCL="":"??",$DATA(^DIC(40.7,APCLCL,0)):$EXTRACT($PIECE(^(0),"^"),1,25)_" ("_$PIECE(^(0),"^",2)_")",1:"??")
- +10 ;set visit date without time
- SET APCLVDAT=$PIECE(APCLVDT,".")
- +11 ;
- +12 SET ^XTMP("APCLYV6",APCLJOB,APCLBT,APCLCS,APCLPRN,APCLPR,APCLVDAT,APCLCL)=$SELECT($DATA(^XTMP("APCLYV6",APCLJOB,APCLBT,APCLCS,APCLPRN,APCLPR,APCLVDAT,APCLCL)):^(APCLCL)+1,1:1)
- +13 GOTO VST2
- +14 ;
- NEXT ;
- +1 SET APCLET=$HOROLOG
- +2 QUIT
