ABPAALK2 ;PRIV-INS ACCOUNT DISPLAY UTILITY;[ 05/24/91 1:00 PM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
START S R=0 F ABPAR=1:1 D Q:+R=0
.S R=$O(^ABPVAO(ABPATDFN,"P",R)) Q:+R=0
.S RR=0,RRR=0,ABPA("CTOT")=0,ABPA("PTOT")=0
.S ABPA("CCNT")=0,ABPA("ACNT")=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
...Q:+ABPA("CCNT")'>1&(+ABPA("ACNT")'>1)
...W !?33,"--------",?64,"--------",!?33
...W $J(ABPA("CTOT"),8,2),?64,$J(ABPA("PTOT"),8,2)
..S ABPA("CCNT")=ABPA("CCNT")+1
..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 S ABPA("ACNT")=ABPA("ACNT")+1 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("ACNT")=ABPA("ACNT")-1
...S ABPA("CTOT")=ABPA("CTOT")-(+$P(^ABPVAO(DA,1,ABPAC,0),"^",7))
...S ABPA("CCNT")=ABPA("CCNT")-1
...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 ^ABPAALK3
..I $Y>55 W @IOF
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,3),?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
.S ABPA("ACNT")=ABPA("ACNT")+1
.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 ^ABPAALK3
.I $Y>55 W @IOF
ABPAALK2 ;PRIV-INS ACCOUNT DISPLAY UTILITY;[ 05/24/91 1:00 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
START SET R=0
FOR ABPAR=1:1
Begin DoDot:1
+1 SET R=$ORDER(^ABPVAO(ABPATDFN,"P",R))
IF +R=0
QUIT
+2 SET RR=0
SET RRR=0
SET ABPA("CTOT")=0
SET ABPA("PTOT")=0
+3 SET ABPA("CCNT")=0
SET ABPA("ACNT")=0
+4 WRITE !
FOR ABPARR=1:1
Begin DoDot:2
+5 SET RR=$ORDER(^ABPVAO(ABPATDFN,"P",R,"D",RR))
+6 IF +RR=0
DO AMT
IF +RRR=99
QUIT
Begin DoDot:3
+7 IF +ABPA("CCNT")'>1&(+ABPA("ACNT")'>1)
QUIT
+8 WRITE !?33,"--------",?64,"--------",!?33
+9 WRITE $JUSTIFY(ABPA("CTOT"),8,2),?64,$JUSTIFY(ABPA("PTOT"),8,2)
End DoDot:3
QUIT
+10 SET ABPA("CCNT")=ABPA("CCNT")+1
+11 SET ABPAC=$PIECE(^ABPVAO(ABPATDFN,"P",R,"D",RR,0),"^",2)
+12 DO DT3
SET ABPAI=ABPAI+1
+13 IF ABPARR=1
Begin DoDot:3
+14 SET ABPATDT=+^ABPVAO(DA,"P",R,0)
+15 SET ABPAPDT=+$EXTRACT(ABPATDT,4,5)_"/"_+$EXTRACT(ABPATDT,6,7)_"/"
+16 SET ABPAPDT=ABPAPDT_+$EXTRACT(ABPATDT,2,3)
KILL ABPATDT
+17 WRITE ?50,$JUSTIFY(ABPAPDT,10)
End DoDot:3
+18 SET RRR=$ORDER(^ABPVAO(ABPATDFN,"P",R,"A",RRR))
+19 IF +RRR>0
SET ABPA("ACNT")=ABPA("ACNT")+1
Begin DoDot:3
+20 IF $X>62
WRITE !
WRITE ?62,$JUSTIFY(+^ABPVAO(DA,"P",R,"A",RRR,0),10,2)
+21 SET ABPA("PTOT")=ABPA("PTOT")+(+^ABPVAO(DA,"P",R,"A",RRR,0))
+22 WRITE " (",$PIECE(^ABPVAO(DA,"P",R,"A",RRR,0),"^",2),")"
End DoDot:3
+23 IF +RRR<1
SET RRR=99
+24 IF $Y>21&(IO=IO(0))
Begin DoDot:3
+25 IF +RRR<99
Begin DoDot:4
+26 SET ABPA("PTOT")=ABPA("PTOT")-(+^ABPVAO(DA,"P",R,"A",RRR,0))
+27 SET ABPA("ACNT")=ABPA("ACNT")-1
End DoDot:4
+28 SET ABPA("CTOT")=ABPA("CTOT")-(+$PIECE(^ABPVAO(DA,1,ABPAC,0),"^",7))
+29 SET ABPA("CCNT")=ABPA("CCNT")-1
+30 SET RR=RR-1
SET RRR=RRR-1
SET ABPAI=ABPAI-1
SET ABPARR=ABPARR-1
IF +RR=0
SET RR=.99
+31 READ !,?20,"< Press 'RETURN' to Continue, or '^' to Exit >",X:300
+32 IF '$TEST!(X="^")
SET R=""
SET RR=""
QUIT
+33 DO ^ABPAALK3
End DoDot:3
QUIT
+34 IF $Y>55
WRITE @IOF
End DoDot:2
IF +RR=0
QUIT
End DoDot:1
IF +R=0
QUIT
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,3),?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 SET ABPA("ACNT")=ABPA("ACNT")+1
+3 IF $X>62
WRITE !
WRITE ?62,$JUSTIFY(+^ABPVAO(DA,"P",R,"A",RRR,0),10,2)
+4 SET ABPA("PTOT")=ABPA("PTOT")+(+^ABPVAO(DA,"P",R,"A",RRR,0))
+5 WRITE " (",$PIECE(^ABPVAO(DA,"P",R,"A",RRR,0),"^",2),")"
+6 IF $Y>21&(IO=IO(0))
Begin DoDot:2
+7 SET R=R-1
SET RR=""
SET RRR=99
SET ABPAI=ABPAI-1
+8 READ !,?20,"< Press 'RETURN' to Continue, or '^' to Exit >",X:300
+9 IF '$TEST!(X="^")
SET R=""
QUIT
+10 DO ^ABPAALK3
End DoDot:2
QUIT
+11 IF $Y>55
WRITE @IOF
End DoDot:1
IF +RRR=0!(+RRR=99)
QUIT
