BARPPY02 ; IHS/SD/TMM - PREPAYMENT RECEIPTS 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.
; *********************************************************************
Q
;
RECEIPT(BARRIEN) ; Print Receipt Y/N?
R1 ; Print Receipt. Prompt for number of copies and device.
D RESETDIR^BARPPY01
S DIR("A")="Print Receipt? YES/NO "
;S DIR("B")="YES"
S DIR(0)="YA"
D ^DIR
I Y=0 Q
I $D(DIROUT) S BARSTOP=1 Q
I $D(DTOUT)!$D(DUOUT) Q
;
Q:BARSTOP
W !!
D PRINT(BARPPIEN)
D PRTDATE ;update the print date
D CLEAN
Q
;
RCPT(BARPPIEN) ; Receipt data to print
K BARHDR
K BARLINE
;
;Receipt Header
I '$D(BARPSAT(DUZ(2),.01)) D BARPSAT^BARUTL0
D BARPPAY^BARCLU1(BARPPIEN) ;builds BARPPAY array
S BARFAC=$G(BARPSAT(DUZ(2),.01)) ;Facility Name (BARFAC)
S BARHDR2="RECEIPT OF PAYMENT"
S BARHDR3=$G(BARPPAY(.11)) ;Department
D NOW^%DTC
S BARCPTDT=$P(%,".") ;Receipt print date (current date)
S BARCPTDT=$$MDY(BARCPTDT)
;
;Receipt Detail
S BARPAT=$G(BARPPAY(.08)) ;Patient Name
S BARPATI=$G(BARPPAY(.08,"I")) ;Patient IEN
;
S BARIENS=DUZ(2)_","_BARPATI_","
S BARHRN=$$GET1^DIQ(9000001.41,BARIENS,.02) ; Patient Chart number (HRN)
;
S BARCPT=$G(BARPPAY(.01)) ;Receipt #
S BARPMTDI=$G(BARPPAY(.02,"I")) ;Premayment date (FM format)
S BARPMTDT=$$MDY(BARPMTDI)
;
S BARPMTY1=$G(BARPPAY(.03)) ;Payment Type ;PAYMENT TYPE line 1
S BARPMTYP=$G(BARPPAY(.03,"I")) ;Payment Type (internal)
S BARCK=$G(BARPPAY(.04)) ;Check #
S BARCARD=$G(BARPPAY(.06)) ;Credit Card Type
S BARPPAMT=$G(BARPPAY(.07)) ;Credit - Amount paid
;
S BARPMTDI=$G(BARPPAY(.13,"I")) ;Payment for DOS, DOS the payment is intended for
S BARPPDOS=$$MDY(BARPMTDI)
;
S BARPMTY2=$S(BARPMTYP="CK":BARCK,1:BARCARD) ;Payment TYPE line 2 (check # or Card Type)
S BARTMP=""
S I="" F S I=$O(BARPPAY(101,I)) Q:I="" D
. S BARTMP=$G(BARTMP)_$G(BARPPAY(101,I))
K BARCMT M BARCMT=BARPPAY(.2)
Q
;
PRTRECPT ; Receipt output
F I=1:1:19 W ! ;start receipt on line 20
W !,?(80-$L(BARFAC)/2),BARFAC ;receipt line 1
W !,?(80-$L(BARHDR2)/2),BARHDR2 ;receipt line 2
W !,?(80-$L(BARHDR3)/2),BARHDR3 ;receipt line 3
S BARTMP="RECEIPT DATE: "_BARCPTDT
W !,?(80-$L(BARTMP)/2),BARTMP ;receipt line 4
I $G(BARREPRT)=1 W " *REPRINT*"
W ! ;receipt line 5
W !,"PATIENT: ",BARPAT,?39,"HRN: ",BARHRN ;receipt line 6
W ! ;receipt line 7
W !,"RECEIPT NO: ",BARCPT,?39,"PAYMENT RECEIVE DATE: "_BARPMTDT ;receipt line 8
W !,"PAYMENT TYPE: ",BARPMTY1 ;receipt line 9
S BARTMP=$S(BARPMTYP="CK":"CHECK NUMBER : ",BARPMTYP="CA":"",1:"CARD TYPE: ")
W !,BARTMP_BARPMTY2,?39,"AMOUNT: $ ",$FN(BARPPAMT,",",2) ;receipt line 10
W !,"PAYMENT FOR DOS: ",BARPPDOS ;receipt line 11
W ! ;receipt line 12
N CT F CT=1:1:4 I $D(BARCMT(CT)) W !,BARCMT(CT) ;receipt line 13
W ! ;receipt line 14
Q
;
REPRINT ; Re-print receipt
;-------------------------------------------
;Ask for receipt #
I '$D(BARUSR) D INIT^BARUTL
K DIC
S DIC("B")="Enter Receipt Number, Patient, DOS, Receipt Date: "
S DIC="^BARPPAY(DUZ(2),"
S DIC(0)="AEZQM"
D ^DIC
Q:Y'>0
S BARPPIEN=+Y
;-------------------------------------------
;Redisplay the receipt data
K BARPPAY
D BARPPAY^BARCLU1(BARPPIEN) ;setup Prepayment array (BARPPAY)
S BARSTOP=0
D RECAPDAT ;get RECAP data
D RECAPDSP ;display RECAP data
;-------------------------------------------
;Print the recap
D CLEAN1 ;clear all but BARPPIEN and BARPPAY array
S BARREPRT=1 ;reprint flag
D RECEIPT(BARPPIEN) ;print the receipt
K BARREPRT
Q
;
RECAPDAT ; Get recap receipt data (reprints)
D CLEAN1
S BARECPT=BARPPAY(.01) ;Receipt #
S BARPMTDI=BARPPAY(.13) ;Payment for DOS, DOS the payment is intended for
S BARPPAMT=BARPPAY(.07) ;Credit - Amount paid
S BARHDR3=$G(BARPPAY(.11)) ;Department
S BARPMTYP=BARPPAY(.03,"I") ;Payment Type (internal code)
S BARCK=BARPPAY(.04) ;check number
S BARCTYPN=BARPPAY(.06) ;Credit Card Type
S BARCNAME=BARPPAY(.05) ;account owner name (re: credit card or checking acct)
S BARBL=BARPPAY(.09) ;A/R Bill
S BARBLIEN=BARPPAY(.09,"I") ;A/R Bill IEN
S BARBL=BARPPAY(.09) ;A/R Bill (ext)
S BARPAT=$$GET1^DIQ(90050.01,BARBLIEN_",",101) ;Patient Name from A/R Bill
S BARDOSB=BARPPAY(.12) ;A/R BILL Begin DOS
S BARPTNM1=BARPPAY(.08) ;patient name (from select patient prompt, not from A/R Bill)
K BARCMT M BARCMT=BARPPAY(.2) ; Get full comment
;S BARCMT=$G(BARPPAY(.2,1)) ;prepayment comments
Q
;
RECAPDSP ; Display re-print data for user to review before select print
Q:BARSTOP
W $$EN^BARVDF("IOF"),! ;Form Feed/Clear screen
W $$EN^BARVDF("CLR") ;Clear screen
W !,"Receipt Number: ",BARECPT,!!
W !,"1)",?4,"PAYMENT FOR DOS:",?22,BARPMTDI
W !!,"2)",?4,"CREDIT:",?22,"$ ",$FN(BARPPAMT,",",2)
W !!,"3)",?4,"DEPARTMENT:",?22,BARHDR3
I BARPMTYP="CA" S BARTMP="CASH^^"
I BARPMTYP="CK" S BARTMP="CHECK^CHECK NUMBER:^NAME ON CK ACCOUNT:"
I BARPMTYP="CC" S BARTMP="CREDIT CARD^CARD TYPE:^NAME ON CARD:"
I BARPMTYP="DB" S BARTMP="DEBIT CARD^CARD TYPE:^NAME ON CARD:"
W !!,"4)",?4,"PAYMENT TYPE:",?22,$P(BARTMP,U) ;PAYMENT TYPE line 1
S BARTMP1=$S(BARPMTYP="CK":BARCK,BARPMTYP="CC":BARCTYPN,BARPMTYP="DB":BARCTYPN,1:"")
I $P(BARTMP,U)'="CASH" D
. W !,?4,$P(BARTMP,U,2),?22,BARTMP1 ;PAYMENT TYPE line 2
. S BARTMP1=$S("^CK^CC^DB^"[BARPMTYP:BARCNAME,1:"")
. W !,?4,$P(BARTMP,U,3),?22,BARCNAME ;PAYMENT TYPE line 3
W !!,"5)",?4,"A/R BILL NUMBER:",?22,BARPPAY(.09)
W !,?4,"PATIENT NAME:",?22,BARPAT
W !,?4,"BILL DOS:",?22,BARDOSB
W !!,"6)",?4,"PATIENT:",?22,BARPTNM1
; display / print full comment
W !!,"7)",?4,"COMMENTS:"
N CT F CT=1:1:4 I $D(BARCMT(CT)) D
. S BARCMT(5)=BARCMT(CT)
. I CT=1 W " " ; 2 SPACES AFTER COLON
. ; And then let it wrap around
. E I $E(BARCMT(5),$L(BARCMT(5)))'=" "&($E(BARCMT(CT))'=" ") W " "
. W BARCMT(CT) ;receipt line 13
W ! ;receipt line 14
Q
;
PRINT(BARPPIEN) ; Test print logic
; Print report to device. Queuing allowed.
; prompt user for number of copies to print
S BARCOPY=0
S BARCOPY=$$ASKCOPY^BARDBQ01()
I $D(DUOUT)!$D(DUOUT)=1 Q
I $D(DIROUT) S BARSTOP=1 Q
I BARCOPY>0 S BAR("MULTI")=BARCOPY
S XBNS="BAR"
S XBRC="RCPT^BARPPY02(BARPPIEN)" ; Build tmp global with data
S XBRP="PRTRECPT^BARPPY02" ; Print reports from tmp global
;S XBRX="CLEAN0^BARPPY02" ; Clean-up routine
S XBRX="" ; Clean-up routine
S BAR("NOQUE")=1 ;don't allow queing receipts
D ^BARDBQ02
Q
;
CLEAN ; Clean up after print/re-print receipt
;If update this list, consider updating CLEAN1 tag as well
K BARFMDT,BARFMMM,BARFMDD,BARFMYY
K BARPPAMT,BARCNTPP,BARECPT,BARNOPP,BARPAYDT,BARPAYTY,BARPMTDD,BARPMTDI,BARPMTDT
K BARPMTMM,BARPMTYP,BARPMTYY,BARPP,BARPPAY,BARPPCMT,BARPPDTM,BARPPIEN,BARPTNM
K BARQ,BARREPRT,BARSELPP
Q
;
CLEAN1 ; Clear variables before print receipt
;clear all but BARPPIEN, BARPPAY, and BARREPRT
K BARFMDT,BARFMMM,BARFMDD,BARFMYY
K BARPPAMT,BARCNTPP,BARECPT,BARNOPP,BARPAYDT,BARPAYTY,BARPMTDD,BARPMTDI,BARPMTDT
K BARPMTMM,BARPMTYP,BARPMTYY,BARPP,BARPPCMT,BARPPDTM,BARPTNM
K BARQ,BARSELPP
Q
;
CLEAN0 ; Fake cleanup for multi copy printing. Routine needed for ^BARDBQ01.
;Routine calling BARDBQ1 must do cleanup.
Q
;
PRTDATE ;Update Receipt Print date in A/R Prepayment file
;Update Receipt Print Date
K DIE,DR,DA
; IHS/SD/PKD First Printed Date - Not Last Reprint Date
S BARPRTDT=$P($G(^BARPPAY(DUZ(2),BARPPIEN,0)),U,19)
I BARPRTDT="" D
. D NOW^%DTC
. S BARPRTDT=$P(%,".")
S DR=".19////^S X=BARPRTDT" ;RECEIPT PRINT DATE
; Update Pre-Payment file
S DA=BARPPIEN
S DIE=$$DIC^XBDIQ1(90050.06)
D ^DIE
;
PRTDT ;
;Update Receipt Print Date (multiple)
K DIC,DR,DA,DD,DO
S DA(1)=BARPPIEN
S DIC=$$DIC^XBDIQ1(90050.06201)
S DIC(0)="L"
S DIC("P")=$P(^DD(90050.06,201,0),U,2)
D NOW^%DTC
S PRTDAT=%
;S X=$P(%,".")
S X=%_U_DUZ ; Date.Time ^ Cashier
D FILE^DICN
Q
;
MDY(BARFMDT) ; format Date from FM to MM/DD/YYYY
S BARFMMM=$E(BARFMDT,4,5)
S BARFMDD=$E(BARFMDT,6,7)
S BARFMYY=$E(BARFMDT,1,3)+1700
S BARFMDT=BARFMMM_"/"_BARFMDD_"/"_BARFMYY ;DOS for Prepayment
Q BARFMDT
;
BARPPY02 ; IHS/SD/TMM - PREPAYMENT RECEIPTS 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 ; *********************************************************************
+5 QUIT
+6 ;
RECEIPT(BARRIEN) ; Print Receipt Y/N?
R1 ; Print Receipt. Prompt for number of copies and device.
+1 DO RESETDIR^BARPPY01
+2 SET DIR("A")="Print Receipt? YES/NO "
+3 ;S DIR("B")="YES"
+4 SET DIR(0)="YA"
+5 DO ^DIR
+6 IF Y=0
QUIT
+7 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+8 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+9 ;
+10 IF BARSTOP
QUIT
+11 WRITE !!
+12 DO PRINT(BARPPIEN)
+13 ;update the print date
DO PRTDATE
+14 DO CLEAN
+15 QUIT
+16 ;
RCPT(BARPPIEN) ; Receipt data to print
+1 KILL BARHDR
+2 KILL BARLINE
+3 ;
+4 ;Receipt Header
+5 IF '$DATA(BARPSAT(DUZ(2),.01))
DO BARPSAT^BARUTL0
+6 ;builds BARPPAY array
DO BARPPAY^BARCLU1(BARPPIEN)
+7 ;Facility Name (BARFAC)
SET BARFAC=$GET(BARPSAT(DUZ(2),.01))
+8 SET BARHDR2="RECEIPT OF PAYMENT"
+9 ;Department
SET BARHDR3=$GET(BARPPAY(.11))
+10 DO NOW^%DTC
+11 ;Receipt print date (current date)
SET BARCPTDT=$PIECE(%,".")
+12 SET BARCPTDT=$$MDY(BARCPTDT)
+13 ;
+14 ;Receipt Detail
+15 ;Patient Name
SET BARPAT=$GET(BARPPAY(.08))
+16 ;Patient IEN
SET BARPATI=$GET(BARPPAY(.08,"I"))
+17 ;
+18 SET BARIENS=DUZ(2)_","_BARPATI_","
+19 ; Patient Chart number (HRN)
SET BARHRN=$$GET1^DIQ(9000001.41,BARIENS,.02)
+20 ;
+21 ;Receipt #
SET BARCPT=$GET(BARPPAY(.01))
+22 ;Premayment date (FM format)
SET BARPMTDI=$GET(BARPPAY(.02,"I"))
+23 SET BARPMTDT=$$MDY(BARPMTDI)
+24 ;
+25 ;Payment Type ;PAYMENT TYPE line 1
SET BARPMTY1=$GET(BARPPAY(.03))
+26 ;Payment Type (internal)
SET BARPMTYP=$GET(BARPPAY(.03,"I"))
+27 ;Check #
SET BARCK=$GET(BARPPAY(.04))
+28 ;Credit Card Type
SET BARCARD=$GET(BARPPAY(.06))
+29 ;Credit - Amount paid
SET BARPPAMT=$GET(BARPPAY(.07))
+30 ;
+31 ;Payment for DOS, DOS the payment is intended for
SET BARPMTDI=$GET(BARPPAY(.13,"I"))
+32 SET BARPPDOS=$$MDY(BARPMTDI)
+33 ;
+34 ;Payment TYPE line 2 (check # or Card Type)
SET BARPMTY2=$SELECT(BARPMTYP="CK":BARCK,1:BARCARD)
+35 SET BARTMP=""
+36 SET I=""
FOR
SET I=$ORDER(BARPPAY(101,I))
IF I=""
QUIT
Begin DoDot:1
+37 SET BARTMP=$GET(BARTMP)_$GET(BARPPAY(101,I))
End DoDot:1
+38 KILL BARCMT
MERGE BARCMT=BARPPAY(.2)
+39 QUIT
+40 ;
PRTRECPT ; Receipt output
+1 ;start receipt on line 20
FOR I=1:1:19
WRITE !
+2 ;receipt line 1
WRITE !,?(80-$LENGTH(BARFAC)/2),BARFAC
+3 ;receipt line 2
WRITE !,?(80-$LENGTH(BARHDR2)/2),BARHDR2
+4 ;receipt line 3
WRITE !,?(80-$LENGTH(BARHDR3)/2),BARHDR3
+5 SET BARTMP="RECEIPT DATE: "_BARCPTDT
+6 ;receipt line 4
WRITE !,?(80-$LENGTH(BARTMP)/2),BARTMP
+7 IF $GET(BARREPRT)=1
WRITE " *REPRINT*"
+8 ;receipt line 5
WRITE !
+9 ;receipt line 6
WRITE !,"PATIENT: ",BARPAT,?39,"HRN: ",BARHRN
+10 ;receipt line 7
WRITE !
+11 ;receipt line 8
WRITE !,"RECEIPT NO: ",BARCPT,?39,"PAYMENT RECEIVE DATE: "_BARPMTDT
+12 ;receipt line 9
WRITE !,"PAYMENT TYPE: ",BARPMTY1
+13 SET BARTMP=$SELECT(BARPMTYP="CK":"CHECK NUMBER : ",BARPMTYP="CA":"",1:"CARD TYPE: ")
+14 ;receipt line 10
WRITE !,BARTMP_BARPMTY2,?39,"AMOUNT: $ ",$FNUMBER(BARPPAMT,",",2)
+15 ;receipt line 11
WRITE !,"PAYMENT FOR DOS: ",BARPPDOS
+16 ;receipt line 12
WRITE !
+17 ;receipt line 13
NEW CT
FOR CT=1:1:4
IF $DATA(BARCMT(CT))
WRITE !,BARCMT(CT)
+18 ;receipt line 14
WRITE !
+19 QUIT
+20 ;
REPRINT ; Re-print receipt
+1 ;-------------------------------------------
+2 ;Ask for receipt #
+3 IF '$DATA(BARUSR)
DO INIT^BARUTL
+4 KILL DIC
+5 SET DIC("B")="Enter Receipt Number, Patient, DOS, Receipt Date: "
+6 SET DIC="^BARPPAY(DUZ(2),"
+7 SET DIC(0)="AEZQM"
+8 DO ^DIC
+9 IF Y'>0
QUIT
+10 SET BARPPIEN=+Y
+11 ;-------------------------------------------
+12 ;Redisplay the receipt data
+13 KILL BARPPAY
+14 ;setup Prepayment array (BARPPAY)
DO BARPPAY^BARCLU1(BARPPIEN)
+15 SET BARSTOP=0
+16 ;get RECAP data
DO RECAPDAT
+17 ;display RECAP data
DO RECAPDSP
+18 ;-------------------------------------------
+19 ;Print the recap
+20 ;clear all but BARPPIEN and BARPPAY array
DO CLEAN1
+21 ;reprint flag
SET BARREPRT=1
+22 ;print the receipt
DO RECEIPT(BARPPIEN)
+23 KILL BARREPRT
+24 QUIT
+25 ;
RECAPDAT ; Get recap receipt data (reprints)
+1 DO CLEAN1
+2 ;Receipt #
SET BARECPT=BARPPAY(.01)
+3 ;Payment for DOS, DOS the payment is intended for
SET BARPMTDI=BARPPAY(.13)
+4 ;Credit - Amount paid
SET BARPPAMT=BARPPAY(.07)
+5 ;Department
SET BARHDR3=$GET(BARPPAY(.11))
+6 ;Payment Type (internal code)
SET BARPMTYP=BARPPAY(.03,"I")
+7 ;check number
SET BARCK=BARPPAY(.04)
+8 ;Credit Card Type
SET BARCTYPN=BARPPAY(.06)
+9 ;account owner name (re: credit card or checking acct)
SET BARCNAME=BARPPAY(.05)
+10 ;A/R Bill
SET BARBL=BARPPAY(.09)
+11 ;A/R Bill IEN
SET BARBLIEN=BARPPAY(.09,"I")
+12 ;A/R Bill (ext)
SET BARBL=BARPPAY(.09)
+13 ;Patient Name from A/R Bill
SET BARPAT=$$GET1^DIQ(90050.01,BARBLIEN_",",101)
+14 ;A/R BILL Begin DOS
SET BARDOSB=BARPPAY(.12)
+15 ;patient name (from select patient prompt, not from A/R Bill)
SET BARPTNM1=BARPPAY(.08)
+16 ; Get full comment
KILL BARCMT
MERGE BARCMT=BARPPAY(.2)
+17 ;S BARCMT=$G(BARPPAY(.2,1)) ;prepayment comments
+18 QUIT
+19 ;
RECAPDSP ; Display re-print data for user to review before select print
+1 IF BARSTOP
QUIT
+2 ;Form Feed/Clear screen
WRITE $$EN^BARVDF("IOF"),!
+3 ;Clear screen
WRITE $$EN^BARVDF("CLR")
+4 WRITE !,"Receipt Number: ",BARECPT,!!
+5 WRITE !,"1)",?4,"PAYMENT FOR DOS:",?22,BARPMTDI
+6 WRITE !!,"2)",?4,"CREDIT:",?22,"$ ",$FNUMBER(BARPPAMT,",",2)
+7 WRITE !!,"3)",?4,"DEPARTMENT:",?22,BARHDR3
+8 IF BARPMTYP="CA"
SET BARTMP="CASH^^"
+9 IF BARPMTYP="CK"
SET BARTMP="CHECK^CHECK NUMBER:^NAME ON CK ACCOUNT:"
+10 IF BARPMTYP="CC"
SET BARTMP="CREDIT CARD^CARD TYPE:^NAME ON CARD:"
+11 IF BARPMTYP="DB"
SET BARTMP="DEBIT CARD^CARD TYPE:^NAME ON CARD:"
+12 ;PAYMENT TYPE line 1
WRITE !!,"4)",?4,"PAYMENT TYPE:",?22,$PIECE(BARTMP,U)
+13 SET BARTMP1=$SELECT(BARPMTYP="CK":BARCK,BARPMTYP="CC":BARCTYPN,BARPMTYP="DB":BARCTYPN,1:"")
+14 IF $PIECE(BARTMP,U)'="CASH"
Begin DoDot:1
+15 ;PAYMENT TYPE line 2
WRITE !,?4,$PIECE(BARTMP,U,2),?22,BARTMP1
+16 SET BARTMP1=$SELECT("^CK^CC^DB^"[BARPMTYP:BARCNAME,1:"")
+17 ;PAYMENT TYPE line 3
WRITE !,?4,$PIECE(BARTMP,U,3),?22,BARCNAME
End DoDot:1
+18 WRITE !!,"5)",?4,"A/R BILL NUMBER:",?22,BARPPAY(.09)
+19 WRITE !,?4,"PATIENT NAME:",?22,BARPAT
+20 WRITE !,?4,"BILL DOS:",?22,BARDOSB
+21 WRITE !!,"6)",?4,"PATIENT:",?22,BARPTNM1
+22 ; display / print full comment
+23 WRITE !!,"7)",?4,"COMMENTS:"
+24 NEW CT
FOR CT=1:1:4
IF $DATA(BARCMT(CT))
Begin DoDot:1
+25 SET BARCMT(5)=BARCMT(CT)
+26 ; 2 SPACES AFTER COLON
IF CT=1
WRITE " "
+27 ; And then let it wrap around
+28 IF '$TEST
IF $EXTRACT(BARCMT(5),$LENGTH(BARCMT(5)))'=" "&($EXTRACT(BARCMT(CT))'=" ")
WRITE " "
+29 ;receipt line 13
WRITE BARCMT(CT)
End DoDot:1
+30 ;receipt line 14
WRITE !
+31 QUIT
+32 ;
PRINT(BARPPIEN) ; Test print logic
+1 ; Print report to device. Queuing allowed.
+2 ; prompt user for number of copies to print
+3 SET BARCOPY=0
+4 SET BARCOPY=$$ASKCOPY^BARDBQ01()
+5 IF $DATA(DUOUT)!$DATA(DUOUT)=1
QUIT
+6 IF $DATA(DIROUT)
SET BARSTOP=1
QUIT
+7 IF BARCOPY>0
SET BAR("MULTI")=BARCOPY
+8 SET XBNS="BAR"
+9 ; Build tmp global with data
SET XBRC="RCPT^BARPPY02(BARPPIEN)"
+10 ; Print reports from tmp global
SET XBRP="PRTRECPT^BARPPY02"
+11 ;S XBRX="CLEAN0^BARPPY02" ; Clean-up routine
+12 ; Clean-up routine
SET XBRX=""
+13 ;don't allow queing receipts
SET BAR("NOQUE")=1
+14 DO ^BARDBQ02
+15 QUIT
+16 ;
CLEAN ; Clean up after print/re-print receipt
+1 ;If update this list, consider updating CLEAN1 tag as well
+2 KILL BARFMDT,BARFMMM,BARFMDD,BARFMYY
+3 KILL BARPPAMT,BARCNTPP,BARECPT,BARNOPP,BARPAYDT,BARPAYTY,BARPMTDD,BARPMTDI,BARPMTDT
+4 KILL BARPMTMM,BARPMTYP,BARPMTYY,BARPP,BARPPAY,BARPPCMT,BARPPDTM,BARPPIEN,BARPTNM
+5 KILL BARQ,BARREPRT,BARSELPP
+6 QUIT
+7 ;
CLEAN1 ; Clear variables before print receipt
+1 ;clear all but BARPPIEN, BARPPAY, and BARREPRT
+2 KILL BARFMDT,BARFMMM,BARFMDD,BARFMYY
+3 KILL BARPPAMT,BARCNTPP,BARECPT,BARNOPP,BARPAYDT,BARPAYTY,BARPMTDD,BARPMTDI,BARPMTDT
+4 KILL BARPMTMM,BARPMTYP,BARPMTYY,BARPP,BARPPCMT,BARPPDTM,BARPTNM
+5 KILL BARQ,BARSELPP
+6 QUIT
+7 ;
CLEAN0 ; Fake cleanup for multi copy printing. Routine needed for ^BARDBQ01.
+1 ;Routine calling BARDBQ1 must do cleanup.
+2 QUIT
+3 ;
PRTDATE ;Update Receipt Print date in A/R Prepayment file
+1 ;Update Receipt Print Date
+2 KILL DIE,DR,DA
+3 ; IHS/SD/PKD First Printed Date - Not Last Reprint Date
+4 SET BARPRTDT=$PIECE($GET(^BARPPAY(DUZ(2),BARPPIEN,0)),U,19)
+5 IF BARPRTDT=""
Begin DoDot:1
+6 DO NOW^%DTC
+7 SET BARPRTDT=$PIECE(%,".")
End DoDot:1
+8 ;RECEIPT PRINT DATE
SET DR=".19////^S X=BARPRTDT"
+9 ; Update Pre-Payment file
+10 SET DA=BARPPIEN
+11 SET DIE=$$DIC^XBDIQ1(90050.06)
+12 DO ^DIE
+13 ;
PRTDT ;
+1 ;Update Receipt Print Date (multiple)
+2 KILL DIC,DR,DA,DD,DO
+3 SET DA(1)=BARPPIEN
+4 SET DIC=$$DIC^XBDIQ1(90050.06201)
+5 SET DIC(0)="L"
+6 SET DIC("P")=$PIECE(^DD(90050.06,201,0),U,2)
+7 DO NOW^%DTC
+8 SET PRTDAT=%
+9 ;S X=$P(%,".")
+10 ; Date.Time ^ Cashier
SET X=%_U_DUZ
+11 DO FILE^DICN
+12 QUIT
+13 ;
MDY(BARFMDT) ; format Date from FM to MM/DD/YYYY
+1 SET BARFMMM=$EXTRACT(BARFMDT,4,5)
+2 SET BARFMDD=$EXTRACT(BARFMDT,6,7)
+3 SET BARFMYY=$EXTRACT(BARFMDT,1,3)+1700
+4 ;DOS for Prepayment
SET BARFMDT=BARFMMM_"/"_BARFMDD_"/"_BARFMYY
+5 QUIT BARFMDT
+6 ;
