- BARPST1 ; IHS/SD/LSL - Posting and Adjustments ; 07/10/2010
- ;;1.8;IHS ACCOUNTS RECEIVABLE;**19,21**;OCT 26, 2005
- ;
- ;
- ; IHS/SD/TMM 06/18/2010 1.8*19 Add Prepayment functionality.
- ; See work order 3PMS10001
- ; ------------------------
- ; 819_1. Display prepayments not assigned to a batch (^BARCLU)
- ; 819_2. Remove prompt: AUTO PRINT RECEIPT (^BARCLU01)
- ; 819_3. Prepayment entry ^BARPPY01 (new routine),^BARCLU1,^BARPUTL
- ; 819_4. Display prepayments matching payment type selected (^BARCLU)
- ; 819_5. Allow user to assign prepayment to batch (^BARCLU,^BARCLU01,^BARPUTL,^BARPST1,^BARBLLK)
- ; 819_6. Print Prepayment Receipt (^BARPPY02) (new routine)
- ; *********************************************************************
- ;
- EN() ; EP
- ; Batch Posting entry
- K BARPAT,BARZ
- D SELBILL^BARPUTL
- I $G(BARZ) Q BARZ
- D ASKPAT^BARPUTL
- I $G(BARZ) Q BARZ
- D GETBIL^BARPUTL
- I $G(BARZ) Q BARZ
- Q 0
- ; *********************************************************************
- ;
- TOP(BARV) ; EP
- ; Select Batch
- W !!!
- W "Select Batch: "_$P(BARCOL(0),U,1)
- S Y=+BARCOL
- D BATW^BARPST
- D BBAL^BARPST(BARCOL)
- W !!,"Select Item: "_BARITM
- S Y=+BARITM
- D DICW^BARPST
- D IBAL^BARPST(BARITM)
- I $G(BAREOB) D
- .N DA
- .W !!
- .W "Select Visit Location: "
- .S DA=BAREOB
- .S DA(1)=+BARITM
- .S DA(2)=+BARCOL
- .W $$VAL^XBDIQ1(90051.1101601,.DA,.01)
- .D EBAL^BARPST(BAREOB)
- Q:'BARV
- W !!
- W "Select Patient: "_$P(BARPAT(0),U,1)
- Q
- ;
- EN1(DICB,DICB2,DICB3) ; EP
- ;--->NEW TAG EN1---> ;M819*ADD*TMM*20100711 (819_4)
- ; (Same as EN^BARPST1 but passes default DIC("B") values to ^BARPUTL
- ;
- ; Batch Posting entry
- K BARPAT,BARZ
- D SELBILLB^BARPUTL(DICB2)
- I $G(BARZ) Q BARZ
- D ASKPATB^BARPUTL(DICB)
- I $G(BARZ) Q BARZ
- D GETBILB^BARPUTL(DICB3)
- I $G(BARZ) Q BARZ
- Q 0
- BARPST1 ; IHS/SD/LSL - Posting and Adjustments ; 07/10/2010
- +1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**19,21**;OCT 26, 2005
- +2 ;
- +3 ;
- +4 ; IHS/SD/TMM 06/18/2010 1.8*19 Add Prepayment functionality.
- +5 ; See work order 3PMS10001
- +6 ; ------------------------
- +7 ; 819_1. Display prepayments not assigned to a batch (^BARCLU)
- +8 ; 819_2. Remove prompt: AUTO PRINT RECEIPT (^BARCLU01)
- +9 ; 819_3. Prepayment entry ^BARPPY01 (new routine),^BARCLU1,^BARPUTL
- +10 ; 819_4. Display prepayments matching payment type selected (^BARCLU)
- +11 ; 819_5. Allow user to assign prepayment to batch (^BARCLU,^BARCLU01,^BARPUTL,^BARPST1,^BARBLLK)
- +12 ; 819_6. Print Prepayment Receipt (^BARPPY02) (new routine)
- +13 ; *********************************************************************
- +14 ;
- EN() ; EP
- +1 ; Batch Posting entry
- +2 KILL BARPAT,BARZ
- +3 DO SELBILL^BARPUTL
- +4 IF $GET(BARZ)
- QUIT BARZ
- +5 DO ASKPAT^BARPUTL
- +6 IF $GET(BARZ)
- QUIT BARZ
- +7 DO GETBIL^BARPUTL
- +8 IF $GET(BARZ)
- QUIT BARZ
- +9 QUIT 0
- +10 ; *********************************************************************
- +11 ;
- TOP(BARV) ; EP
- +1 ; Select Batch
- +2 WRITE !!!
- +3 WRITE "Select Batch: "_$PIECE(BARCOL(0),U,1)
- +4 SET Y=+BARCOL
- +5 DO BATW^BARPST
- +6 DO BBAL^BARPST(BARCOL)
- +7 WRITE !!,"Select Item: "_BARITM
- +8 SET Y=+BARITM
- +9 DO DICW^BARPST
- +10 DO IBAL^BARPST(BARITM)
- +11 IF $GET(BAREOB)
- Begin DoDot:1
- +12 NEW DA
- +13 WRITE !!
- +14 WRITE "Select Visit Location: "
- +15 SET DA=BAREOB
- +16 SET DA(1)=+BARITM
- +17 SET DA(2)=+BARCOL
- +18 WRITE $$VAL^XBDIQ1(90051.1101601,.DA,.01)
- +19 DO EBAL^BARPST(BAREOB)
- End DoDot:1
- +20 IF 'BARV
- QUIT
- +21 WRITE !!
- +22 WRITE "Select Patient: "_$PIECE(BARPAT(0),U,1)
- +23 QUIT
- +24 ;
- EN1(DICB,DICB2,DICB3) ; EP
- +1 ;--->NEW TAG EN1---> ;M819*ADD*TMM*20100711 (819_4)
- +2 ; (Same as EN^BARPST1 but passes default DIC("B") values to ^BARPUTL
- +3 ;
- +4 ; Batch Posting entry
- +5 KILL BARPAT,BARZ
- +6 DO SELBILLB^BARPUTL(DICB2)
- +7 IF $GET(BARZ)
- QUIT BARZ
- +8 DO ASKPATB^BARPUTL(DICB)
- +9 IF $GET(BARZ)
- QUIT BARZ
- +10 DO GETBILB^BARPUTL(DICB3)
- +11 IF $GET(BARZ)
- QUIT BARZ
- +12 QUIT 0