APCLYV61.m

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