BARPST1.m

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