- 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
