BARPPY01 ; IHS/SD/TMM - PREPAYMENT ENTRY MAY 11,2010 ; 05/11/2010
;;1.8;IHS ACCOUNTS RECEIVABLE;**19**;OCT 26, 2005
;
; IHS/SD/TMM 06/18/10 1.8*19 Add Prepayment functionality.
; See work order 3PMS10001
; ------------------------
; 1. Display prepayments not assigned to a batch (^BARCLU)
; 2. Remove prompt: AUTO PRINT RECEIPT (^BARCLU01)
; 3. Prepayment entry ^BARPPY01 (new routine),^BARCLU1,^BARPUTL
; 4. Display prepayments matching payment type selected (^BARCLU)
; 5. Allow user to assign prepayment to batch (^BARCLU,^BARCLU01,^BARPUTL,^BARPST1,^BARBLLK)
; 6. Print Prepayment Receipt (^BARPPY02) (new routine)
; 7. Allow user to look up registered patient with no bills in system
; *********************************************************************
;
; BARDONE - All data has been collected, ready to review and file/modify
; BARSTOP - Exit processing
;
Q
;
EN ;EP - Prepayment Collections
S BARESIG=""
D SIG^XUSESIG ;electronic signature test
Q:X1="" ;elec signature test
S BARESIG=1
F I=1:1 D EN1 Q:($D(DUOUT)!$D(DTOUT)!$D(DIROUT))!$G(BARSTOP)
XIT ;
D CLEAN
Q
;
EN1 ; Loop
D GETDATA
Q:BARSTOP
I $D(DIROUT) S BARSTOP=1 Q
I $D(DUOUT)!$D(DTOUT) Q
I 'BARDONE G EN1
D RECAP^BARPPY1A
I $G(BARQUIT)=1 Q ;user opted to quit, not file receipt ;
Q:BARSTOP
I $D(DIROUT) S BARSTOP=1 Q
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT) Q
I BARFILE="Q" G EN1
D FILE^BARPPY1A
D RECEIPT^BARPPY02(BARPPIEN) ;prompt to print receipt
Q
;
GETDATA ; Get Pre-payment data
; Select Department (Clinic Stop)
Q:$G(BARSTOP)
D INIT
D SELDEPT
Q:BARSTOP
I $D(DTOUT)!$D(DUOUT) Q
I $G(BARDEPTI)="" S BARSTOP=1 Q
SELPMT ; Select Payment Type
D SELPMT1
Q:BARSTOP
I $D(DIROUT) S BARSTOP=1 Q
I '$G(BARUPDT),$D(DUOUT) G GETDATA
I $G(BARUPDT),$D(DUOUT) Q
I $D(DTOUT) Q
; Get additional payment data for selected payment type
S BARDAT=0 ;identifies if required data for this payment type was collected 0/1
S BARTAG=$P(Y(0)," ",1)
PMTDATA ;
Q:BARSTOP
I '$G(BARAMTUP) D @BARTAG ;get additional data for the selected payment type
I $G(BARAMTUP) D
. K BARAMTUP
. S BARTAG1=$S(BARTAG="CHECK":"CHECKNM","^CREDIT^DEBIT^"[BARTAG:"CARDNM",1:"CASH")
. D @BARTAG1
Q:BARSTOP
I $D(DIROUT) S BARSTOP=1 Q
I '$G(BARUPDT),$D(DUOUT) G SELPMT
I $G(BARUPDT),$D(DUOUT) G SELPMT
I $D(DTOUT) Q
I '$G(BARUPDT),'BARDAT G SELPMT
I $G(BARUPDT) Q ;edit payment data only for updates
;
AMOUNT ; Enter Credit amount
K BARAMTUP
D AMOUNT1
Q:BARSTOP
I $D(DIROUT) S BARSTOP=1 Q
I '$G(BARUPDT),$D(DUOUT) S BARAMTUP=1 G PMTDATA
I $G(BARUPDT),$D(DUOUT) Q
I $D(DTOUT) Q
ARBILL ; Get A/R Bill, Patient, A/R Bill DOS
D ARBILL1
Q:BARSTOP
I $D(DIROUT) S BARSTOP=1 Q
I '$G(BARUPDT),$D(DUOUT) G AMOUNT
I $G(BARUPDT),$D(DUOUT) Q
I $D(DTOUT) Q
PAYDOS ; Get DOS for this payment
D PAYDOS1
Q:BARSTOP
I $D(DIROUT) S BARSTOP=1 Q
I '$G(BARUPDT),$D(DUOUT) G ARBILL
I $G(BARUPDT),$D(DUOUT) Q
I $D(DTOUT) Q
; Select patient if not selected during A/R Bill entry
GETPAT ;
D GETPAT1
Q:BARSTOP
I $D(DIROUT) S BARSTOP=1 Q
I '$G(BARUPDT),$D(DUOUT) G PAYDOS
I $G(BARUPDT),$D(DUOUT) Q
I $D(DTOUT) Q
; Enter comments
D CMTS
Q:BARSTOP
I $D(DIROUT) S BARSTOP=1 Q
I '$G(BARUPDT),$D(DUOUT) G PAYDOS
I $G(BARUPDT),$D(DUOUT) Q
I $D(DTOUT) Q
; Data entry complete
S BARDONE=1
Q
;
SELDEPT ;
K DIC,DR,DA,X,Y
S DIC="^DIC(40.7,"
W !
S DIC(0)="AEZQM"
S DIC("A")="Enter your Department: "
S BARTMP=$G(BARDEPTE)
I BARTMP'="" S DIR("B")=BARTMP
K DD,DO
D ^DIC
I X="^^" S BARSTOP=1 Q
I $D(DTOUT)!$D(DUOUT) Q
;I 'Y G SELDEPT
I Y'>0 S (BARDEPTI,BARDEPTE)="" Q
S BARDEPTI=$P(Y,U) ;CLINIC STOP IEN
S BARDEPTE=$P(Y,U,2) ;CLINIC STOP NAME
K DIC
Q
; *********************************************************************
SELPMT1 ; Select Payment Type
Q:BARSTOP
K DIR,DTOUT,DUOUT,DIROUT,DIRUT W !
S DIR(0)="SA^CA:CASH;CK:CHECK;CC:CREDIT CARD;DB:DEBIT CARD"
S DIR("A")="PAYMENT TYPE: "
S BARTMP=$$PAYTYPE^BARPPY1A($G(BARPMTYP))
I BARTMP'="" S DIR("B")=BARTMP
K DA
D ^DIR
I $D(DIROUT) S BARSTOP=1 Q
I $D(DTOUT)!$D(DUOUT) Q
S BARPMTYP=Y
Q
;
CASH ; Collect additional data related to CASH payment
; Account name/account number not needed for cash payments
Q:BARSTOP
S BARDAT=1
; Reset 'payment type' fields in case payment type was modified from other to 'cash'
I BARPMTYP="CA" S (BARCK,BARCNAME,BARCTYPE,BARCTYPN)=""
Q
;
CHECK ; data related to CHECK payment
Q:BARSTOP
; Get check number
K DIR,DTOUT,DUOUT,DIROUT,DIRUT W !
S DIR(0)="FA"
S DIR("A")="CHECK NUMBER: "
S BARTMP=$G(BARCK)
I BARTMP'="" S DIR("B")=BARTMP
S DIR("?")="Enter the check number, (i.e. number in the top right corner of the check)"
D ^DIR
I X="" D G CHECK
. W !,?5,"Check Number is required",!!
I $D(DIROUT) S BARSTOP=1 Q
I $D(DUOUT)!$D(DTOUT) Q
S BARCK=X
CHECKNM ;Checking account name
Q:BARSTOP
;prompt for name on checking account or name of person making the payment
K DIR,DTOUT,DUOUT,DIROUT,DIRUT W !
S DIR(0)="FA"
S DIR("A")="NAME ON CHECKING ACCOUNT: "
S DIR("?")="Enter the name for this checking account, i.e. JOHN DOE"
D ^DIR
I X="" D G CHECKNM
. W !,?5,"Checking Account Name is required",!!
I $D(DIROUT) S BARSTOP=1 Q
I '$G(BARUPDT),$D(DUOUT) G CHECK
I $G(BARUPDT),$D(DUOUT) Q
I $D(DTOUT) Q
S BARCNAME=X
S BARDAT=1 ;required data collected
; Reset 'payment type' fields in case payment type was modified from other to 'check'
I BARPMTYP="CK" S (BARCTYPE,BARCTYPN)=""
Q
;
DEBIT ;data related to DEBIT CARD payment
CREDIT ;data related to CREDIT CARD payment
Q:BARSTOP
K DIR,DTOUT,DUOUT,DIROUT,DIRUT W !
S DIR(0)="SA^A:AMERICAN EXPRESS;C:DINERS CLUB;D:DISCOVER;M:MASTERCARD;V:VISA"
S DIR("A")="CARD TYPE: "
S BARTMP=$$CARDTYPE^BARPPY1A($G(BARCTYPE))
I BARTMP'="" S DIR("B")=BARTMP
S DIR("?")="Enter type of credit card, i.e. Visa, Mastercard, etc...)"
K DA
D ^DIR
I X="" D G CREDIT
. W !,?5,"Card type is required",!!
I $D(DIROUT) S BARSTOP=1 Q
I $D(DTOUT)!$D(DUOUT) Q
S BARCTYPE=Y ;card type code (i.e. "M")
S BARCTYPN=Y(0) ;card type name (i.e. "MASTERCARD")
CARDNM ;prompt for name on credit card
Q:BARSTOP
K DIR,DTOUT,DUOUT,DIROUT,DIRUT W !
S DIR(0)="FA"
S DIR("A")="NAME ON CARD: "
S DIR("?")="Enter the card holder name shown on the card, i.e. JOHN X DOE"
D ^DIR
I X="" D G CARDNM
. W !,?5,"Card holder name is required",!!
I $D(DIROUT) S BARSTOP=1 Q
I $D(DUOUT) G CREDIT
I $D(DTOUT) Q
S BARCNAME=X
S BARDAT=1 ;required data collected
; Reset 'payment type' field in case payment type was modified from other to CR/DB
I "^CC^DB^"[BARPMTYP S BARCK=""
Q
;
AMOUNT1 ;prompt for payment
Q:BARSTOP
S BARAMT=$G(BARAMT)
K DIR,DTOUT,DUOUT,DIROUT,DIRUT W !
S DIR(0)="NA^.01:999999.99:2"
S DIR("A")="CREDIT: "
K DA
D ^DIR
I $D(DIROUT) S BARSTOP=1 Q
I $D(DTOUT)!$D(DUOUT) Q
S BARAMT=X
Q
;
ARBILL1 ; Prompt for A/R bill #, Patient Name, Bill DOS
Q:BARSTOP
K BARFPASS
S BARNEWPT=0
W !
; IHS/SD/PKD 1/6/11
K BARBL,BARBLIEN,BARDOSB,BARDOSE,BAREND,BARSTART
K BARFPASS,BARPASS
K BARPAT,BARTMPB,BARTMPE,BARZ ; omit K BARPDOS
S BARBIL=0,BARBLIEN="" ;No bill selected yet
F D Q:('+BARBIL)!(BARSTOP)!$D(DUOUT)!$D(DTOUT)!$G(BARNEWPT)=1 ;Ask A/R bills loop
. I $G(BARNEWPT)=1 S BARFPASS=BARZ Q
. K BARPAT,BARZ
. S BARBIL=1 ; Bill Entry Loop Flag
. S BARFPASS=$$GETBIL ; Get bills by bill, patient, or DOS
. Q:BARSTOP!$D(DTOUT)
. I (BARFPASS=0)!($P(BARFPASS,U,4)=""),+$G(BARPAT)>0 K BARPAT
. I BARFPASS=0 S BARBIL=0 Q ; No bill selected
. I $G(BARNEWPT)=1 Q ;Registered patient with no A/R Bills
. S BARPASS=$P(BARFPASS,U,1,3) ; needed for FINDBIL^BARFPST3
. ; If no A/R Bill IEN
. I '+$P(BARFPASS,U,4) D FINDBIL^BARFPST3 Q:'BARCNT Q:'+BARASK
. I $D(DIROUT) S BARSTOP=1 Q
. Q:$D(DTOUT)
. ; Update BARFPASS with A/R Bill DOS info from FINDBIL call
. I BARFPASS'=0 D
.. S BARBLIEN=$P(BARFPASS,U,4) ; A/R BILL IEN
.. S BARTMPB=$$GET1^DIQ(90050.01,BARBLIEN_",",102,"I") ;DOS begin
.. S BARTMPE=$$GET1^DIQ(90050.01,BARBLIEN_",",103,"I") ;DOS end
.. S $P(BARFPASS,U,2)=BARTMPB
.. S $P(BARFPASS,U,3)=BARTMPE
.. ; try this IHS/SD/PKD 1/6/11
.. S (BARPDOS,BARDOSB)=BARTMPB ;DOS defaults to BILL DOS
.. S BARBIL=0
S BARDOSB=$P(BARFPASS,U,2) ; DOS begin
S BARDOSE=$P(BARFPASS,U,3) ; DOS end
S BARBLIEN=$P(BARFPASS,U,4) ; A/R BILL IEN
I BARBLIEN'="" S (BARPAT,BARPTI1)=+($P(BARFPASS,U,1)) ; Patient IEN override any previous if bill change
I +$G(BARPAT)=0 S (BARPAT,BARPTI1,BARPTNM1)="" ;if Bill Entered, keep Patient in sync IHS/SD/PKD 1/6/11
I +$G(BARPAT)>0 D Q ;Patient (BARPAT) selected in ARBILL1
. ; Set patient IEN and NAME to what was selected when selecting A/R Bill data
. S BARPTI1=BARPAT
. S BARPTNM1=$$GET1^DIQ(9000001,BARPTI1,.01) ; Patient Name
Q
;
PAYDOS1 ; Enter DOS for the Payment
Q:BARSTOP
K DIR,DTOUT,DUOUT,DIROUT,DIRUT W !
; If BILL DOS captured set that as the default for this entry
S DIR(0)="DA^::E"
S DIR("A")="PAYMENT FOR DOS: "
I $G(BARPDOS)="" S BARPDOS=$G(BARDOSB)
S Y=BARPDOS
D D^DIQ ;converts internal FM date to external, returns external dt Y
S BARTMP=Y
I BARTMP'="" S DIR("B")=BARTMP
D ^DIR
I $D(DIROUT) S BARSTOP=1 Q
I $D(DTOUT)!$D(DUOUT) Q
I Y="" G PAYDOS1
S BARPDOS=Y
Q
;
GETPAT1 ; Select Patient if not selected in ARBILL1
Q:BARSTOP
W !
I 'BARUPDT,+$G(BARPAT)>0 D Q ;Patient (BARPAT) selected in ARBILL1
. ; Set patient IEN and NAME to what was selected when selecting A/R Bill data
. S BARPTI1=BARPAT
. S BARPTNM1=$$GET1^DIQ(9000001,BARPTI1,.01) ; Patient Name
K DIC,BARZ
S BARTMP=$S($D(BARPTI1):BARPTI1,+$G(BARPAT)>0:BARPAT,1:"")
I BARTMP S DIC("B")=$$GET1^DIQ(9000001,BARTMP,.01)
S DIC="^AUPNPAT("
S DIC(0)="IAEMZ"
S DIC("A")="Select Patient: "
D ^DIC
K DIC
S BARPTI1=X
I X="" D G GETPAT1
. W !,?5,"Patient Name is required",!!
I $D(DIROUT) S BARSTOP=1 Q
I $D(DTOUT)!$D(DUOUT) Q
Q:+Y<0
S BARPTI1=+Y ;patient IEN (select patient prompt)
S BARPAT1(0)=Y(0) ;patient name (select patient prompt)
S BARPTNM1=$P($G(^DPT(+BARPTI1,0)),"^",1) ;patient name (select patient prompt)
I '$D(^BARBL(DUZ(2),"ABC",+Y)) D
. K DIR,DTOUT,DUOUT,DIROUT,DIRUT W !
. S DIR(0)="SO^Y:YES Continue;N:NO Select a different patient"
. S DIR("A")="This is a registered patient with no bills. Continue Y/N: "
. ;S DIR("B")="N"
. K DA
. D ^DIR
. I $D(DIROUT) S BARSTOP=1 Q
. I $D(DTOUT)!$D(DUOUT) Q
. I "Nn"[Y D G GETPAT1
.. K BARPTI1,BARPAT1(0),BARPTNM1
. S BARNEWPT=2 ;Registered patient only, no bills (2nd Select Patient Prompt)
Q
;
CMTS ; Enter Pre-payment Comments
K DIR,DTOUT,DUOUT,DIROUT,DIRUT W !
S BARCMTS=$G(BARCMTS)
S DIR(0)="FAOU^:255"
S DIR("A")="COMMENTS: "
D ^DIR
I $D(DIROUT) S BARSTOP=1 Q
I $D(DTOUT)!$D(DUOUT) Q
S BARCMTS=X
Q
;***********
; COPIED FROM GETBIL^BARFPST3
; modified to allow user to "^" back to prior prompt or "^^" to
; exit completely
;
GETBIL() ; EP
GB1 ; Return point when user enters "^" in ASKPAT tag
; EP - Flat Rate Posting - Bill Entry
; If Editing, ask Flat Rate Posting Bill
; Kill identifying Vars if chg'g BILL
; IHS/SD/PKD 1/5/11
;K BARBLIEN,BARPDOS,BARDOSB,BARDOSE,BAREND,BARPASS,BARPATI
;K BARBLIEN,BARDOSB,BARDOSE,BAREND,BARPASS,BARPATI
;K BARPAT
;K BARPTI1,BARPTNM1,BARSTART,BARTMPB,BARTMPE,BARPPDOS,BARZ
;K AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX
I $G(BARRECPQ)="E" D SELFRBIL^BARFPST3 I $G(BARZ) Q BARZ ; Flat Rate bill select
D SELBILL^BARPUTL ; Ask A/R BILL
I X="^^" S BARSTOP=1 Q 0
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$G(BARSTOP) Q 0
I $G(BARZ) D Q BARZ
. S BARBL=+Y ; IEN to A/R IHS BILL File
. S $P(BARZ,U,4)=BARBL
;
ASKPAT ; EP
W !
S DICB=$S($D(BARPAT):BARPAT,1:"")
D ASKPATB^BARPUTL(DICB) ; If bill not answered, ask patient
I X="^^" S BARSTOP=1 Q 0
I BARSTOP Q 0
I $D(DUOUT) G GB1
I $D(DTOUT) Q 0
I $G(BARZ) Q BARZ
D GETBIL^BARPUTL ; If patient not answered, ask DOS
I X="^^" S BARSTOP=1 Q 0
I BARSTOP Q 0
I $D(DUOUT) G ASKPAT
I $D(DTOUT) Q 0
I $G(BARZ) Q BARZ
Q 0 ; No bills entered
;
RESETDIR ; Clear variables for DIR no longer used
K DIR,DTOUT,DUOUT,DIROUT,DIRUT W !
Q
;
ASKPATB ;EP - select patient
; Same functionality as ASKPAT^BARPUTL but and allows user select a patient
; with A/R Bills and passes default value for DIC("B"))
K DIC,BARZ,BARPAT
S BARNEWPT=0
S DIC("B")=$G(DICB)
S DIC="^AUPNPAT("
S DIC(0)="IAEMQZ"
D ^DIC
K DIC
Q:+Y<0
S BARPAT=+Y
S BARPAT(0)=Y(0)
S BARPAT(0)=$P($G(^DPT(+BARPAT,0)),"^",1)
I '$D(^BARBL(DUZ(2),"ABC",+Y)) D
. K DIR,DTOUT,DUOUT,DIROUT,DIRUT W !
. S DIR(0)="SO^Y:YES Continue this patient without an A/R Bill;N:NO Do not continue this patient, select a different one"
. S DIR("A")="The selected patient does not have an A/R Bill. Continue Y/N: "
. ;S DIR("B")="N"
. K DA
. D ^DIR
. I $D(DIROUT) S BARSTOP=1 Q
. I $D(DTOUT)!$D(DUOUT) Q
. I "Nn"[Y D G ASKPATB
.. K BARPAT,BARPAT(0)
. S BARNEWPT=1
I BARNEWPT=0 D GETDOS^BARPUTL
I BARNEWPT=0,'$G(BAROK) K BARPAT,BARPAT(0) Q
S BARZ=BARPAT_"^"_$G(BARSTART)_"^"_$G(BAREND)
Q
;
INIT ;
D CLEARVAR
S (BARDONE,BARSTOP,BARUPDT,HINBLON,HINPTON)=0
S BARNOTE="**"
S BARNOTE1="** Indicates Bill DOS does not match payment date for service."
S BARNOTE2="Patient in Item 6 must match patient in item 5 when A/R Bill is selected"
Q
;
CLEARVAR ; kill variables
K BARAMT,BARAMTUP,BARASK
K BARBIL,BARBL,BARBLIEN
K BARCK,BARCMT,BARCMTS,BARCNAME,BARCNT,BARCPT,BARCTYPE,BARCTYPN
K BARDAT,BARDEPTE,BARDEPTI,BARDOSB,BARDOSE
K BAREND,BARESIG
K BARFILE,BARFPASS
K BARIENS,BARITEM
K BARLIST,BARLNG,BARNEWPT,BAROK
K BARPAT,BARPATNM,BARPDOS,BARPMTYP,BARPPIEN,BARPTI1,BARPTNM1
K BARQUIT,BARRECPQ,BARSTART,BARSUFX
K BARTAG,BARTAG1,BARTMP,BARTMP1,BARTMPB,BARTMPE,BARTMPF
K BARVAR,BARZERO
K BARZ
K CARD,CARDTYPE
K DIC,DICB,DICB2,DICB3,DIE,DIROUT,DIRUT,DR,DTOUT,DUOUT
K HINBLON,HINPTON
K PAYTYPE,PMTYP
K X,X1,Y
Q
;
CLEAN ; Clean up
D CLEARVAR
;stuff not cleared in CLEARVAR
K BARDONE,BARNOTE,BARNOTE1,BARNOTE2,BARSTOP,BARUPDT,HINBLON,HINPTON
K X,X1,Y
Q
;
BARPPY01 ; IHS/SD/TMM - PREPAYMENT ENTRY MAY 11,2010 ; 05/11/2010
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**19**;OCT 26, 2005
+2 ;
+3 ; IHS/SD/TMM 06/18/10 1.8*19 Add Prepayment functionality.
+4 ; See work order 3PMS10001
+5 ; ------------------------
+6 ; 1. Display prepayments not assigned to a batch (^BARCLU)
+7 ; 2. Remove prompt: AUTO PRINT RECEIPT (^BARCLU01)
+8 ; 3. Prepayment entry ^BARPPY01 (new routine),^BARCLU1,^BARPUTL
+9 ; 4. Display prepayments matching payment type selected (^BARCLU)
+10 ; 5. Allow user to assign prepayment to batch (^BARCLU,^BARCLU01,^BARPUTL,^BARPST1,^BARBLLK)
+11 ; 6. Print Prepayment Receipt (^BARPPY02) (new routine)
+12 ; 7. Allow user to look up registered patient with no bills in system
+13 ; *********************************************************************
+14 ;
+15 ; BARDONE - All data has been collected, ready to review and file/modify
+16 ; BARSTOP - Exit processing
+17 ;
+18 QUIT
+19 ;
EN ;EP - Prepayment Collections
+1 SET BARESIG=""
+2 ;electronic signature test
DO SIG^XUSESIG
+3 ;elec signature test
IF X1=""
QUIT
+4 SET BARESIG=1
+5 FOR I=1:1
DO EN1
IF ($DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT))!$GET(BARSTOP)
QUIT
XIT ;
+1 DO CLEAN
+2 QUIT
+3 ;
EN1 ; Loop
+1 DO GETDATA
+2 IF BARSTOP
QUIT
+3 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+4 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+5 IF 'BARDONE
GOTO EN1
+6 DO RECAP^BARPPY1A
+7 ;user opted to quit, not file receipt ;
IF $GET(BARQUIT)=1
QUIT
+8 IF BARSTOP
QUIT
+9 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+10 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)
QUIT
+11 IF BARFILE="Q"
GOTO EN1
+12 DO FILE^BARPPY1A
+13 ;prompt to print receipt
DO RECEIPT^BARPPY02(BARPPIEN)
+14 QUIT
+15 ;
GETDATA ; Get Pre-payment data
+1 ; Select Department (Clinic Stop)
+2 IF $GET(BARSTOP)
QUIT
+3 DO INIT
+4 DO SELDEPT
+5 IF BARSTOP
QUIT
+6 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+7 IF $GET(BARDEPTI)=""
SET BARSTOP=1
QUIT
SELPMT ; Select Payment Type
+1 DO SELPMT1
+2 IF BARSTOP
QUIT
+3 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+4 IF '$GET(BARUPDT)
IF $DATA(DUOUT)
GOTO GETDATA
+5 IF $GET(BARUPDT)
IF $DATA(DUOUT)
QUIT
+6 IF $DATA(DTOUT)
QUIT
+7 ; Get additional payment data for selected payment type
+8 ;identifies if required data for this payment type was collected 0/1
SET BARDAT=0
+9 SET BARTAG=$PIECE(Y(0)," ",1)
PMTDATA ;
+1 IF BARSTOP
QUIT
+2 ;get additional data for the selected payment type
IF '$GET(BARAMTUP)
DO @BARTAG
+3 IF $GET(BARAMTUP)
Begin DoDot:1
+4 KILL BARAMTUP
+5 SET BARTAG1=$SELECT(BARTAG="CHECK":"CHECKNM","^CREDIT^DEBIT^"[BARTAG:"CARDNM",1:"CASH")
+6 DO @BARTAG1
End DoDot:1
+7 IF BARSTOP
QUIT
+8 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+9 IF '$GET(BARUPDT)
IF $DATA(DUOUT)
GOTO SELPMT
+10 IF $GET(BARUPDT)
IF $DATA(DUOUT)
GOTO SELPMT
+11 IF $DATA(DTOUT)
QUIT
+12 IF '$GET(BARUPDT)
IF 'BARDAT
GOTO SELPMT
+13 ;edit payment data only for updates
IF $GET(BARUPDT)
QUIT
+14 ;
AMOUNT ; Enter Credit amount
+1 KILL BARAMTUP
+2 DO AMOUNT1
+3 IF BARSTOP
QUIT
+4 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+5 IF '$GET(BARUPDT)
IF $DATA(DUOUT)
SET BARAMTUP=1
GOTO PMTDATA
+6 IF $GET(BARUPDT)
IF $DATA(DUOUT)
QUIT
+7 IF $DATA(DTOUT)
QUIT
ARBILL ; Get A/R Bill, Patient, A/R Bill DOS
+1 DO ARBILL1
+2 IF BARSTOP
QUIT
+3 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+4 IF '$GET(BARUPDT)
IF $DATA(DUOUT)
GOTO AMOUNT
+5 IF $GET(BARUPDT)
IF $DATA(DUOUT)
QUIT
+6 IF $DATA(DTOUT)
QUIT
PAYDOS ; Get DOS for this payment
+1 DO PAYDOS1
+2 IF BARSTOP
QUIT
+3 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+4 IF '$GET(BARUPDT)
IF $DATA(DUOUT)
GOTO ARBILL
+5 IF $GET(BARUPDT)
IF $DATA(DUOUT)
QUIT
+6 IF $DATA(DTOUT)
QUIT
+7 ; Select patient if not selected during A/R Bill entry
GETPAT ;
+1 DO GETPAT1
+2 IF BARSTOP
QUIT
+3 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+4 IF '$GET(BARUPDT)
IF $DATA(DUOUT)
GOTO PAYDOS
+5 IF $GET(BARUPDT)
IF $DATA(DUOUT)
QUIT
+6 IF $DATA(DTOUT)
QUIT
+7 ; Enter comments
+8 DO CMTS
+9 IF BARSTOP
QUIT
+10 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+11 IF '$GET(BARUPDT)
IF $DATA(DUOUT)
GOTO PAYDOS
+12 IF $GET(BARUPDT)
IF $DATA(DUOUT)
QUIT
+13 IF $DATA(DTOUT)
QUIT
+14 ; Data entry complete
+15 SET BARDONE=1
+16 QUIT
+17 ;
SELDEPT ;
+1 KILL DIC,DR,DA,X,Y
+2 SET DIC="^DIC(40.7,"
+3 WRITE !
+4 SET DIC(0)="AEZQM"
+5 SET DIC("A")="Enter your Department: "
+6 SET BARTMP=$GET(BARDEPTE)
+7 IF BARTMP'=""
SET DIR("B")=BARTMP
+8 KILL DD,DO
+9 DO ^DIC
+10 IF X="^^"
SET BARSTOP=1
QUIT
+11 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+12 ;I 'Y G SELDEPT
+13 IF Y'>0
SET (BARDEPTI,BARDEPTE)=""
QUIT
+14 ;CLINIC STOP IEN
SET BARDEPTI=$PIECE(Y,U)
+15 ;CLINIC STOP NAME
SET BARDEPTE=$PIECE(Y,U,2)
+16 KILL DIC
+17 QUIT
+18 ; *********************************************************************
SELPMT1 ; Select Payment Type
+1 IF BARSTOP
QUIT
+2 KILL DIR,DTOUT,DUOUT,DIROUT,DIRUT
WRITE !
+3 SET DIR(0)="SA^CA:CASH;CK:CHECK;CC:CREDIT CARD;DB:DEBIT CARD"
+4 SET DIR("A")="PAYMENT TYPE: "
+5 SET BARTMP=$$PAYTYPE^BARPPY1A($GET(BARPMTYP))
+6 IF BARTMP'=""
SET DIR("B")=BARTMP
+7 KILL DA
+8 DO ^DIR
+9 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+10 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+11 SET BARPMTYP=Y
+12 QUIT
+13 ;
CASH ; Collect additional data related to CASH payment
+1 ; Account name/account number not needed for cash payments
+2 IF BARSTOP
QUIT
+3 SET BARDAT=1
+4 ; Reset 'payment type' fields in case payment type was modified from other to 'cash'
+5 IF BARPMTYP="CA"
SET (BARCK,BARCNAME,BARCTYPE,BARCTYPN)=""
+6 QUIT
+7 ;
CHECK ; data related to CHECK payment
+1 IF BARSTOP
QUIT
+2 ; Get check number
+3 KILL DIR,DTOUT,DUOUT,DIROUT,DIRUT
WRITE !
+4 SET DIR(0)="FA"
+5 SET DIR("A")="CHECK NUMBER: "
+6 SET BARTMP=$GET(BARCK)
+7 IF BARTMP'=""
SET DIR("B")=BARTMP
+8 SET DIR("?")="Enter the check number, (i.e. number in the top right corner of the check)"
+9 DO ^DIR
+10 IF X=""
Begin DoDot:1
+11 WRITE !,?5,"Check Number is required",!!
End DoDot:1
GOTO CHECK
+12 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+13 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+14 SET BARCK=X
CHECKNM ;Checking account name
+1 IF BARSTOP
QUIT
+2 ;prompt for name on checking account or name of person making the payment
+3 KILL DIR,DTOUT,DUOUT,DIROUT,DIRUT
WRITE !
+4 SET DIR(0)="FA"
+5 SET DIR("A")="NAME ON CHECKING ACCOUNT: "
+6 SET DIR("?")="Enter the name for this checking account, i.e. JOHN DOE"
+7 DO ^DIR
+8 IF X=""
Begin DoDot:1
+9 WRITE !,?5,"Checking Account Name is required",!!
End DoDot:1
GOTO CHECKNM
+10 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+11 IF '$GET(BARUPDT)
IF $DATA(DUOUT)
GOTO CHECK
+12 IF $GET(BARUPDT)
IF $DATA(DUOUT)
QUIT
+13 IF $DATA(DTOUT)
QUIT
+14 SET BARCNAME=X
+15 ;required data collected
SET BARDAT=1
+16 ; Reset 'payment type' fields in case payment type was modified from other to 'check'
+17 IF BARPMTYP="CK"
SET (BARCTYPE,BARCTYPN)=""
+18 QUIT
+19 ;
DEBIT ;data related to DEBIT CARD payment
CREDIT ;data related to CREDIT CARD payment
+1 IF BARSTOP
QUIT
+2 KILL DIR,DTOUT,DUOUT,DIROUT,DIRUT
WRITE !
+3 SET DIR(0)="SA^A:AMERICAN EXPRESS;C:DINERS CLUB;D:DISCOVER;M:MASTERCARD;V:VISA"
+4 SET DIR("A")="CARD TYPE: "
+5 SET BARTMP=$$CARDTYPE^BARPPY1A($GET(BARCTYPE))
+6 IF BARTMP'=""
SET DIR("B")=BARTMP
+7 SET DIR("?")="Enter type of credit card, i.e. Visa, Mastercard, etc...)"
+8 KILL DA
+9 DO ^DIR
+10 IF X=""
Begin DoDot:1
+11 WRITE !,?5,"Card type is required",!!
End DoDot:1
GOTO CREDIT
+12 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+13 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+14 ;card type code (i.e. "M")
SET BARCTYPE=Y
+15 ;card type name (i.e. "MASTERCARD")
SET BARCTYPN=Y(0)
CARDNM ;prompt for name on credit card
+1 IF BARSTOP
QUIT
+2 KILL DIR,DTOUT,DUOUT,DIROUT,DIRUT
WRITE !
+3 SET DIR(0)="FA"
+4 SET DIR("A")="NAME ON CARD: "
+5 SET DIR("?")="Enter the card holder name shown on the card, i.e. JOHN X DOE"
+6 DO ^DIR
+7 IF X=""
Begin DoDot:1
+8 WRITE !,?5,"Card holder name is required",!!
End DoDot:1
GOTO CARDNM
+9 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+10 IF $DATA(DUOUT)
GOTO CREDIT
+11 IF $DATA(DTOUT)
QUIT
+12 SET BARCNAME=X
+13 ;required data collected
SET BARDAT=1
+14 ; Reset 'payment type' field in case payment type was modified from other to CR/DB
+15 IF "^CC^DB^"[BARPMTYP
SET BARCK=""
+16 QUIT
+17 ;
AMOUNT1 ;prompt for payment
+1 IF BARSTOP
QUIT
+2 SET BARAMT=$GET(BARAMT)
+3 KILL DIR,DTOUT,DUOUT,DIROUT,DIRUT
WRITE !
+4 SET DIR(0)="NA^.01:999999.99:2"
+5 SET DIR("A")="CREDIT: "
+6 KILL DA
+7 DO ^DIR
+8 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+9 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+10 SET BARAMT=X
+11 QUIT
+12 ;
ARBILL1 ; Prompt for A/R bill #, Patient Name, Bill DOS
+1 IF BARSTOP
QUIT
+2 KILL BARFPASS
+3 SET BARNEWPT=0
+4 WRITE !
+5 ; IHS/SD/PKD 1/6/11
+6 KILL BARBL,BARBLIEN,BARDOSB,BARDOSE,BAREND,BARSTART
+7 KILL BARFPASS,BARPASS
+8 ; omit K BARPDOS
KILL BARPAT,BARTMPB,BARTMPE,BARZ
+9 ;No bill selected yet
SET BARBIL=0
SET BARBLIEN=""
+10 ;Ask A/R bills loop
FOR
Begin DoDot:1
+11 IF $GET(BARNEWPT)=1
SET BARFPASS=BARZ
QUIT
+12 KILL BARPAT,BARZ
+13 ; Bill Entry Loop Flag
SET BARBIL=1
+14 ; Get bills by bill, patient, or DOS
SET BARFPASS=$$GETBIL
+15 IF BARSTOP!$DATA(DTOUT)
QUIT
+16 IF (BARFPASS=0)!($PIECE(BARFPASS,U,4)="")
IF +$GET(BARPAT)>0
KILL BARPAT
+17 ; No bill selected
IF BARFPASS=0
SET BARBIL=0
QUIT
+18 ;Registered patient with no A/R Bills
IF $GET(BARNEWPT)=1
QUIT
+19 ; needed for FINDBIL^BARFPST3
SET BARPASS=$PIECE(BARFPASS,U,1,3)
+20 ; If no A/R Bill IEN
+21 IF '+$PIECE(BARFPASS,U,4)
DO FINDBIL^BARFPST3
IF 'BARCNT
QUIT
IF '+BARASK
QUIT
+22 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+23 IF $DATA(DTOUT)
QUIT
+24 ; Update BARFPASS with A/R Bill DOS info from FINDBIL call
+25 IF BARFPASS'=0
Begin DoDot:2
+26 ; A/R BILL IEN
SET BARBLIEN=$PIECE(BARFPASS,U,4)
+27 ;DOS begin
SET BARTMPB=$$GET1^DIQ(90050.01,BARBLIEN_",",102,"I")
+28 ;DOS end
SET BARTMPE=$$GET1^DIQ(90050.01,BARBLIEN_",",103,"I")
+29 SET $PIECE(BARFPASS,U,2)=BARTMPB
+30 SET $PIECE(BARFPASS,U,3)=BARTMPE
+31 ; try this IHS/SD/PKD 1/6/11
+32 ;DOS defaults to BILL DOS
SET (BARPDOS,BARDOSB)=BARTMPB
+33 SET BARBIL=0
End DoDot:2
End DoDot:1
IF ('+BARBIL)!(BARSTOP)!$DATA(DUOUT)!$DATA(DTOUT)!$GET(BARNEWPT)=1
QUIT
+34 ; DOS begin
SET BARDOSB=$PIECE(BARFPASS,U,2)
+35 ; DOS end
SET BARDOSE=$PIECE(BARFPASS,U,3)
+36 ; A/R BILL IEN
SET BARBLIEN=$PIECE(BARFPASS,U,4)
+37 ; Patient IEN override any previous if bill change
IF BARBLIEN'=""
SET (BARPAT,BARPTI1)=+($PIECE(BARFPASS,U,1))
+38 ;if Bill Entered, keep Patient in sync IHS/SD/PKD 1/6/11
IF +$GET(BARPAT)=0
SET (BARPAT,BARPTI1,BARPTNM1)=""
+39 ;Patient (BARPAT) selected in ARBILL1
IF +$GET(BARPAT)>0
Begin DoDot:1
+40 ; Set patient IEN and NAME to what was selected when selecting A/R Bill data
+41 SET BARPTI1=BARPAT
+42 ; Patient Name
SET BARPTNM1=$$GET1^DIQ(9000001,BARPTI1,.01)
End DoDot:1
QUIT
+43 QUIT
+44 ;
PAYDOS1 ; Enter DOS for the Payment
+1 IF BARSTOP
QUIT
+2 KILL DIR,DTOUT,DUOUT,DIROUT,DIRUT
WRITE !
+3 ; If BILL DOS captured set that as the default for this entry
+4 SET DIR(0)="DA^::E"
+5 SET DIR("A")="PAYMENT FOR DOS: "
+6 IF $GET(BARPDOS)=""
SET BARPDOS=$GET(BARDOSB)
+7 SET Y=BARPDOS
+8 ;converts internal FM date to external, returns external dt Y
DO D^DIQ
+9 SET BARTMP=Y
+10 IF BARTMP'=""
SET DIR("B")=BARTMP
+11 DO ^DIR
+12 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+13 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+14 IF Y=""
GOTO PAYDOS1
+15 SET BARPDOS=Y
+16 QUIT
+17 ;
GETPAT1 ; Select Patient if not selected in ARBILL1
+1 IF BARSTOP
QUIT
+2 WRITE !
+3 ;Patient (BARPAT) selected in ARBILL1
IF 'BARUPDT
IF +$GET(BARPAT)>0
Begin DoDot:1
+4 ; Set patient IEN and NAME to what was selected when selecting A/R Bill data
+5 SET BARPTI1=BARPAT
+6 ; Patient Name
SET BARPTNM1=$$GET1^DIQ(9000001,BARPTI1,.01)
End DoDot:1
QUIT
+7 KILL DIC,BARZ
+8 SET BARTMP=$SELECT($DATA(BARPTI1):BARPTI1,+$GET(BARPAT)>0:BARPAT,1:"")
+9 IF BARTMP
SET DIC("B")=$$GET1^DIQ(9000001,BARTMP,.01)
+10 SET DIC="^AUPNPAT("
+11 SET DIC(0)="IAEMZ"
+12 SET DIC("A")="Select Patient: "
+13 DO ^DIC
+14 KILL DIC
+15 SET BARPTI1=X
+16 IF X=""
Begin DoDot:1
+17 WRITE !,?5,"Patient Name is required",!!
End DoDot:1
GOTO GETPAT1
+18 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+19 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+20 IF +Y<0
QUIT
+21 ;patient IEN (select patient prompt)
SET BARPTI1=+Y
+22 ;patient name (select patient prompt)
SET BARPAT1(0)=Y(0)
+23 ;patient name (select patient prompt)
SET BARPTNM1=$PIECE($GET(^DPT(+BARPTI1,0)),"^",1)
+24 IF '$DATA(^BARBL(DUZ(2),"ABC",+Y))
Begin DoDot:1
+25 KILL DIR,DTOUT,DUOUT,DIROUT,DIRUT
WRITE !
+26 SET DIR(0)="SO^Y:YES Continue;N:NO Select a different patient"
+27 SET DIR("A")="This is a registered patient with no bills. Continue Y/N: "
+28 ;S DIR("B")="N"
+29 KILL DA
+30 DO ^DIR
+31 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+32 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+33 IF "Nn"[Y
Begin DoDot:2
+34 KILL BARPTI1,BARPAT1(0),BARPTNM1
End DoDot:2
GOTO GETPAT1
+35 ;Registered patient only, no bills (2nd Select Patient Prompt)
SET BARNEWPT=2
End DoDot:1
+36 QUIT
+37 ;
CMTS ; Enter Pre-payment Comments
+1 KILL DIR,DTOUT,DUOUT,DIROUT,DIRUT
WRITE !
+2 SET BARCMTS=$GET(BARCMTS)
+3 SET DIR(0)="FAOU^:255"
+4 SET DIR("A")="COMMENTS: "
+5 DO ^DIR
+6 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+7 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+8 SET BARCMTS=X
+9 QUIT
+10 ;***********
+11 ; COPIED FROM GETBIL^BARFPST3
+12 ; modified to allow user to "^" back to prior prompt or "^^" to
+13 ; exit completely
+14 ;
GETBIL() ; EP
GB1 ; Return point when user enters "^" in ASKPAT tag
+1 ; EP - Flat Rate Posting - Bill Entry
+2 ; If Editing, ask Flat Rate Posting Bill
+3 ; Kill identifying Vars if chg'g BILL
+4 ; IHS/SD/PKD 1/5/11
+5 ;K BARBLIEN,BARPDOS,BARDOSB,BARDOSE,BAREND,BARPASS,BARPATI
+6 ;K BARBLIEN,BARDOSB,BARDOSE,BAREND,BARPASS,BARPATI
+7 ;K BARPAT
+8 ;K BARPTI1,BARPTNM1,BARSTART,BARTMPB,BARTMPE,BARPPDOS,BARZ
+9 ;K AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX
+10 ; Flat Rate bill select
IF $GET(BARRECPQ)="E"
DO SELFRBIL^BARFPST3
IF $GET(BARZ)
QUIT BARZ
+11 ; Ask A/R BILL
DO SELBILL^BARPUTL
+12 IF X="^^"
SET BARSTOP=1
QUIT 0
+13 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!$GET(BARSTOP)
QUIT 0
+14 IF $GET(BARZ)
Begin DoDot:1
+15 ; IEN to A/R IHS BILL File
SET BARBL=+Y
+16 SET $PIECE(BARZ,U,4)=BARBL
End DoDot:1
QUIT BARZ
+17 ;
ASKPAT ; EP
+1 WRITE !
+2 SET DICB=$SELECT($DATA(BARPAT):BARPAT,1:"")
+3 ; If bill not answered, ask patient
DO ASKPATB^BARPUTL(DICB)
+4 IF X="^^"
SET BARSTOP=1
QUIT 0
+5 IF BARSTOP
QUIT 0
+6 IF $DATA(DUOUT)
GOTO GB1
+7 IF $DATA(DTOUT)
QUIT 0
+8 IF $GET(BARZ)
QUIT BARZ
+9 ; If patient not answered, ask DOS
DO GETBIL^BARPUTL
+10 IF X="^^"
SET BARSTOP=1
QUIT 0
+11 IF BARSTOP
QUIT 0
+12 IF $DATA(DUOUT)
GOTO ASKPAT
+13 IF $DATA(DTOUT)
QUIT 0
+14 IF $GET(BARZ)
QUIT BARZ
+15 ; No bills entered
QUIT 0
+16 ;
RESETDIR ; Clear variables for DIR no longer used
+1 KILL DIR,DTOUT,DUOUT,DIROUT,DIRUT
WRITE !
+2 QUIT
+3 ;
ASKPATB ;EP - select patient
+1 ; Same functionality as ASKPAT^BARPUTL but and allows user select a patient
+2 ; with A/R Bills and passes default value for DIC("B"))
+3 KILL DIC,BARZ,BARPAT
+4 SET BARNEWPT=0
+5 SET DIC("B")=$GET(DICB)
+6 SET DIC="^AUPNPAT("
+7 SET DIC(0)="IAEMQZ"
+8 DO ^DIC
+9 KILL DIC
+10 IF +Y<0
QUIT
+11 SET BARPAT=+Y
+12 SET BARPAT(0)=Y(0)
+13 SET BARPAT(0)=$PIECE($GET(^DPT(+BARPAT,0)),"^",1)
+14 IF '$DATA(^BARBL(DUZ(2),"ABC",+Y))
Begin DoDot:1
+15 KILL DIR,DTOUT,DUOUT,DIROUT,DIRUT
WRITE !
+16 SET DIR(0)="SO^Y:YES Continue this patient without an A/R Bill;N:NO Do not continue this patient, select a different one"
+17 SET DIR("A")="The selected patient does not have an A/R Bill. Continue Y/N: "
+18 ;S DIR("B")="N"
+19 KILL DA
+20 DO ^DIR
+21 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+22 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+23 IF "Nn"[Y
Begin DoDot:2
+24 KILL BARPAT,BARPAT(0)
End DoDot:2
GOTO ASKPATB
+25 SET BARNEWPT=1
End DoDot:1
+26 IF BARNEWPT=0
DO GETDOS^BARPUTL
+27 IF BARNEWPT=0
IF '$GET(BAROK)
KILL BARPAT,BARPAT(0)
QUIT
+28 SET BARZ=BARPAT_"^"_$GET(BARSTART)_"^"_$GET(BAREND)
+29 QUIT
+30 ;
INIT ;
+1 DO CLEARVAR
+2 SET (BARDONE,BARSTOP,BARUPDT,HINBLON,HINPTON)=0
+3 SET BARNOTE="**"
+4 SET BARNOTE1="** Indicates Bill DOS does not match payment date for service."
+5 SET BARNOTE2="Patient in Item 6 must match patient in item 5 when A/R Bill is selected"
+6 QUIT
+7 ;
CLEARVAR ; kill variables
+1 KILL BARAMT,BARAMTUP,BARASK
+2 KILL BARBIL,BARBL,BARBLIEN
+3 KILL BARCK,BARCMT,BARCMTS,BARCNAME,BARCNT,BARCPT,BARCTYPE,BARCTYPN
+4 KILL BARDAT,BARDEPTE,BARDEPTI,BARDOSB,BARDOSE
+5 KILL BAREND,BARESIG
+6 KILL BARFILE,BARFPASS
+7 KILL BARIENS,BARITEM
+8 KILL BARLIST,BARLNG,BARNEWPT,BAROK
+9 KILL BARPAT,BARPATNM,BARPDOS,BARPMTYP,BARPPIEN,BARPTI1,BARPTNM1
+10 KILL BARQUIT,BARRECPQ,BARSTART,BARSUFX
+11 KILL BARTAG,BARTAG1,BARTMP,BARTMP1,BARTMPB,BARTMPE,BARTMPF
+12 KILL BARVAR,BARZERO
+13 KILL BARZ
+14 KILL CARD,CARDTYPE
+15 KILL DIC,DICB,DICB2,DICB3,DIE,DIROUT,DIRUT,DR,DTOUT,DUOUT
+16 KILL HINBLON,HINPTON
+17 KILL PAYTYPE,PMTYP
+18 KILL X,X1,Y
+19 QUIT
+20 ;
CLEAN ; Clean up
+1 DO CLEARVAR
+2 ;stuff not cleared in CLEARVAR
+3 KILL BARDONE,BARNOTE,BARNOTE1,BARNOTE2,BARSTOP,BARUPDT,HINBLON,HINPTON
+4 KILL X,X1,Y
+5 QUIT
+6 ;
