ABPAPD2C ;DISPLAY CLAIMS FOR PAYMENT; [ 07/08/91 3:43 PM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
A0 S U="^",DC=1,D0=ABPATDFN K DXS W @IOF,! D ^ABPAPDA K DXS,ABPA("C")
K DIC,DIE,DA,DR,ABPA("QF"),ABPACAMT,ABPACCNT,ABPA("HP"),ABPA("CP")
S ABPADOS=ABPAFRDT-1,(ABPACAMT,ABPACCNT,ABPAOBAL,ABPATPD)=0
S (ABPATA2,ABPATA3,ABPATA4,ABPATA5,ABPATA7)=0
F ABPA("I")=0:0 D Q:$D(ABPA("QF",1))=1
.S ABPADOS=$O(^ABPVAO("PC",ABPATDFN,ABPADOS))
.I +ABPADOS=0!(ABPADOS>ABPATODT) S ABPA("QF",1)="" Q
.K ABPA("QF",2) S DA=0 F ABPA("II")=0:0 D Q:$D(ABPA("QF",2))=1
..S DA=$O(^ABPVAO("PC",ABPATDFN,ABPADOS,DA))
..I +DA=0 S ABPA("QF",2)="" Q
..Q:$D(^ABPVAO(ABPATDFN,1,DA,0))'=1!($D(ABPACSCR(+DA))=1)
..S ABPAPTR=+DA,ABPADATA=^ABPVAO(ABPATDFN,1,ABPAPTR,0)
..S ABPA("CP",ABPADOS,DA)="0^0^0^0^0^0"
..S ABPA("HP",ABPADOS,DA)=ABPA("CP",ABPADOS,DA)
..;-------------------------------------------------------------------
..;PROCEDURE TO BUILD PAYMENT HISTORY ARRAY
..F ABPAJ=2:1:5 S @("ABPAP"_ABPAJ)=0
..S ABPAZ=0 F ABPAJ=0:0 S ABPAPTOT=0 D Q:+ABPAZ=0
...S ABPAZ=$O(^ABPVAO("PD",ABPATDFN,DA,ABPAZ)) Q:+ABPAZ=0
...S ABPAZZ=0 F ABPAK=0:0 D Q:+ABPAZZ=0
....S ABPAZZ=$O(^ABPVAO(ABPATDFN,"P",ABPAZ,"D",ABPAZZ)) Q:+ABPAZZ=0
....Q:$D(^ABPVAO(ABPATDFN,"P",ABPAZ,"D",ABPAZZ,0))'=1 S ABPARCD=^(0)
....Q:$P(ABPARCD,"^",2)'=DA F ABPAL=3:1:6 D
.....S @("ABPAP"_(ABPAL-1))=@("ABPAP"_(ABPAL-1))+$P(ABPARCD,"^",ABPAL)
..S ABPAPTOT=ABPAP2+ABPAP3+ABPAP4+ABPAP5,ABPATPD=ABPATPD+ABPAPTOT
..S ABPABAL=($P(ABPADATA,"^",7)-ABPAPTOT)-(+$P(ABPADATA,"^",3))
..S $P(ABPA("HP",ABPADOS,DA),"^")=ABPABAL,ABPAOBAL=ABPAOBAL+ABPABAL
..F ABPAJ=2:1:5 S $P(ABPA("HP",ABPADOS,DA),"^",ABPAJ)=@("ABPAP"_ABPAJ)
..S $P(ABPA("HP",ABPADOS,DA),"^",6)=ABPAPTOT
..S $P(ABPA("HP",ABPADOS,DA),"^",7)=+$P(ABPADATA,"^",3)
..;-------------------------------------------------------------------
..S ABPACCNT=ABPACCNT+1,ABPA("C",ABPACCNT)=DA
..W !,ABPACCNT,?2,$J($P(ABPADATA,"^",2),7)
..S ABPA("DTIN")=+ABPADATA D DTCVT^ABPAMAIN W ?10,$J(ABPA("DTOUT"),8)
..W ?19,$J($P(ABPADATA,"^",7),8,2)
..S ABPACAMT=ABPACAMT+$P(ABPADATA,"^",7)
..F I=28,37 S J=$E(I) D
...W ?I,$J($P(ABPA("HP",ABPADOS,DA),"^",J),8,2)
...S @("ABPATA"_J)=@("ABPATA"_J)+$P(ABPA("HP",ABPADOS,DA),"^",J)
..W ?46,$J($P(ABPA("HP",ABPADOS,DA),"^",4),7,2)
..S ABPATA4=ABPATA4+$P(ABPA("HP",ABPADOS,DA),"^",4)
..W ?54,$J($P(ABPA("HP",ABPADOS,DA),"^",5),8,2)
..S ABPATA5=ABPATA5+$P(ABPA("HP",ABPADOS,DA),"^",5)
..W ?63,$J($P(ABPA("HP",ABPADOS,DA),"^",7),8,2)
..S ABPATA7=ABPATA7+$P(ABPA("HP",ABPADOS,DA),"^",7)
..W ?72,$J(ABPABAL,8,2)
I +ABPACCNT<1 D Q
.W !!?5,*7,"<<< NO 'ELIGIBLE' CLAIMS FOUND FOR THIS DATE OF SERVICE "
.W "PERIOD >>>" H 3
I +ABPACCNT>1 W ! D
.F ABPAI=19,28,37 W ?(ABPAI),"--------"
.W ?46,"-------",?54,"--------",?63,"--------",?72,"--------"
.W !?19,$J(ABPACAMT,8,2),?28,$J(ABPATA2,8,2),?37,$J(ABPATA3,8,2)
.W ?46,$J(ABPATA4,7,2),?54,$J(ABPATA5,8,2)
.W ?63,$J(ABPATA7,8,2),?72,$J(ABPAOBAL,8,2)
W !,ABPAXX
Q
ABPAPD2C ;DISPLAY CLAIMS FOR PAYMENT; [ 07/08/91 3:43 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
A0 SET U="^"
SET DC=1
SET D0=ABPATDFN
KILL DXS
WRITE @IOF,!
DO ^ABPAPDA
KILL DXS,ABPA("C")
+1 KILL DIC,DIE,DA,DR,ABPA("QF"),ABPACAMT,ABPACCNT,ABPA("HP"),ABPA("CP")
+2 SET ABPADOS=ABPAFRDT-1
SET (ABPACAMT,ABPACCNT,ABPAOBAL,ABPATPD)=0
+3 SET (ABPATA2,ABPATA3,ABPATA4,ABPATA5,ABPATA7)=0
+4 FOR ABPA("I")=0:0
Begin DoDot:1
+5 SET ABPADOS=$ORDER(^ABPVAO("PC",ABPATDFN,ABPADOS))
+6 IF +ABPADOS=0!(ABPADOS>ABPATODT)
SET ABPA("QF",1)=""
QUIT
+7 KILL ABPA("QF",2)
SET DA=0
FOR ABPA("II")=0:0
Begin DoDot:2
+8 SET DA=$ORDER(^ABPVAO("PC",ABPATDFN,ABPADOS,DA))
+9 IF +DA=0
SET ABPA("QF",2)=""
QUIT
+10 IF $DATA(^ABPVAO(ABPATDFN,1,DA,0))'=1!($DATA(ABPACSCR(+DA))=1)
QUIT
+11 SET ABPAPTR=+DA
SET ABPADATA=^ABPVAO(ABPATDFN,1,ABPAPTR,0)
+12 SET ABPA("CP",ABPADOS,DA)="0^0^0^0^0^0"
+13 SET ABPA("HP",ABPADOS,DA)=ABPA("CP",ABPADOS,DA)
+14 ;-------------------------------------------------------------------
+15 ;PROCEDURE TO BUILD PAYMENT HISTORY ARRAY
+16 FOR ABPAJ=2:1:5
SET @("ABPAP"_ABPAJ)=0
+17 SET ABPAZ=0
FOR ABPAJ=0:0
SET ABPAPTOT=0
Begin DoDot:3
+18 SET ABPAZ=$ORDER(^ABPVAO("PD",ABPATDFN,DA,ABPAZ))
IF +ABPAZ=0
QUIT
+19 SET ABPAZZ=0
FOR ABPAK=0:0
Begin DoDot:4
+20 SET ABPAZZ=$ORDER(^ABPVAO(ABPATDFN,"P",ABPAZ,"D",ABPAZZ))
IF +ABPAZZ=0
QUIT
+21 IF $DATA(^ABPVAO(ABPATDFN,"P",ABPAZ,"D",ABPAZZ,0))'=1
QUIT
SET ABPARCD=^(0)
+22 IF $PIECE(ABPARCD,"^",2)'=DA
QUIT
FOR ABPAL=3:1:6
Begin DoDot:5
+23 SET @("ABPAP"_(ABPAL-1))=@("ABPAP"_(ABPAL-1))+$PIECE(ABPARCD,"^",ABPAL)
End DoDot:5
End DoDot:4
IF +ABPAZZ=0
QUIT
End DoDot:3
IF +ABPAZ=0
QUIT
+24 SET ABPAPTOT=ABPAP2+ABPAP3+ABPAP4+ABPAP5
SET ABPATPD=ABPATPD+ABPAPTOT
+25 SET ABPABAL=($PIECE(ABPADATA,"^",7)-ABPAPTOT)-(+$PIECE(ABPADATA,"^",3))
+26 SET $PIECE(ABPA("HP",ABPADOS,DA),"^")=ABPABAL
SET ABPAOBAL=ABPAOBAL+ABPABAL
+27 FOR ABPAJ=2:1:5
SET $PIECE(ABPA("HP",ABPADOS,DA),"^",ABPAJ)=@("ABPAP"_ABPAJ)
+28 SET $PIECE(ABPA("HP",ABPADOS,DA),"^",6)=ABPAPTOT
+29 SET $PIECE(ABPA("HP",ABPADOS,DA),"^",7)=+$PIECE(ABPADATA,"^",3)
+30 ;-------------------------------------------------------------------
+31 SET ABPACCNT=ABPACCNT+1
SET ABPA("C",ABPACCNT)=DA
+32 WRITE !,ABPACCNT,?2,$JUSTIFY($PIECE(ABPADATA,"^",2),7)
+33 SET ABPA("DTIN")=+ABPADATA
DO DTCVT^ABPAMAIN
WRITE ?10,$JUSTIFY(ABPA("DTOUT"),8)
+34 WRITE ?19,$JUSTIFY($PIECE(ABPADATA,"^",7),8,2)
+35 SET ABPACAMT=ABPACAMT+$PIECE(ABPADATA,"^",7)
+36 FOR I=28,37
SET J=$EXTRACT(I)
Begin DoDot:3
+37 WRITE ?I,$JUSTIFY($PIECE(ABPA("HP",ABPADOS,DA),"^",J),8,2)
+38 SET @("ABPATA"_J)=@("ABPATA"_J)+$PIECE(ABPA("HP",ABPADOS,DA),"^",J)
End DoDot:3
+39 WRITE ?46,$JUSTIFY($PIECE(ABPA("HP",ABPADOS,DA),"^",4),7,2)
+40 SET ABPATA4=ABPATA4+$PIECE(ABPA("HP",ABPADOS,DA),"^",4)
+41 WRITE ?54,$JUSTIFY($PIECE(ABPA("HP",ABPADOS,DA),"^",5),8,2)
+42 SET ABPATA5=ABPATA5+$PIECE(ABPA("HP",ABPADOS,DA),"^",5)
+43 WRITE ?63,$JUSTIFY($PIECE(ABPA("HP",ABPADOS,DA),"^",7),8,2)
+44 SET ABPATA7=ABPATA7+$PIECE(ABPA("HP",ABPADOS,DA),"^",7)
+45 WRITE ?72,$JUSTIFY(ABPABAL,8,2)
End DoDot:2
IF $DATA(ABPA("QF",2))=1
QUIT
End DoDot:1
IF $DATA(ABPA("QF",1))=1
QUIT
+46 IF +ABPACCNT<1
Begin DoDot:1
+47 WRITE !!?5,*7,"<<< NO 'ELIGIBLE' CLAIMS FOUND FOR THIS DATE OF SERVICE "
+48 WRITE "PERIOD >>>"
HANG 3
End DoDot:1
QUIT
+49 IF +ABPACCNT>1
WRITE !
Begin DoDot:1
+50 FOR ABPAI=19,28,37
WRITE ?(ABPAI),"--------"
+51 WRITE ?46,"-------",?54,"--------",?63,"--------",?72,"--------"
+52 WRITE !?19,$JUSTIFY(ABPACAMT,8,2),?28,$JUSTIFY(ABPATA2,8,2),?37,$JUSTIFY(ABPATA3,8,2)
+53 WRITE ?46,$JUSTIFY(ABPATA4,7,2),?54,$JUSTIFY(ABPATA5,8,2)
+54 WRITE ?63,$JUSTIFY(ABPATA7,8,2),?72,$JUSTIFY(ABPAOBAL,8,2)
End DoDot:1
+55 WRITE !,ABPAXX
+56 QUIT
