Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARFPST

BARFPST.m

Go to the documentation of this file. 
  1. BARFPST ; IHS/SD/LSL - FLAT RATE POSTING ; 07/08/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**6,21**;OCT 26, 2005
  1.  ;;
  1. DOC ;
  1.  ; LSL - 12/30/1999 - Created routine
  1.  ;       First Flat Rate Posting Routine
  1.  ;       Contains top level logic loop, Batch, Item, and Facility
  1.  ;
  1.  ; IHS/SD/LSL - 02/27/04 - V1.7 Patch 5
  1.  ;      Mark FAC as entry point
  1.  ;;
  1.  Q
  1.  ; *********************************************************************
  1. EN ; EP
  1.  ; EP - Electronic Signature test
  1.  D ^BARVKL0                    ; kill namespace variables
  1.  S BARESIG=""                  ; BAR electronic signature flag
  1.  D SIG^XUSESIG Q:X1=""         ; elec sig test - Q if fail
  1.  S BARESIG=1                   ; passed elec sig test
  1.  I '$D(BARUSR) D INIT^BARUTL   ; Initialize BAR environment
  1.  D FRPBATCH                    ; Look up Flat Rate Post entry
  1.  I $D(BARNEW),'+BARNEW D EXIT Q  ; If not new entry, quit
  1.  ; Ask A/R col batch if not existing FRP
  1.  I '+$G(BARIEN) D BATCH I '+BARBATCH D EXIT Q
  1.  ; -------------------------------
  1.  ;
  1. SELITEM ;
  1.  ; return here if user never enters a facility when multiple 3P EOB
  1.  D ITEM                        ; Select batch item
  1.  I '+BARITEM D EXIT Q          ; Batch item failed
  1.  ; I multiple 3P EOB
  1.  I +$P(^BAR(90052.06,DUZ(2),DUZ(2),0),U,2) D
  1.  . F  D FAC Q:'+BARFAC  D
  1.  . . S BAREOB=+Y               ; IEN to VISIT LOC multiple
  1.  . . D PAYADJD^BARFPST1        ; Display current payment/adjustment
  1.  . . F  D PAYADJ^BARFPST1 Q:BARPA="Q"   ; Ask for payments/adjustments
  1.  . . Q:('$D(BARPAY)&('$D(BARADJ)))  ; No paymnt/adjustments entered
  1.  . . D BARSAV^BARFPST2         ; Save data in FLAT RATE POST File
  1.  . . Q:$D(BARNONE)             ; Entry to FRP file failed
  1.  . . D DISP^BARFPST3           ; Display accum post/balance
  1.  . . D FRPBILL^BARFPST3        ; A/R bill selection
  1.  E  D
  1.  . S BAREOB=DUZ(2)             ; Parent facility
  1.  . D PAYADJD^BARFPST1          ; Display current payment/adjustment
  1.  .;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
  1.  .I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) Q  ;IS SESSION STILL OPEN
  1.  . F  D PAYADJ^BARFPST1 Q:BARPA="Q"     ; Ask for payments/adjustments
  1.  . Q:('$D(BARPAY)&('$D(BARADJ)))  ; No paymnt/adjustments entered
  1.  . D BARSAV^BARFPST2           ; Save data in FLAT RATE POST File
  1.  . Q:$D(BARNONE)               ; Entry to FRP file failed
  1.  . D DISP^BARFPST3             ; Display accum post/balance
  1.  .;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
  1.  .I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) Q  ;IS SESSION STILL OPEN
  1.  . D FRPBILL^BARFPST3          ; A/R bill selection
  1.  ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
  1.  I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) D EXIT Q  ;IS SESSION STILL OPEN
  1.  ; Q if facility not asked and no payments or adjustments
  1.  I '$D(BARFAC),('$D(BARPAY)&('$D(BARADJ))) D EXIT Q
  1.  I '$D(BARFIEN) G SELITEM
  1.  D ACTION^BARFPST5             ; Posting and reviewing bills.
  1.  D EXIT
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. FRPBATCH ;
  1.  ; Look up Flate Rate Posting entry
  1.  K DIC
  1.  S DIC="^BARFRP(DUZ(2),"
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Select previously opened FRP batch: "
  1.  ; Screen for FRP batches not already posted.
  1.  S DIC("S")="I $P(^(0),U,13)'=""P"""
  1.  D ^DIC
  1.  ; If look up fails, ask if user is creating a new entry
  1.  I Y<1 D NEWFRP Q
  1.  S BARCOL=$P(Y(0),U,4)         ; IEN to A/R COLLECTION BATCH
  1.  I '$$CKDATE^BARPST(BARCOL,1,"SELECT A/R COLLECTION BATCH") D NEWFRP Q  ; OLD BATCH BAR*1.8*6 DD 4.2.4
  1.  S BARIEN=+Y                   ; IEN to A/R FLAT RATE POSTING
  1.  S BARITM=$P(Y(0),U,5)         ; IEN to ITEM Mult of A/R COLLECT BATCH
  1.  S BARNAME=Y(0,0)              ; Name of FRP batch
  1.  S BARBNM=$$VAL^XBDIQ1(90054.01,BARIEN,.04)  ; Collection batch name
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. NEWFRP ;
  1.  ; Ask if user wants to create a new Flat Rate Posting entry
  1.  K DIR
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Create new entry"
  1.  S DIR("B")="Yes"
  1.  D ^DIR
  1.  I Y'=1 S BARNEW=0 Q
  1.  S BARNEW=1                    ; Flag for new FRP entry
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. BATCH ; EP 
  1.  ; EP - Select Collection Batch
  1.  W !
  1.  K DIC
  1.  S BARBATCH=1                  ; Batch loop flag
  1.  S DIC="^BARCOL(DUZ(2),"
  1.  S DIC(0)="AEZQM"
  1.  S DIC("A")="Select Batch: "
  1.  ; Screen for only postable batches where service/section of user
  1.  ; equals that of batch.
  1.  S DIC("S")="I $P(^(0),U,3)=""P""&($G(BARUSR(29,""I""))=$P(^(0),U,10))"
  1.  ; Write site location next to each selection
  1.  S DIC("W")="D BATW^BARPST"
  1.  D ^DIC
  1.  K DIC
  1.  I Y'>0 S BARBATCH=0 Q         ; Batch loop flag
  1.  S BARCOL=+Y                   ; IEN to A/R COLLECTION BATCH
  1.  I '$$CKDATE^BARPST(BARCOL,1,"SELECT A/R COLLECTION BATCH") S BARBATCH=0 Q  ;MRS:BAR*1.8*6 DD 4.2.4
  1.  S BARBNM=$P(Y(0),U)           ; Collection batch name
  1.  D BBAL^BARPST(BARCOL)         ; Display batch balance and posting total
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. ITEM ; EP
  1.  ; EP - Select Batch Item Number
  1.  W !
  1.  S BARITEM=1                   ; Item loop flag
  1.  S DA(1)=BARCOL
  1.  S DIC="^BARCOL(DUZ(2),"_DA(1)_",1,"
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("W")="D DICW^BARPST"    ; Help dislpay
  1.  S DIC("A")="Select Batch Item: "
  1.  S:$D(BARITM) DIC("B")=$$VAL^XBDIQ1(90051.1101,"BARCOL,BARITM",.01)
  1.  ; Screen for all ITEMS not Cancelled or Rolled up
  1.  S DIC("S")="I $P(^(0),U,17)'=""C""&($P(^(0),U,17)'=""R"")"
  1.  D ^DIC
  1.  K DIC
  1.  I +Y<1 S BARITEM=0 Q          ; Item loop flag
  1.  S BARITM=+Y                   ; IEN to ITEM Mult of A/R COLLECT BATCH
  1.  S BARINM=$P(Y(0),U,11)        ; Check number
  1.  D IBAL^BARPST(BARITM)         ; Display item balance and posting total
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. FAC ; EP
  1.  ; Select visit location only if Multiple 3P EOB site parameter
  1.  ; is set to yes.
  1.  K BAREOB
  1.  W !
  1.  S BARFAC=1                    ; Facility loop flag
  1.  S DA(2)=+BARCOL               ; IEN to A/R COLLECTION
  1.  S DA(1)=+BARITM               ; IEN to ITEM multiple
  1.  D ^XBSFGBL(90051.1101601,.BARGL)  ; Format global structure
  1.  S DIC=$P(BARGL,"DA,",1)
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("W")="W ?20,$J($P(^(0),U,2),8,2)"
  1.  S DIC("A")="Select Visit Location: "
  1.  D ^DIC
  1.  K DIC
  1.  I +Y<1 S BARFAC=0             ; Facility loop flag
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. EXIT ; EP
  1.  ; EP - Exit, kill local variables
  1.  D ^BARVKL0                    ; kill namespace variables
  1.  Q