- 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
