- ABPAPDD2 ;DISPLAY PAYMENT TRANS. SCREEN.; [ 06/25/91 4:02 PM ]
- ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
- DISP K DIC,DIE,DA,DR,ABPA("QF"),ABPADOS,ABPA("I"),ABPA("II"),ABPACDFN
- K ABPAVTYP,ABPA("QF"),ABPAPTR,ABPADATA,ABPATYPE
- S U="^",DC=1,D0=ABPATDFN K DXS W @IOF,! D ^ABPAPDB K DXS,D0 W !
- S ABPA("I")="Current Payment Transactions" W ?(40-($L(ABPA("I"))/2))
- W ABPA("I"),!!,"TRN DATE REC'D PAID AMOUNT CODE CLAIM # "
- W "CHECK NUMBER DATE POSTED",!,"--- ---------- ----------- "
- W "---- -------- --------------- -----------"
- 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 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)
- .W ?65,ABPAPSDT S ABPAPAMT=ABPAPAMT+(+ABPADATA)
- ENDLOOP S $P(ABPAX,"=",81)="" W !,ABPAX
- K ABPAPOST,ABPAPSDT,ABPARECV,ABPA("QF"),ABPADATA,ABPA("I")
- S ABPACHK=ABPA("CHK") G ^ABPAPDD4
- ABPAPDD2 ;DISPLAY PAYMENT TRANS. SCREEN.; [ 06/25/91 4:02 PM ]
- +1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
- DISP KILL DIC,DIE,DA,DR,ABPA("QF"),ABPADOS,ABPA("I"),ABPA("II"),ABPACDFN
- +1 KILL ABPAVTYP,ABPA("QF"),ABPAPTR,ABPADATA,ABPATYPE
- +2 SET U="^"
- SET DC=1
- SET D0=ABPATDFN
- KILL DXS
- WRITE @IOF,!
- DO ^ABPAPDB
- KILL DXS,D0
- WRITE !
- +3 SET ABPA("I")="Current Payment Transactions"
- WRITE ?(40-($LENGTH(ABPA("I"))/2))
- +4 WRITE ABPA("I"),!!,"TRN DATE REC'D PAID AMOUNT CODE CLAIM # "
- +5 WRITE "CHECK NUMBER DATE POSTED",!,"--- ---------- ----------- "
- +6 WRITE "---- -------- --------------- -----------"
- 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 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)
- End DoDot:2
- +13 WRITE ?65,ABPAPSDT
- SET ABPAPAMT=ABPAPAMT+(+ABPADATA)
- End DoDot:1
- IF $DATA(ABPA("QF"))=1
- QUIT
- ENDLOOP SET $PIECE(ABPAX,"=",81)=""
- WRITE !,ABPAX
- +1 KILL ABPAPOST,ABPAPSDT,ABPARECV,ABPA("QF"),ABPADATA,ABPA("I")
- +2 SET ABPACHK=ABPA("CHK")
- GOTO ^ABPAPDD4
