APCLPVC1.m

APCLPVC1 ; IHS/CMI/LAB - POV GROUPED BY APC CODES - 6/21/89 11:11 AM ;

 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

 ;FIND PCC AMBULATORY VISITS FOR DATE RANGE, RECODE TO APC CODES, AND TOTAL

 ;

 ;cmi/anch/maw 9/10/2007 code set versioning in I1

 ;

 S APCLBT=$H,APCLJOB=$J

 D XTMP^APCLOSUT("APCLPVC","PCC - VISITS BY APC RECODE")

 S APCLS=APCLSD-.0001

 F I=0:0 S APCLS=$O(^AUPNVSIT("B",APCLS)) Q:APCLS=""!(APCLS>(APCLFD+.2359))  D C1

 Q

C1 S APCLVDFN=0 F J=0:0 S APCLVDFN=$O(^AUPNVSIT("B",APCLS,APCLVDFN)) Q:APCLVDFN=""  D C2

 S APCLET=$H

 Q

C2 Q:'$D(^AUPNVSIT(APCLVDFN,0))

 S APCLVN0=^AUPNVSIT(APCLVDFN,0)

 Q:$$DEMO^APCLUTL($P(APCLVN0,U,5),$G(APCLDEMO))

 Q:$P(APCLVN0,"^",7)'="A"

 Q:'$P(APCLVN0,U,9)

 Q:"C"[$P(APCLVN0,"^",3)

 Q:$P(APCLVN0,"^",11)

 G:'$D(APCLCOM) ICDCK

 S APCLPDFN=$P(APCLVN0,"^",5) S APCLPCOM=$S($D(^AUPNPAT(APCLPDFN,11)):$P(^(11),"^",18),1:"NOCOM")

 Q:APCLPCOM="NOCOM"

 Q:APCLPCOM'=APCLCOM

ICDCK S APCLIDFN="" F  S APCLIDFN=$O(^AUPNVPOV("AD",APCLVDFN,APCLIDFN)) Q:APCLIDFN=""  D I1

 Q

I1 Q:'$D(^AUPNVPOV(APCLIDFN,0))

 S APCLINO=+^AUPNVPOV(APCLIDFN,0)

 ;S APCLX=$P(^ICD9(APCLINO,0),"^") D ^APCLRAPC G:'$D(APCLY) I11 G:APCLY="" I11 S APCLAPC=APCLY  ;cmi/anch/maw 9/10/2007 orig line

 S APCLX=$P($$ICDDX^ICDEX(APCLINO),"^",2) D ^APCLRAPC G:'$D(APCLY) I11 G:APCLY="" I11 S APCLAPC=APCLY  ;cmi/anch/maw 9/10/2007 csv

 S ^(0)=$S($D(^XTMP("APCLPVC",APCLJOB,APCLBT,APCLAPC,0)):^(0)+1,1:1)

 Q:'APCLLIM  S ^(APCLINO)=$S($D(^XTMP("APCLPVC",APCLJOB,APCLBT,APCLAPC,APCLINO)):^(APCLINO)+1,1:1) G I12

I11 S ^("NOCODE")=$S($D(^XTMP("APCLPVC",APCLJOB,APCLBT,"NOCODE")):^("NOCODE"),1:1)

I12 Q

APCLPVC1  ; IHS/CMI/LAB - POV GROUPED BY APC CODES - 6/21/89 11:11 AM ;

 +1       ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

 +2       ;FIND PCC AMBULATORY VISITS FOR DATE RANGE, RECODE TO APC CODES, AND TOTAL

 +3       ;

 +4       ;cmi/anch/maw 9/10/2007 code set versioning in I1

 +5       ;

 +6        SET APCLBT=$HOROLOG

           SET APCLJOB=$JOB

 +7        DO XTMP^APCLOSUT("APCLPVC","PCC - VISITS BY APC RECODE")

 +8        SET APCLS=APCLSD-.0001

 +9        FOR I=0:0

               SET APCLS=$ORDER(^AUPNVSIT("B",APCLS))

               IF APCLS=""!(APCLS>(APCLFD+.2359))

                   QUIT 

               DO C1

 +10       QUIT 

C1         SET APCLVDFN=0

           FOR J=0:0

               SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLS,APCLVDFN))

               IF APCLVDFN=""

                   QUIT 

               DO C2

 +1        SET APCLET=$HOROLOG

 +2        QUIT 

C2         IF '$DATA(^AUPNVSIT(APCLVDFN,0))

               QUIT 

 +1        SET APCLVN0=^AUPNVSIT(APCLVDFN,0)

 +2        IF $$DEMO^APCLUTL($PIECE(APCLVN0,U,5),$GET(APCLDEMO))

               QUIT 

 +3        IF $PIECE(APCLVN0,"^",7)'="A"

               QUIT 

 +4        IF '$PIECE(APCLVN0,U,9)

               QUIT 

 +5        IF "C"[$PIECE(APCLVN0,"^",3)

               QUIT 

 +6        IF $PIECE(APCLVN0,"^",11)

               QUIT 

 +7        IF '$DATA(APCLCOM)

               GOTO ICDCK

 +8        SET APCLPDFN=$PIECE(APCLVN0,"^",5)

           SET APCLPCOM=$SELECT($DATA(^AUPNPAT(APCLPDFN,11)):$PIECE(^(11),"^",18),1:"NOCOM")

 +9        IF APCLPCOM="NOCOM"

               QUIT 

 +10       IF APCLPCOM'=APCLCOM

               QUIT 

ICDCK      SET APCLIDFN=""

           FOR 

               SET APCLIDFN=$ORDER(^AUPNVPOV("AD",APCLVDFN,APCLIDFN))

               IF APCLIDFN=""

                   QUIT 

               DO I1

 +1        QUIT 

I1         IF '$DATA(^AUPNVPOV(APCLIDFN,0))

               QUIT 

 +1        SET APCLINO=+^AUPNVPOV(APCLIDFN,0)

 +2       ;S APCLX=$P(^ICD9(APCLINO,0),"^") D ^APCLRAPC G:'$D(APCLY) I11 G:APCLY="" I11 S APCLAPC=APCLY  ;cmi/anch/maw 9/10/2007 orig line

 +3       ;cmi/anch/maw 9/10/2007 csv

           SET APCLX=$PIECE($$ICDDX^ICDEX(APCLINO),"^",2)

           DO ^APCLRAPC

           IF '$DATA(APCLY)

               GOTO I11

           IF APCLY=""

               GOTO I11

           SET APCLAPC=APCLY

 +4        SET ^(0)=$SELECT($DATA(^XTMP("APCLPVC",APCLJOB,APCLBT,APCLAPC,0)):^(0)+1,1:1)

 +5        IF 'APCLLIM

               QUIT 

           SET ^(APCLINO)=$SELECT($DATA(^XTMP("APCLPVC",APCLJOB,APCLBT,APCLAPC,APCLINO)):^(APCLINO)+1,1:1)

           GOTO I12

I11        SET ^("NOCODE")=$SELECT($DATA(^XTMP("APCLPVC",APCLJOB,APCLBT,"NOCODE")):^("NOCODE"),1:1)

I12        QUIT