- ABPAPD6 ;EDIT PAYMENT TRANSACTIONS; [ 06/25/91 4:54 PM ]
- ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
- A0 W !,"Select TRANSACTION #// " D SBRS
- I $D(DFOUT)!$D(DTOUT)!$D(DLOUT)!$D(DUOUT) G DISP^ABPAPD3
- I $D(DQOUT) D G A0
- .W !!?10,"Enter the payment TRN number you wish to edit as it is"
- .W !?10,"listed in the far left column of the 'Payment Information'"
- .W !?10,"section of the edit screen above.",!
- K DIE,DA,DR S DA(2)=ABPATDFN,DA(1)=ABPADDFN,ABPAADFN=+Y,DA=+Y
- I $D(^ABPVAO(DA(2),"P",DA(1),"A",DA,0))'=1 D G A0
- .W *7,!!?10,"<<< TRANSACTION NOT FOUND >>>",!
- D ^ABPAPD2C S DA(2)=ABPATDFN,DA(1)=ABPADDFN,DA=ABPAADFN
- S DIE="^ABPVAO("_DA(2)_",""P"","_DA(1)_",""A"",",DR=".01;1"
- S DIE("NO^")="" W ! D ^DIE G:$D(DA)'=11 DISP^ABPAPD3
- I ABPACCNT=1 D G DISP^ABPAPD3
- .S DR="2///"_ABPA("C",1) D ^DIE
- K DIR S DIR(0)="NO^1:"_ABPACCNT,DIR("A")="Apply to which claim"
- S ABPATPTR=$P(^ABPVAO(DA(2),"P",DA(1),"A",DA,0),"^",3)
- F ABPA("I")=1:1 Q:$D(ABPA("C",ABPA("I")))'=1!($D(DIR("B"))=1) D
- .S:ABPA("C",ABPA("I"))=ABPATPTR DIR("B")=ABPA("I")
- D ^DIR G:'X&(X'["@") DISP^ABPAPD3
- I X["@" S DR="2///@" D ^DIE G DISP^ABPAPD3
- G:$D(ABPA("C",X))'=1 DISP^ABPAPD3 S DR="2///"_ABPA("C",X) D ^DIE
- G DISP^ABPAPD3
- 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
- ABPAPD6 ;EDIT PAYMENT TRANSACTIONS; [ 06/25/91 4:54 PM ]
- +1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
- A0 WRITE !,"Select TRANSACTION #// "
- DO SBRS
- +1 IF $DATA(DFOUT)!$DATA(DTOUT)!$DATA(DLOUT)!$DATA(DUOUT)
- GOTO DISP^ABPAPD3
- +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,"listed in the far left column of the 'Payment Information'"
- +5 WRITE !?10,"section of the edit screen above.",!
- End DoDot:1
- GOTO A0
- +6 KILL DIE,DA,DR
- SET DA(2)=ABPATDFN
- SET DA(1)=ABPADDFN
- SET ABPAADFN=+Y
- SET DA=+Y
- +7 IF $DATA(^ABPVAO(DA(2),"P",DA(1),"A",DA,0))'=1
- Begin DoDot:1
- +8 WRITE *7,!!?10,"<<< TRANSACTION NOT FOUND >>>",!
- End DoDot:1
- GOTO A0
- +9 DO ^ABPAPD2C
- SET DA(2)=ABPATDFN
- SET DA(1)=ABPADDFN
- SET DA=ABPAADFN
- +10 SET DIE="^ABPVAO("_DA(2)_",""P"","_DA(1)_",""A"","
- SET DR=".01;1"
- +11 SET DIE("NO^")=""
- WRITE !
- DO ^DIE
- IF $DATA(DA)'=11
- GOTO DISP^ABPAPD3
- +12 IF ABPACCNT=1
- Begin DoDot:1
- +13 SET DR="2///"_ABPA("C",1)
- DO ^DIE
- End DoDot:1
- GOTO DISP^ABPAPD3
- +14 KILL DIR
- SET DIR(0)="NO^1:"_ABPACCNT
- SET DIR("A")="Apply to which claim"
- +15 SET ABPATPTR=$PIECE(^ABPVAO(DA(2),"P",DA(1),"A",DA,0),"^",3)
- +16 FOR ABPA("I")=1:1
- IF $DATA(ABPA("C",ABPA("I")))'=1!($DATA(DIR("B"))=1)
- QUIT
- Begin DoDot:1
- +17 IF ABPA("C",ABPA("I"))=ABPATPTR
- SET DIR("B")=ABPA("I")
- End DoDot:1
- +18 DO ^DIR
- IF 'X&(X'["@")
- GOTO DISP^ABPAPD3
- +19 IF X["@"
- SET DR="2///@"
- DO ^DIE
- GOTO DISP^ABPAPD3
- +20 IF $DATA(ABPA("C",X))'=1
- GOTO DISP^ABPAPD3
- SET DR="2///"_ABPA("C",X)
- DO ^DIE
- +21 GOTO DISP^ABPAPD3
- 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
