ABPAPD7C ;DISPLAY CLAIMS AFTER TRANS ALLOCATION; [ 07/18/91 6:09 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
K DIC,DIE,DA,DR,ABPACAMT,ABPACCNT
S ABPADOS=ABPAFRDT-1,(ABPACAMT,ABPACCNT,ABPACTPD)=0
S (ABPATA2,ABPATA3,ABPATA4,ABPATA5,ABPATA5)=0
LOOP F D Q:'ABPADOS
.S ABPADOS=$O(^ABPVAO("PC",ABPATDFN,ABPADOS))
.Q:+ABPADOS=0!(ABPADOS>ABPATODT) S DA=0 F D Q:'DA
..S DA=$O(^ABPVAO("PC",ABPATDFN,ABPADOS,DA)) Q:'DA
..Q:$D(^ABPVAO(ABPATDFN,1,DA,0))'=1!($D(ABPACSCR(+DA))=1)
..S ABPAPTR=+DA,ABPADATA=^ABPVAO(ABPATDFN,1,ABPAPTR,0)
..S ABPACCNT=ABPACCNT+1 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("PP",ABPADOS,DA),"^",J),8,2)
...S @("ABPATA"_J)=@("ABPATA"_J)+$P(ABPA("PP",ABPADOS,DA),"^",J)
...S:+$P(ABPA("PP",ABPADOS,DA),"^",J)<0 ABPA("OPERR")=""
..W ?46,$J($P(ABPA("PP",ABPADOS,DA),"^",4),7,2)
..S ABPATA4=ABPATA4+$P(ABPA("PP",ABPADOS,DA),"^",4)
..S:+$P(ABPA("PP",ABPADOS,DA),"^",4)<0 ABPA("OPERR")=""
..W ?54,$J($P(ABPA("PP",ABPADOS,DA),"^",5),8,2)
..S ABPATA5=ABPATA5+$P(ABPA("PP",ABPADOS,DA),"^",5)
..S:+$P(ABPA("PP",ABPADOS,DA),"^",5)<0 ABPA("OPERR")=""
..W ?63,$J($P(ABPA("PP",ABPADOS,DA),"^",7),8,2)
..S ABPATA7=ABPATA7+$P(ABPA("PP",ABPADOS,DA),"^",7)
..S ABPACTPD=ABPACTPD+$P(ABPA("PP",ABPADOS,DA),"^",6)
..W ?72,$J(+ABPA("PP",ABPADOS,DA),8,2)
..I +ABPA("PP",ABPADOS,DA)<0&(+$P(ABPA("PP",ABPADOS,DA),"^",5)'>0) D
...S ABPA("OPERR")=""
..I +ABPA("PP",ABPADOS,DA)>+$P(ABPADATA,"^",7) S ABPA("OPERR")=""
I +ABPACCNT>1 W ! D
.F ABPAI=19,28,37 W ?ABPAI,"--------"
.W ?46,"-------" F ABPAI=54,63,72 W ?ABPAI,"--------"
.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(ABPACTOB,8,2)
W !,ABPAXX
CURARAY ;ENTRY POINT
;PROCEDURE TO BUILD A COMPOSITE ARRAY OF CURRENT TRANS. AS ALLOCATED
S ABPADOS=0 F ABPAI=0:0 D Q:+ABPADOS=0
.S ABPADOS=$O(ABPA("HP",ABPADOS)) Q:+ABPADOS=0
.S DA=0 F ABPAJ=0:0 D Q:+DA=0
..S DA=$O(ABPA("HP",ABPADOS,DA)) Q:+DA=0
..F ABPAK=2:1:5 D
...S @("ABPAH"_ABPAK)=$P(ABPA("HP",ABPADOS,DA),"^",ABPAK)
...S @("ABPAP"_ABPAK)=$P(ABPA("PP",ABPADOS,DA),"^",ABPAK)
...S ABPACURA=@("ABPAP"_ABPAK)-@("ABPAH"_ABPAK)
...S $P(ABPA("CP",ABPADOS,DA),"^",ABPAK)=ABPACURA
Q
ABPAPD7C ;DISPLAY CLAIMS AFTER TRANS ALLOCATION; [ 07/18/91 6:09 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
+1 KILL DIC,DIE,DA,DR,ABPACAMT,ABPACCNT
+2 SET ABPADOS=ABPAFRDT-1
SET (ABPACAMT,ABPACCNT,ABPACTPD)=0
+3 SET (ABPATA2,ABPATA3,ABPATA4,ABPATA5,ABPATA5)=0
LOOP FOR
Begin DoDot:1
+1 SET ABPADOS=$ORDER(^ABPVAO("PC",ABPATDFN,ABPADOS))
+2 IF +ABPADOS=0!(ABPADOS>ABPATODT)
QUIT
SET DA=0
FOR
Begin DoDot:2
+3 SET DA=$ORDER(^ABPVAO("PC",ABPATDFN,ABPADOS,DA))
IF 'DA
QUIT
+4 IF $DATA(^ABPVAO(ABPATDFN,1,DA,0))'=1!($DATA(ABPACSCR(+DA))=1)
QUIT
+5 SET ABPAPTR=+DA
SET ABPADATA=^ABPVAO(ABPATDFN,1,ABPAPTR,0)
+6 SET ABPACCNT=ABPACCNT+1
WRITE !,ABPACCNT,?2,$JUSTIFY($PIECE(ABPADATA,"^",2),7)
+7 SET ABPA("DTIN")=+ABPADATA
DO DTCVT^ABPAMAIN
WRITE ?10,$JUSTIFY(ABPA("DTOUT"),8)
+8 WRITE ?19,$JUSTIFY($PIECE(ABPADATA,"^",7),8,2)
+9 SET ABPACAMT=ABPACAMT+$PIECE(ABPADATA,"^",7)
FOR I=28,37
SET J=$EXTRACT(I)
Begin DoDot:3
+10 WRITE ?I,$JUSTIFY($PIECE(ABPA("PP",ABPADOS,DA),"^",J),8,2)
+11 SET @("ABPATA"_J)=@("ABPATA"_J)+$PIECE(ABPA("PP",ABPADOS,DA),"^",J)
+12 IF +$PIECE(ABPA("PP",ABPADOS,DA),"^",J)<0
SET ABPA("OPERR")=""
End DoDot:3
+13 WRITE ?46,$JUSTIFY($PIECE(ABPA("PP",ABPADOS,DA),"^",4),7,2)
+14 SET ABPATA4=ABPATA4+$PIECE(ABPA("PP",ABPADOS,DA),"^",4)
+15 IF +$PIECE(ABPA("PP",ABPADOS,DA),"^",4)<0
SET ABPA("OPERR")=""
+16 WRITE ?54,$JUSTIFY($PIECE(ABPA("PP",ABPADOS,DA),"^",5),8,2)
+17 SET ABPATA5=ABPATA5+$PIECE(ABPA("PP",ABPADOS,DA),"^",5)
+18 IF +$PIECE(ABPA("PP",ABPADOS,DA),"^",5)<0
SET ABPA("OPERR")=""
+19 WRITE ?63,$JUSTIFY($PIECE(ABPA("PP",ABPADOS,DA),"^",7),8,2)
+20 SET ABPATA7=ABPATA7+$PIECE(ABPA("PP",ABPADOS,DA),"^",7)
+21 SET ABPACTPD=ABPACTPD+$PIECE(ABPA("PP",ABPADOS,DA),"^",6)
+22 WRITE ?72,$JUSTIFY(+ABPA("PP",ABPADOS,DA),8,2)
+23 IF +ABPA("PP",ABPADOS,DA)<0&(+$PIECE(ABPA("PP",ABPADOS,DA),"^",5)'>0)
Begin DoDot:3
+24 SET ABPA("OPERR")=""
End DoDot:3
+25 IF +ABPA("PP",ABPADOS,DA)>+$PIECE(ABPADATA,"^",7)
SET ABPA("OPERR")=""
End DoDot:2
IF 'DA
QUIT
End DoDot:1
IF 'ABPADOS
QUIT
+26 IF +ABPACCNT>1
WRITE !
Begin DoDot:1
+27 FOR ABPAI=19,28,37
WRITE ?ABPAI,"--------"
+28 WRITE ?46,"-------"
FOR ABPAI=54,63,72
WRITE ?ABPAI,"--------"
+29 WRITE !?19,$JUSTIFY(ABPACAMT,8,2),?28,$JUSTIFY(ABPATA2,8,2),?37,$JUSTIFY(ABPATA3,8,2)
+30 WRITE ?46,$JUSTIFY(ABPATA4,7,2),?54,$JUSTIFY(ABPATA5,8,2)
+31 WRITE ?63,$JUSTIFY(ABPATA7,8,2),?72,$JUSTIFY(ABPACTOB,8,2)
End DoDot:1
+32 WRITE !,ABPAXX
CURARAY ;ENTRY POINT
+1 ;PROCEDURE TO BUILD A COMPOSITE ARRAY OF CURRENT TRANS. AS ALLOCATED
+2 SET ABPADOS=0
FOR ABPAI=0:0
Begin DoDot:1
+3 SET ABPADOS=$ORDER(ABPA("HP",ABPADOS))
IF +ABPADOS=0
QUIT
+4 SET DA=0
FOR ABPAJ=0:0
Begin DoDot:2
+5 SET DA=$ORDER(ABPA("HP",ABPADOS,DA))
IF +DA=0
QUIT
+6 FOR ABPAK=2:1:5
Begin DoDot:3
+7 SET @("ABPAH"_ABPAK)=$PIECE(ABPA("HP",ABPADOS,DA),"^",ABPAK)
+8 SET @("ABPAP"_ABPAK)=$PIECE(ABPA("PP",ABPADOS,DA),"^",ABPAK)
+9 SET ABPACURA=@("ABPAP"_ABPAK)-@("ABPAH"_ABPAK)
+10 SET $PIECE(ABPA("CP",ABPADOS,DA),"^",ABPAK)=ABPACURA
End DoDot:3
End DoDot:2
IF +DA=0
QUIT
End DoDot:1
IF +ABPADOS=0
QUIT
+11 QUIT
