ABPAPD5 ;DISPLAY PAYMENT EDIT SCREEN CONT.; [ 07/09/91 7:42 AM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
A0 K ABPA("QF"),SA,ABPAPSDT,ABPARECV,ABPAPOST,ABPADATA,ABPA("CHK")
S ABPAPAMT=0,ABPA("STDAMT")=0,ABPA("UP","N")=0,ABPA("UP","D")=0
S ABPA("UP","S")=0,ABPARECV=$P(^ABPVAO(ABPATDFN,"P",ABPADDFN,0),"^")
S ABPARECV=$E(ABPARECV,4,5)_"/"_$E(ABPARECV,6,7)_"/"_$E(ABPARECV,2,3)
S ABPAPOST=$P(^ABPVAO(ABPATDFN,"P",ABPADDFN,0),"^",3)
S ABPAPOST=$S(ABPAPOST="N":"NO",ABPAPOST="Y":"YES",1:"???")
S ABPADATA=$P(^ABPVAO(ABPATDFN,"P",ABPADDFN,0),"^",2)
I +ABPADATA>0 D
.S ABPAPSDT=$E(ABPADATA,4,5)_"/"_$E(ABPADATA,6,7)_"/"
.S ABPAPSDT=ABPAPSDT_$E(ABPADATA,2,3)
S:$D(ABPAPSDT)=0 ABPAPSDT=""
S ABPA("CHK")=$P(^ABPVAO(ABPATDFN,"P",ABPADDFN,0),"^",6)
LOOP S (REFUND,DA)=0 F ABPA("I")=0:0 D Q:$D(ABPA("QF"))=1
.S DA=$O(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",DA))
.I +DA=0 S ABPA("QF")="" Q
.Q:$D(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",DA,0))'=1 S ABPADATA=^(0)
.W !,$J(DA,3),?7,ABPARECV S ABPAPCOD=$P(ABPADATA,"^",2)
.S ABPACDFN=$P(ABPADATA,"^",3) W ?18,$J(+ABPADATA,9,2),?32,ABPAPCOD
.I ABPACDFN]"" I $D(^ABPVAO(ABPATDFN,1,ABPACDFN,0))=1 D
..W ?36,$J($P(^ABPVAO(ABPATDFN,1,ABPACDFN,0),"^",2),8)
..S ABPA("AP",ABPACDFN,DA)=ABPADATA
.I ABPACDFN']""&("NDS"[ABPAPCOD) D
..S ABPA("UP",ABPAPCOD)=ABPA("UP",ABPAPCOD)+(+ABPADATA)
.I ABPAPCOD="S" W ?46,$J(ABPA("CHK"),15) D
..S ABPA("STDAMT")=ABPA("STDAMT")+(+ABPADATA)
..I ABPA("CHK")']"" S REFUND=REFUND+(+ABPADATA*-1)
.W ?65,ABPAPSDT S ABPAPAMT=ABPAPAMT+(+ABPADATA)
ENDLOOP K ABPAX S $P(ABPAX,"=",81)="" W !,ABPAX
K DIR S DIR("A")="Select ACTION (1-File, 2-Edit, 3-Cancel): "
S DIR(0)="SOAB^1:File;2:Edit;3:Cancel;",DIR("B")=3 D ^DIR
G ^ABPAPD7:+Y=1,^ABPAPD6:+Y=2,^ABPAPD8
;
PROMPT W ?5,"Select FILE, EDIT or CANCEL (F/E/C)// " D SBRS
I $D(DFOUT)!$D(DUOUT)!$D(DLOUT)!$D(DQOUT) D G PROMPT
.W *7,!,"Please enter ""F"", ""E"", or ""C"".",!
I $D(DTOUT) G ^ABPAPD8
S X=Y I "FEC"'[X D G PROMPT
.W *7,!,"Please enter ""F"", ""E"", or ""C"".",!
I X="E" W "dit" G ^ABPAPD6
I X="C" W "ancel" G ^ABPAPD8
W "ile" G ^ABPAPD7
;
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
ABPAPD5 ;DISPLAY PAYMENT EDIT SCREEN CONT.; [ 07/09/91 7:42 AM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
A0 KILL ABPA("QF"),SA,ABPAPSDT,ABPARECV,ABPAPOST,ABPADATA,ABPA("CHK")
+1 SET ABPAPAMT=0
SET ABPA("STDAMT")=0
SET ABPA("UP","N")=0
SET ABPA("UP","D")=0
+2 SET ABPA("UP","S")=0
SET ABPARECV=$PIECE(^ABPVAO(ABPATDFN,"P",ABPADDFN,0),"^")
+3 SET ABPARECV=$EXTRACT(ABPARECV,4,5)_"/"_$EXTRACT(ABPARECV,6,7)_"/"_$EXTRACT(ABPARECV,2,3)
+4 SET ABPAPOST=$PIECE(^ABPVAO(ABPATDFN,"P",ABPADDFN,0),"^",3)
+5 SET ABPAPOST=$SELECT(ABPAPOST="N":"NO",ABPAPOST="Y":"YES",1:"???")
+6 SET ABPADATA=$PIECE(^ABPVAO(ABPATDFN,"P",ABPADDFN,0),"^",2)
+7 IF +ABPADATA>0
Begin DoDot:1
+8 SET ABPAPSDT=$EXTRACT(ABPADATA,4,5)_"/"_$EXTRACT(ABPADATA,6,7)_"/"
+9 SET ABPAPSDT=ABPAPSDT_$EXTRACT(ABPADATA,2,3)
End DoDot:1
+10 IF $DATA(ABPAPSDT)=0
SET ABPAPSDT=""
+11 SET ABPA("CHK")=$PIECE(^ABPVAO(ABPATDFN,"P",ABPADDFN,0),"^",6)
LOOP SET (REFUND,DA)=0
FOR ABPA("I")=0:0
Begin DoDot:1
+1 SET DA=$ORDER(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",DA))
+2 IF +DA=0
SET ABPA("QF")=""
QUIT
+3 IF $DATA(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",DA,0))'=1
QUIT
SET ABPADATA=^(0)
+4 WRITE !,$JUSTIFY(DA,3),?7,ABPARECV
SET ABPAPCOD=$PIECE(ABPADATA,"^",2)
+5 SET ABPACDFN=$PIECE(ABPADATA,"^",3)
WRITE ?18,$JUSTIFY(+ABPADATA,9,2),?32,ABPAPCOD
+6 IF ABPACDFN]""
IF $DATA(^ABPVAO(ABPATDFN,1,ABPACDFN,0))=1
Begin DoDot:2
+7 WRITE ?36,$JUSTIFY($PIECE(^ABPVAO(ABPATDFN,1,ABPACDFN,0),"^",2),8)
+8 SET ABPA("AP",ABPACDFN,DA)=ABPADATA
End DoDot:2
+9 IF ABPACDFN']""&("NDS"[ABPAPCOD)
Begin DoDot:2
+10 SET ABPA("UP",ABPAPCOD)=ABPA("UP",ABPAPCOD)+(+ABPADATA)
End DoDot:2
+11 IF ABPAPCOD="S"
WRITE ?46,$JUSTIFY(ABPA("CHK"),15)
Begin DoDot:2
+12 SET ABPA("STDAMT")=ABPA("STDAMT")+(+ABPADATA)
+13 IF ABPA("CHK")']""
SET REFUND=REFUND+(+ABPADATA*-1)
End DoDot:2
+14 WRITE ?65,ABPAPSDT
SET ABPAPAMT=ABPAPAMT+(+ABPADATA)
End DoDot:1
IF $DATA(ABPA("QF"))=1
QUIT
ENDLOOP KILL ABPAX
SET $PIECE(ABPAX,"=",81)=""
WRITE !,ABPAX
+1 KILL DIR
SET DIR("A")="Select ACTION (1-File, 2-Edit, 3-Cancel): "
+2 SET DIR(0)="SOAB^1:File;2:Edit;3:Cancel;"
SET DIR("B")=3
DO ^DIR
+3 IF +Y=1
GOTO ^ABPAPD7
IF +Y=2
GOTO ^ABPAPD6
GOTO ^ABPAPD8
+4 ;
PROMPT WRITE ?5,"Select FILE, EDIT or CANCEL (F/E/C)// "
DO SBRS
+1 IF $DATA(DFOUT)!$DATA(DUOUT)!$DATA(DLOUT)!$DATA(DQOUT)
Begin DoDot:1
+2 WRITE *7,!,"Please enter ""F"", ""E"", or ""C"".",!
End DoDot:1
GOTO PROMPT
+3 IF $DATA(DTOUT)
GOTO ^ABPAPD8
+4 SET X=Y
IF "FEC"'[X
Begin DoDot:1
+5 WRITE *7,!,"Please enter ""F"", ""E"", or ""C"".",!
End DoDot:1
GOTO PROMPT
+6 IF X="E"
WRITE "dit"
GOTO ^ABPAPD6
+7 IF X="C"
WRITE "ancel"
GOTO ^ABPAPD8
+8 WRITE "ile"
GOTO ^ABPAPD7
+9 ;
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
