ABPAPCS1 ;PVT-INS PAID CLAIM SUMMARY;[ 05/24/91 1:55 PM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
;VARIABLE DEFINITION: R = PAYMENT DFN
; RR = LINKED CLAIM DFN
; RRR = PAYMENT AMOUNT DFN
;
START S R=0 F ABPAR=1:1 D Q:+R=0
.S R=$O(^ABPVAO(ABPATDFN,"P","CD",ABPACDT,R)) Q:+R=0
.S RR=0,RRR=0,ABPA("CTOT")=0,ABPA("PTOT")=0
.W ! F ABPARR=1:1 D Q:+RR=0
..S RR=$O(^ABPVAO(ABPATDFN,"P",R,"D",RR))
..I +RR=0 D AMT Q:+RRR=99 D Q
...W !?33,"--------",?64,"--------",!?33
...W $J(ABPA("CTOT"),8,2),?64,$J(ABPA("PTOT"),8,2)
..S ABPAC=$P(^ABPVAO(ABPATDFN,"P",R,"D",RR,0),"^",2)
..D DT3 S ABPAI=ABPAI+1
..I ABPARR=1 D
...S ABPATDT=+^ABPVAO(DA,"P",R,0)
...S ABPAPDT=+$E(ABPATDT,4,5)_"/"_+$E(ABPATDT,6,7)_"/"
...S ABPAPDT=ABPAPDT_+$E(ABPATDT,2,3) K ABPATDT
...W ?50,$J(ABPAPDT,10)
..S RRR=$O(^ABPVAO(ABPATDFN,"P",R,"A",RRR))
..I +RRR>0 D
...W:$X>62 ! W ?62,$J(+^ABPVAO(DA,"P",R,"A",RRR,0),10,2)
...S ABPA("PTOT")=ABPA("PTOT")+(+^ABPVAO(DA,"P",R,"A",RRR,0))
...W " (",$P(^ABPVAO(DA,"P",R,"A",RRR,0),"^",2),")"
..I +RRR<1 S RRR=99
..I $Y>21&(IO=IO(0)) D Q
...I +RRR<99 D
....S ABPA("PTOT")=ABPA("PTOT")-(+^ABPVAO(DA,"P",R,"A",RRR,0))
...S ABPA("CTOT")=ABPA("CTOT")-(+$P(^ABPVAO(DA,1,ABPAC,0),"^",7))
...S RR=RR-1,RRR=RRR-1,ABPAI=ABPAI-1,ABPARR=ABPARR-1 S:+RR=0 RR=.99
...R !,?20,"< Press 'RETURN' to Continue, or '^' to Exit >",X:300
...I '$T!(X="^") S R="",RR="" Q
...D ^ABPAPCS2
..I $Y>55 W @IOF
I ABPAR=1 D
.W *7,!!,"No payments on file for claim date "
.W +$E(ABPACDT,4,5)_"/"_+$E(ABPACDT,6,7)_"/"_+$E(ABPACDT,2,3),"."
QUIT Q
;
DT3 S Y=^ABPVAO(DA,1,ABPAC,0),ABPA(ABPAI)=+Y
S ABPAINS=$E($P(^AUTNINS($P(Y,U,6),0),U),1,15)
W !,$J(ABPAI,2),?5,$J("",14-$L(ABPAINS)\2)_ABPAINS,?22
W $J((+$E(Y,4,5)_"/"_+$E(Y,6,7)_"/"_+$E(Y,2,3)),8),?33
W $J($P(Y,U,7),8,2) S ABPA("CTOT")=ABPA("CTOT")+(+$P(Y,U,7))
S ABPASTAT=$P(Y,"^",17)
W ?43,ABPASTAT,$S(ABPASTAT="C":"LOSED",ABPASTAT="D":"ENIED",ABPASTAT="PA":"ID",ABPASTAT="PE":"NDING",ABPASTAT="O":"PEN",1:"??????") Q
;
AMT F ABPARRR=0:0 D Q:+RRR=0!(+RRR=99)
.S RRR=$O(^ABPVAO(ABPATDFN,"P",R,"A",RRR)) Q:+RRR=0
.W:$X>62 ! W ?62,$J(+^ABPVAO(DA,"P",R,"A",RRR,0),10,2)
.S ABPA("PTOT")=ABPA("PTOT")+(+^ABPVAO(DA,"P",R,"A",RRR,0))
.W " (",$P(^ABPVAO(DA,"P",R,"A",RRR,0),"^",2),")"
.I $Y>21&(IO=IO(0)) D Q
..S R=R-1,RR="",RRR=99,ABPAI=ABPAI-1
..R !,?20,"< Press 'RETURN' to Continue, or '^' to Exit >",X:300
..I '$T!(X="^") S R="" Q
..D ^ABPAPCS2
.I $Y>55 W @IOF
ABPAPCS1 ;PVT-INS PAID CLAIM SUMMARY;[ 05/24/91 1:55 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
+2 ;VARIABLE DEFINITION: R = PAYMENT DFN
+3 ; RR = LINKED CLAIM DFN
+4 ; RRR = PAYMENT AMOUNT DFN
+5 ;
START SET R=0
FOR ABPAR=1:1
Begin DoDot:1
+1 SET R=$ORDER(^ABPVAO(ABPATDFN,"P","CD",ABPACDT,R))
IF +R=0
QUIT
+2 SET RR=0
SET RRR=0
SET ABPA("CTOT")=0
SET ABPA("PTOT")=0
+3 WRITE !
FOR ABPARR=1:1
Begin DoDot:2
+4 SET RR=$ORDER(^ABPVAO(ABPATDFN,"P",R,"D",RR))
+5 IF +RR=0
DO AMT
IF +RRR=99
QUIT
Begin DoDot:3
+6 WRITE !?33,"--------",?64,"--------",!?33
+7 WRITE $JUSTIFY(ABPA("CTOT"),8,2),?64,$JUSTIFY(ABPA("PTOT"),8,2)
End DoDot:3
QUIT
+8 SET ABPAC=$PIECE(^ABPVAO(ABPATDFN,"P",R,"D",RR,0),"^",2)
+9 DO DT3
SET ABPAI=ABPAI+1
+10 IF ABPARR=1
Begin DoDot:3
+11 SET ABPATDT=+^ABPVAO(DA,"P",R,0)
+12 SET ABPAPDT=+$EXTRACT(ABPATDT,4,5)_"/"_+$EXTRACT(ABPATDT,6,7)_"/"
+13 SET ABPAPDT=ABPAPDT_+$EXTRACT(ABPATDT,2,3)
KILL ABPATDT
+14 WRITE ?50,$JUSTIFY(ABPAPDT,10)
End DoDot:3
+15 SET RRR=$ORDER(^ABPVAO(ABPATDFN,"P",R,"A",RRR))
+16 IF +RRR>0
Begin DoDot:3
+17 IF $X>62
WRITE !
WRITE ?62,$JUSTIFY(+^ABPVAO(DA,"P",R,"A",RRR,0),10,2)
+18 SET ABPA("PTOT")=ABPA("PTOT")+(+^ABPVAO(DA,"P",R,"A",RRR,0))
+19 WRITE " (",$PIECE(^ABPVAO(DA,"P",R,"A",RRR,0),"^",2),")"
End DoDot:3
+20 IF +RRR<1
SET RRR=99
+21 IF $Y>21&(IO=IO(0))
Begin DoDot:3
+22 IF +RRR<99
Begin DoDot:4
+23 SET ABPA("PTOT")=ABPA("PTOT")-(+^ABPVAO(DA,"P",R,"A",RRR,0))
End DoDot:4
+24 SET ABPA("CTOT")=ABPA("CTOT")-(+$PIECE(^ABPVAO(DA,1,ABPAC,0),"^",7))
+25 SET RR=RR-1
SET RRR=RRR-1
SET ABPAI=ABPAI-1
SET ABPARR=ABPARR-1
IF +RR=0
SET RR=.99
+26 READ !,?20,"< Press 'RETURN' to Continue, or '^' to Exit >",X:300
+27 IF '$TEST!(X="^")
SET R=""
SET RR=""
QUIT
+28 DO ^ABPAPCS2
End DoDot:3
QUIT
+29 IF $Y>55
WRITE @IOF
End DoDot:2
IF +RR=0
QUIT
End DoDot:1
IF +R=0
QUIT
+30 IF ABPAR=1
Begin DoDot:1
+31 WRITE *7,!!,"No payments on file for claim date "
+32 WRITE +$EXTRACT(ABPACDT,4,5)_"/"_+$EXTRACT(ABPACDT,6,7)_"/"_+$EXTRACT(ABPACDT,2,3),"."
End DoDot:1
QUIT QUIT
+1 ;
DT3 SET Y=^ABPVAO(DA,1,ABPAC,0)
SET ABPA(ABPAI)=+Y
+1 SET ABPAINS=$EXTRACT($PIECE(^AUTNINS($PIECE(Y,U,6),0),U),1,15)
+2 WRITE !,$JUSTIFY(ABPAI,2),?5,$JUSTIFY("",14-$LENGTH(ABPAINS)\2)_ABPAINS,?22
+3 WRITE $JUSTIFY((+$EXTRACT(Y,4,5)_"/"_+$EXTRACT(Y,6,7)_"/"_+$EXTRACT(Y,2,3)),8),?33
+4 WRITE $JUSTIFY($PIECE(Y,U,7),8,2)
SET ABPA("CTOT")=ABPA("CTOT")+(+$PIECE(Y,U,7))
+5 SET ABPASTAT=$PIECE(Y,"^",17)
+6 WRITE ?43,ABPASTAT,$SELECT(ABPASTAT="C":"LOSED",ABPASTAT="D":"ENIED",ABPASTAT="PA":"ID",ABPASTAT="PE":"NDING",ABPASTAT="O":"PEN",1:"??????")
QUIT
+7 ;
AMT FOR ABPARRR=0:0
Begin DoDot:1
+1 SET RRR=$ORDER(^ABPVAO(ABPATDFN,"P",R,"A",RRR))
IF +RRR=0
QUIT
+2 IF $X>62
WRITE !
WRITE ?62,$JUSTIFY(+^ABPVAO(DA,"P",R,"A",RRR,0),10,2)
+3 SET ABPA("PTOT")=ABPA("PTOT")+(+^ABPVAO(DA,"P",R,"A",RRR,0))
+4 WRITE " (",$PIECE(^ABPVAO(DA,"P",R,"A",RRR,0),"^",2),")"
+5 IF $Y>21&(IO=IO(0))
Begin DoDot:2
+6 SET R=R-1
SET RR=""
SET RRR=99
SET ABPAI=ABPAI-1
+7 READ !,?20,"< Press 'RETURN' to Continue, or '^' to Exit >",X:300
+8 IF '$TEST!(X="^")
SET R=""
QUIT
+9 DO ^ABPAPCS2
End DoDot:2
QUIT
+10 IF $Y>55
WRITE @IOF
End DoDot:1
IF +RRR=0!(+RRR=99)
QUIT
