- 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
