- 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
