- ABPAPD1 ;PVT-INS PYMT ENTRY FROM END^ABPAPD3; [ 06/21/91 5:56 AM ]
- ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
- BEG D XIT S U="^"
- S ABPA("HD",1)=ABPATLE,ABPA("HD",2)="Post PAYMENT Data"
- D ^ABPAHD W !,"*"
- S X="CURRENT BATCH FACILITY: "_$P(^DIC(4,ABPASITE,0),"^",1)
- W ?(40-($L(X)/2)),X,?78,"*",! F X=1:1:79 W "*"
- S X="BATCH DATE = "_ABPABDT W !!?(40-($L(X)/2)),X
- PAT W !! D ^ABPAPATL
- I $D(ABPATDFN)'=1 D G FAC^ABPAPD0
- .K ABPA("HD")
- .S ABPA("HD",1)=ABPATLE,ABPA("HD",2)="Post PAYMENT Data"
- .D ^ABPAHD S X="BATCH DATE = "_ABPABDT W !!?(40-($L(X)/2)),X
- G:+ABPATDFN<1 BEG
- L ^ABPVAO(ABPATDFN):3 I '$T D G PAT
- .W *7,!!?5,"<<< PATIENT RECORD UNAVAILABLE AT THIS TIME -- "
- .W "TRY AGAIN LATER >>>"
- HEAD S $P(ABPAX,"=",81)="",ABPAHRN=$P(^ABPVAO(ABPATDFN,0),"^",3)
- S ABPAL=$E($P(^DIC(4,$P(^ABPVAO(DA,0),U,2),0),U),1,19)
- S $P(ABPAXX,"-",81)="" ;,ABPAHD1="POST Payments" D HEADER^ABPAMAIN
- ;W !!,"Patient: ",ABPAPAT_" ("_ABPAHRN_")",?50,"Facility: "
- ;W $E(ABPAL,1,19)
- K DXS S U="^",DC=1,D0=ABPATDFN W @IOF,! D ^ABPAPDB K DXS G ^ABPAPD2
- XIT K ABPARECV,ABPAPD,ABPAENT,ABPADDFN,ABPATDFN,ABPADT,ABPADTD,ABPAPAT,D
- K ABPA,ABPAL,DIC,C,ABPAQKS,ABPAQK,ABPAHRN,DA,J,K,Z,XQH,ABPACOD
- K ABPAC,ABPAI,ABPAXX,ABPAINS,DIE,DR,%DT,ABPAFRDT,ABPATODT,ABPAX
- K ABPACSCR,ABPACHK,GOTCHECK,CLOSE,ABPACCNT,ABPACAMT,ABPAPAMT,ABPAPTOT
- K ABPATPD,ABPACOD,ABPACTOB,ABPACTPD,ABPACURB,ABPADATA,ABPADOS,ABPAJ
- K ABPAJ,ABPAK,ABPAOBAL,ABPAP1,ABPAP2,ABPAP3,ABPAP4,ABPAP5,ABPAPCOD
- K ABPAPOST,ABPAPSDT,ABPAPSSN,ABPAPTR,ABPAT1,ABPAT2,ABPAT3,ABPAT4
- K ABPAT5,ABPAT6,ABPATA2,ABPATA3,ABPATA4,ABPATA5,ABPATA7,ABPATBAL
- K ABPATCNT,ABPAY,ABPAZ,CLOSED,DIR,X Q
- ABPAPD1 ;PVT-INS PYMT ENTRY FROM END^ABPAPD3; [ 06/21/91 5:56 AM ]
- +1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
- BEG DO XIT
- SET U="^"
- +1 SET ABPA("HD",1)=ABPATLE
- SET ABPA("HD",2)="Post PAYMENT Data"
- +2 DO ^ABPAHD
- WRITE !,"*"
- +3 SET X="CURRENT BATCH FACILITY: "_$PIECE(^DIC(4,ABPASITE,0),"^",1)
- +4 WRITE ?(40-($LENGTH(X)/2)),X,?78,"*",!
- FOR X=1:1:79
- WRITE "*"
- +5 SET X="BATCH DATE = "_ABPABDT
- WRITE !!?(40-($LENGTH(X)/2)),X
- PAT WRITE !!
- DO ^ABPAPATL
- +1 IF $DATA(ABPATDFN)'=1
- Begin DoDot:1
- +2 KILL ABPA("HD")
- +3 SET ABPA("HD",1)=ABPATLE
- SET ABPA("HD",2)="Post PAYMENT Data"
- +4 DO ^ABPAHD
- SET X="BATCH DATE = "_ABPABDT
- WRITE !!?(40-($LENGTH(X)/2)),X
- End DoDot:1
- GOTO FAC^ABPAPD0
- +5 IF +ABPATDFN<1
- GOTO BEG
- +6 LOCK ^ABPVAO(ABPATDFN):3
- IF '$TEST
- Begin DoDot:1
- +7 WRITE *7,!!?5,"<<< PATIENT RECORD UNAVAILABLE AT THIS TIME -- "
- +8 WRITE "TRY AGAIN LATER >>>"
- End DoDot:1
- GOTO PAT
- HEAD SET $PIECE(ABPAX,"=",81)=""
- SET ABPAHRN=$PIECE(^ABPVAO(ABPATDFN,0),"^",3)
- +1 SET ABPAL=$EXTRACT($PIECE(^DIC(4,$PIECE(^ABPVAO(DA,0),U,2),0),U),1,19)
- +2 ;,ABPAHD1="POST Payments" D HEADER^ABPAMAIN
- SET $PIECE(ABPAXX,"-",81)=""
- +3 ;W !!,"Patient: ",ABPAPAT_" ("_ABPAHRN_")",?50,"Facility: "
- +4 ;W $E(ABPAL,1,19)
- +5 KILL DXS
- SET U="^"
- SET DC=1
- SET D0=ABPATDFN
- WRITE @IOF,!
- DO ^ABPAPDB
- KILL DXS
- GOTO ^ABPAPD2
- XIT KILL ABPARECV,ABPAPD,ABPAENT,ABPADDFN,ABPATDFN,ABPADT,ABPADTD,ABPAPAT,D
- +1 KILL ABPA,ABPAL,DIC,C,ABPAQKS,ABPAQK,ABPAHRN,DA,J,K,Z,XQH,ABPACOD
- +2 KILL ABPAC,ABPAI,ABPAXX,ABPAINS,DIE,DR,%DT,ABPAFRDT,ABPATODT,ABPAX
- +3 KILL ABPACSCR,ABPACHK,GOTCHECK,CLOSE,ABPACCNT,ABPACAMT,ABPAPAMT,ABPAPTOT
- +4 KILL ABPATPD,ABPACOD,ABPACTOB,ABPACTPD,ABPACURB,ABPADATA,ABPADOS,ABPAJ
- +5 KILL ABPAJ,ABPAK,ABPAOBAL,ABPAP1,ABPAP2,ABPAP3,ABPAP4,ABPAP5,ABPAPCOD
- +6 KILL ABPAPOST,ABPAPSDT,ABPAPSSN,ABPAPTR,ABPAT1,ABPAT2,ABPAT3,ABPAT4
- +7 KILL ABPAT5,ABPAT6,ABPATA2,ABPATA3,ABPATA4,ABPATA5,ABPATA7,ABPATBAL
- +8 KILL ABPATCNT,ABPAY,ABPAZ,CLOSED,DIR,X
- QUIT
