ABPAAR1B.m

ABPAAR1B ;COMPILE CLAIMS FOR UTILIZATION RPT; [ 03/16/91  10:06 AM ]

 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

 ;KEY VARIABLES: R   = DATE CLAIM EXTRACTED FROM FACILITY

 ;               RR  = PATIENT DFN

 ;               RRR = CLAIM DFN WITHIN PATIENT RECORD

 ;

 G ABORT

R0 K ^TMP($J) S R=BDT-1

NXTR S R=$O(^ABPVAO("AC",R)) G CONT:+R=0,CONT:+R>+EDT S RR=0

NXTRR S RR=$O(^ABPVAO("AC",R,RR)) G:+RR=0 NXTR

 I $D(^ABPVAO(RR,0))=0 G NXTRR

 I $D(^ABPVAO(RR,0))=10 G NXTRR

 I +FAC>0 I +$P(^ABPVAO(RR,0),"^",2)'=+FAC G NXTRR

 S RRR=0 F I=1:1:15 S @("P"_I)=0

NXTRRR S RRR=$O(^ABPVAO("AC",R,RR,RRR)) G:+RRR=0 STEMP

 I $D(^ABPVAO(RR,1,RRR,0))=0 G NXTRRR

 I $D(^ABPVAO(RR,1,RRR,0))=10 G NXTRRR

 S VT=$P(^ABPVAO(RR,1,RRR,0),"^",4),LBL="VT"_VT

 S FC=$P(^ABPVAO(RR,0),"^",2),VD=$P(^ABPVAO(RR,1,RRR,0),"^",7)

 S WKL=$P(^ABPVAO(RR,1,RRR,0),"^",5)

 I $D(^TMP($J,FC,RR))=0 S P11=P11+1,^TMP($J,FC,RR)=""

 G @LBL

 ;

VTO I $D(^TMP($J,FC,"O",RR))=0 S P4=P4+1,^TMP($J,FC,"O",RR)=""

 S P5=P5+WKL,P6=P6+VD,P14=P14+1 G NXTRRR

VTI I $D(^TMP($J,FC,"I",RR))=0 S P1=P1+1,^TMP($J,FC,"I",RR)=""

 S P2=P2+WKL,P3=P3+VD,P12=P12+1 G NXTRRR

VTP I $D(^TMP($J,FC,"I",RR))=0 S P1=P1+1,^TMP($J,FC,"O",RR)=""

 S P3=P3+VD G NXTRRR

VTD I $D(^TMP($J,FC,"O",RR))=0 S P4=P4+1,^TMP($J,FC,"O",RR)=""

 S P5=P5+WKL,P6=P6+VD,P14=P14+1 G NXTRRR

VTA G NXTRRR

 ;

STEMP I $D(TEMP(ZTSK,FC))=0 F I=1:1:15 S $P(TEMP(ZTSK,FC),"^",I)=0

 F P=1:1:6,11,12,14 D

 .S $P(TEMP(ZTSK,FC),"^",P)=$P(TEMP(ZTSK,FC),"^",P)+@("P"_P)

 S $P(TEMP(ZTSK,FC),"^",7)=$P(TEMP(ZTSK,FC),"^",7)+P3+P6

 G NXTRR

 ;

CONT G R0^ABPAAR1C

 ;

ABORT W *7,!!,"<<< SORRY, ACCESS DENIED!!! >>>" Q

ABPAAR1B  ;COMPILE CLAIMS FOR UTILIZATION RPT; [ 03/16/91  10:06 AM ]

 +1       ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

 +2       ;KEY VARIABLES: R   = DATE CLAIM EXTRACTED FROM FACILITY

 +3       ;               RR  = PATIENT DFN

 +4       ;               RRR = CLAIM DFN WITHIN PATIENT RECORD

 +5       ;

 +6        GOTO ABORT

R0         KILL ^TMP($JOB)

           SET R=BDT-1

NXTR       SET R=$ORDER(^ABPVAO("AC",R))

           IF +R=0

               GOTO CONT

           IF +R>+EDT

               GOTO CONT

           SET RR=0

NXTRR      SET RR=$ORDER(^ABPVAO("AC",R,RR))

           IF +RR=0

               GOTO NXTR

 +1        IF $DATA(^ABPVAO(RR,0))=0

               GOTO NXTRR

 +2        IF $DATA(^ABPVAO(RR,0))=10

               GOTO NXTRR

 +3        IF +FAC>0

               IF +$PIECE(^ABPVAO(RR,0),"^",2)'=+FAC

                   GOTO NXTRR

 +4        SET RRR=0

           FOR I=1:1:15

               SET @("P"_I)=0

NXTRRR     SET RRR=$ORDER(^ABPVAO("AC",R,RR,RRR))

           IF +RRR=0

               GOTO STEMP

 +1        IF $DATA(^ABPVAO(RR,1,RRR,0))=0

               GOTO NXTRRR

 +2        IF $DATA(^ABPVAO(RR,1,RRR,0))=10

               GOTO NXTRRR

 +3        SET VT=$PIECE(^ABPVAO(RR,1,RRR,0),"^",4)

           SET LBL="VT"_VT

 +4        SET FC=$PIECE(^ABPVAO(RR,0),"^",2)

           SET VD=$PIECE(^ABPVAO(RR,1,RRR,0),"^",7)

 +5        SET WKL=$PIECE(^ABPVAO(RR,1,RRR,0),"^",5)

 +6        IF $DATA(^TMP($JOB,FC,RR))=0

               SET P11=P11+1

               SET ^TMP($JOB,FC,RR)=""

 +7        GOTO @LBL

 +8       ;

VTO        IF $DATA(^TMP($JOB,FC,"O",RR))=0

               SET P4=P4+1

               SET ^TMP($JOB,FC,"O",RR)=""

 +1        SET P5=P5+WKL

           SET P6=P6+VD

           SET P14=P14+1

           GOTO NXTRRR

VTI        IF $DATA(^TMP($JOB,FC,"I",RR))=0

               SET P1=P1+1

               SET ^TMP($JOB,FC,"I",RR)=""

 +1        SET P2=P2+WKL

           SET P3=P3+VD

           SET P12=P12+1

           GOTO NXTRRR

VTP        IF $DATA(^TMP($JOB,FC,"I",RR))=0

               SET P1=P1+1

               SET ^TMP($JOB,FC,"O",RR)=""

 +1        SET P3=P3+VD

           GOTO NXTRRR

VTD        IF $DATA(^TMP($JOB,FC,"O",RR))=0

               SET P4=P4+1

               SET ^TMP($JOB,FC,"O",RR)=""

 +1        SET P5=P5+WKL

           SET P6=P6+VD

           SET P14=P14+1

           GOTO NXTRRR

VTA        GOTO NXTRRR

 +1       ;

STEMP      IF $DATA(TEMP(ZTSK,FC))=0

               FOR I=1:1:15

                   SET $PIECE(TEMP(ZTSK,FC),"^",I)=0

 +1        FOR P=1:1:6,11,12,14

               Begin DoDot:1

 +2                SET $PIECE(TEMP(ZTSK,FC),"^",P)=$PIECE(TEMP(ZTSK,FC),"^",P)+@("P"_P)

               End DoDot:1

 +3        SET $PIECE(TEMP(ZTSK,FC),"^",7)=$PIECE(TEMP(ZTSK,FC),"^",7)+P3+P6

 +4        GOTO NXTRR

 +5       ;

CONT       GOTO R0^ABPAAR1C

 +1       ;

ABORT      WRITE *7,!!,"<<< SORRY, ACCESS DENIED!!! >>>"

           QUIT