ABPAPDEM ;MULTI-ENTRY LOOKUP; [ 06/27/91 3:32 PM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
D CURRENT^%ZIS K ABPADDFN S R=0 F ABPA("I")=0:1 D Q:+R=0
.S R=$O(^ABPVAO("BD",ABPABDFN,ABPATDFN,R)) Q:+R=0
.S ABPADDFN=+R
I +ABPA("I")<1 K ABPADDFN Q
I +ABPA("I")<2 D Q
.I $D(^ABPVAO(ABPATDFN,"P",ABPADDFN,0))'=1 K ABPADDFN Q
S D0=ABPATDFN,DC=1 K DXS W @IOF,! D ^ABPAPDA K DXS,D0
A0A S $P(ABPAXX,"-",81)="" W ! S DX=0,DY=6 X XY W @ABPAEOP
S X="-- Multiple payment transactions for this batch date --"
W !?(40-($L(X)/2)),X
W !!?15," .....CLAIMS...... .......PAYMENT......."
W !?14,"TRN # FROM TO AMOUNT CODE",!,ABPAXX
A1 K ABPA("QF") S ABPADDFN=0 F ABPA("I")=0:0 D Q:$D(ABPA("QF"))=1
.S ABPADDFN=$O(^ABPVAO("BD",ABPABDFN,ABPATDFN,ABPADDFN))
.I +ABPADDFN<1 S ABPA("QF")="" Q
.Q:$D(^ABPVAO(ABPATDFN,"P",ABPADDFN,0))'=1 W !?14,$J(ABPADDFN,4)
.S ABPADT=0,ABPADT=$O(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADT))
.Q:+ABPADT'>0 S ABPADT=+^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADT,0)
.S ABPADT=$E(ABPADT,4,5)_"/"_$E(ABPADT,6,7)_"/"_$E(ABPADT,2,3)
.W ?22,ABPADT_"-"
.S ABPADT=$P(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",0),"^",3)
.S ABPADT=+^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADT,0)
.S ABPADT=$E(ABPADT,4,5)_"/"_$E(ABPADT,6,7)_"/"_$E(ABPADT,2,3)
.W ABPADT K ABPADT,ABPA("III")
.S DA=0 F ABPA("II")=1:1 D I $D(ABPA("III"))=1 K ABPA("III") Q
A2 ..S DA=$O(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",DA))
..I +DA=0 S ABPA("III")="" Q
..W:+ABPA("II")>1 !
..W ?44,$J($P(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",DA,0),"^"),9,2)
..W ?59,$P(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",DA,0),"^",2)
A3 K ABPADDFN W !,"Select TRANSACTION #// " D SBRS
I $D(DFOUT)!$D(DTOUT)!$D(DLOUT)!$D(DUOUT) Q
I $D(DQOUT) D G A3
.W !!?10,"Enter the payment TRN number you wish to edit as it is"
.W !?10,"shown in the far left column of the 'Transactions"
.W " Listing'",!?10,"displayed above.",!
I +Y<1 W *7," ??",! G A3
I $D(^ABPVAO(ABPATDFN,"P",+Y,0))'=1 D W ! G A3
.W *7,!!?10,"<<< TRANSACTION NUMBER NOT FOUND >>>"
S ABPADDFN=+Y
Q
;
SBRS K DFOUT,DTOUT,DUOUT,DQOUT,DLOUT
R Y:DTIME I '$T W *7 R Y:5 G SBRS:Y="." I '$T S (DTOUT,Y)="" Q
I Y="/.," S (DFOUT,Y)="" Q
I Y="" S DLOUT="" Q
I Y="^" S (DUOUT,Y)="" Q
I Y?1"?".E!(Y["^") S (DQOUT,Y)="" Q
Q
ABPAPDEM ;MULTI-ENTRY LOOKUP; [ 06/27/91 3:32 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
+2 DO CURRENT^%ZIS
KILL ABPADDFN
SET R=0
FOR ABPA("I")=0:1
Begin DoDot:1
+3 SET R=$ORDER(^ABPVAO("BD",ABPABDFN,ABPATDFN,R))
IF +R=0
QUIT
+4 SET ABPADDFN=+R
End DoDot:1
IF +R=0
QUIT
+5 IF +ABPA("I")<1
KILL ABPADDFN
QUIT
+6 IF +ABPA("I")<2
Begin DoDot:1
+7 IF $DATA(^ABPVAO(ABPATDFN,"P",ABPADDFN,0))'=1
KILL ABPADDFN
QUIT
End DoDot:1
QUIT
+8 SET D0=ABPATDFN
SET DC=1
KILL DXS
WRITE @IOF,!
DO ^ABPAPDA
KILL DXS,D0
A0A SET $PIECE(ABPAXX,"-",81)=""
WRITE !
SET DX=0
SET DY=6
XECUTE XY
WRITE @ABPAEOP
+1 SET X="-- Multiple payment transactions for this batch date --"
+2 WRITE !?(40-($LENGTH(X)/2)),X
+3 WRITE !!?15," .....CLAIMS...... .......PAYMENT......."
+4 WRITE !?14,"TRN # FROM TO AMOUNT CODE",!,ABPAXX
A1 KILL ABPA("QF")
SET ABPADDFN=0
FOR ABPA("I")=0:0
Begin DoDot:1
+1 SET ABPADDFN=$ORDER(^ABPVAO("BD",ABPABDFN,ABPATDFN,ABPADDFN))
+2 IF +ABPADDFN<1
SET ABPA("QF")=""
QUIT
+3 IF $DATA(^ABPVAO(ABPATDFN,"P",ABPADDFN,0))'=1
QUIT
WRITE !?14,$JUSTIFY(ABPADDFN,4)
+4 SET ABPADT=0
SET ABPADT=$ORDER(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADT))
+5 IF +ABPADT'>0
QUIT
SET ABPADT=+^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADT,0)
+6 SET ABPADT=$EXTRACT(ABPADT,4,5)_"/"_$EXTRACT(ABPADT,6,7)_"/"_$EXTRACT(ABPADT,2,3)
+7 WRITE ?22,ABPADT_"-"
+8 SET ABPADT=$PIECE(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",0),"^",3)
+9 SET ABPADT=+^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADT,0)
+10 SET ABPADT=$EXTRACT(ABPADT,4,5)_"/"_$EXTRACT(ABPADT,6,7)_"/"_$EXTRACT(ABPADT,2,3)
+11 WRITE ABPADT
KILL ABPADT,ABPA("III")
+12 SET DA=0
FOR ABPA("II")=1:1
Begin DoDot:2
A2 SET DA=$ORDER(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",DA))
+1 IF +DA=0
SET ABPA("III")=""
QUIT
+2 IF +ABPA("II")>1
WRITE !
+3 WRITE ?44,$JUSTIFY($PIECE(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",DA,0),"^"),9,2)
+4 WRITE ?59,$PIECE(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",DA,0),"^",2)
End DoDot:2
IF $DATA(ABPA("III"))=1
KILL ABPA("III")
QUIT
End DoDot:1
IF $DATA(ABPA("QF"))=1
QUIT
A3 KILL ABPADDFN
WRITE !,"Select TRANSACTION #// "
DO SBRS
+1 IF $DATA(DFOUT)!$DATA(DTOUT)!$DATA(DLOUT)!$DATA(DUOUT)
QUIT
+2 IF $DATA(DQOUT)
Begin DoDot:1
+3 WRITE !!?10,"Enter the payment TRN number you wish to edit as it is"
+4 WRITE !?10,"shown in the far left column of the 'Transactions"
+5 WRITE " Listing'",!?10,"displayed above.",!
End DoDot:1
GOTO A3
+6 IF +Y<1
WRITE *7," ??",!
GOTO A3
+7 IF $DATA(^ABPVAO(ABPATDFN,"P",+Y,0))'=1
Begin DoDot:1
+8 WRITE *7,!!?10,"<<< TRANSACTION NUMBER NOT FOUND >>>"
End DoDot:1
WRITE !
GOTO A3
+9 SET ABPADDFN=+Y
+10 QUIT
+11 ;
SBRS KILL DFOUT,DTOUT,DUOUT,DQOUT,DLOUT
+1 READ Y:DTIME
IF '$TEST
WRITE *7
READ Y:5
IF Y="."
GOTO SBRS
IF '$TEST
SET (DTOUT,Y)=""
QUIT
+2 IF Y="/.,"
SET (DFOUT,Y)=""
QUIT
+3 IF Y=""
SET DLOUT=""
QUIT
+4 IF Y="^"
SET (DUOUT,Y)=""
QUIT
+5 IF Y?1"?".E!(Y["^")
SET (DQOUT,Y)=""
QUIT
+6 QUIT
