- 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
