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

BARFPST5.m

Go to the documentation of this file. 
  1. BARFPST5 ; IHS/SD/LSL - A/R FLAT RATE POSTING ; 12/22/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**6,10,21,23**;OCT 26, 2005
  1.  ;;
  1. DOC ;
  1.  ; LSL - 01/01/2000 - Created routine
  1.  ;       Contains code for POSTING, EDITING, CANCELLING, or QUITING
  1.  ;       Bills from A/R FLAT RATE POSTING
  1.  ;
  1.  ; IHS/ASDS/LSL - 06/29/00 - v1.3
  1.  ;       Mark bills for rollback capabilities.  Set BARROLL array 
  1.  ;       during posting process.  Call EN^BARROLL after posting 
  1.  ;       complete.  BARRAYGO needs to be defined as well. (Currently,
  1.  ;       it will be set to 0 as we don't allow "Roll over as you go".)
  1.  ;
  1.  ; IHS/ASDS/LSL - 06/29/00 - V1.3
  1.  ;     Added tag ROLFIX to mark bills for rollback that were posted
  1.  ;     before the above change.
  1.  ;
  1.  ; ITSC/SD/LSL - 10/21/02 - V1.7 - NOIS QAA-1200-130051
  1.  ;     Added quit logic in PSTBIL if error getting A/R Transaction
  1.  ;;
  1.  Q
  1.  ; *********************************************************************
  1. ACTION ; EP
  1.  ; EP - Posting and review bills section.
  1.  ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
  1.  I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) D NOSESS Q  ;IS SESSION STILL OPEN
  1.  I '+BARFLAG W !!,"You must Review the bills before posting."
  1.  D SELCOM                                   ; Select command (P/R/E/C/Q)
  1.  I '+BARCOMD W !!,"This is a required response.",! G ACTION
  1.  I BARRECPQ="P" D                           ; Posting
  1.  . D POST                                   ; Post FRP bills
  1.  . I BARSTOP=1 S BARRECPQ="E" Q      ; HAS NEGATIVE BAL;MRS:BAR*1.8*6 DD 4.2.5
  1.  . S BARRAYGO=0                      ; "Roll-over as you go flag" to no
  1.  . D EN^BARROLL                             ; Mark bills for roll-over
  1.  I BARRECPQ="R" D REVIEW^BARFPST4 G ACTION  ; Review FRP bills
  1.  I BARRECPQ="E" D FRPBILL^BARFPST3 G ACTION  ; Edit FRP bills
  1.  I BARRECPQ="C" D CANCEL G:'+BARCAN ACTION  ; Cancel FRP entry
  1.  Q
  1.  ; *********************************************************************
  1. SELCOM ;  
  1.  ; Select command (P/R/E/C/Q)
  1.  S BARCOMD=1                   ; "Select Command (P/R/E/C/Q)" Entry Flag
  1.  K DIR
  1.  I '+BARFLAG D                 ; If not review flag, don't allow post
  1.  . S DIR(0)="SAO^R:REVIEW;E:EDIT;C:CANCEL;Q:QUIT"
  1.  . S DIR("A")="Select Command (R/E/C/Q): "
  1.  E  D                          ; If review flag, allow post 
  1.  . S DIR(0)="SAO^P:POST;R:REVIEW;E:EDIT;C:CANCEL;Q:QUIT"
  1.  . S DIR("A")="Select Command (P/R/E/C/Q): "
  1.  D ^DIR
  1.  K DIR
  1.  I $D(DUOUT)!(Y="") S BARCOMD=0  ; Select Command Entry Flag
  1.  S BARRECPQ=$E($G(Y(0)))       ; Users answer to prompt
  1.  Q
  1.  ; *********************************************************************
  1. POST ;    
  1.  ; Post to A/R TRANSACTION/IHS File and bill's history
  1.  S BARTMP=0                    ; Adjustment array flag
  1.  S BARSTOP=""                  ; NEGATIVE BALANCE FLAG MRS:BAR*1.8*6 DD 4.2.5
  1.  S BARSECT=$$VALI^XBDIQ1(200,DUZ,29)  ; Service/Section from NEW PERSON
  1.  I $D(BARPAY) D                ; If payment entered
  1.  . I BARPAY<0,$$IHS^BARUFUT(DUZ(2)) D STOP^BARFPST1 S BARSTOP=1 Q  ;MRS:BAR*1.8*10 D158-3
  1.  . ;;;I BARPAY<0,$$IHSERA^BARUFUT(DUZ(2)) D STOP^BARFPST1 S BARSTOP=1 Q  ;MRS:BAR*1.8*10 D158-3 P.OTT
  1.  . D CKBAL(BARIEN,BARPAY,BARCOL,BARITM) ;CHECK BALANCE;MRS:BAR*1.8*6 DD 4.2.5
  1.  . Q:BARSTOP=1                           ;HAS NEGATIVE BALANCE;MRS:BAR*1.8*6 DD 4.2.5
  1.  . D PSTBIL                    ; Post bills with this payment
  1.  . W !,"Payment of "_$J(BARPAY,9,2)_" posted to "_BARCNT_" bills."
  1.  Q:BARSTOP=1                   ; NEGATIVE BALANCE FLAG MRS:BAR*1.8*6 DD 4.2.5
  1.  I $D(BARADJ) D                ; If Adjustments entered
  1.  . S BARTMP=1                  ; Adjustment array flag  
  1.  . S J=0
  1.  . F  S J=$O(BARADJ(J)) Q:'+J  D  ; For each adjustment...
  1.  . . D PSTBIL                  ; Post bills with this adjustment
  1.  . . W !,"Adjustment category "_$P(BARADJ(J),U,3)_" Type "_$P(BARADJ(J),U,5)_" for "_$J($P(BARADJ(J),U),9,2)_" posted to "_BARCNT_" bills."
  1.  W !,"Done Posting."
  1.  ; Mark FRP Batch as POSTED in A/R FLAT RATE POSTING file
  1.  K DA,DR,DIE
  1.  S DIE="^BARFRP(DUZ(2),"
  1.  S DA=BARIEN
  1.  S DR=".13////P"
  1.  D ^DIE
  1.  I $D(BARNOT) D ERROR Q
  1.  Q
  1.  ; *********************************************************************
  1. PSTBIL ;
  1.  ; Post bills 
  1.  K DA,DR,DIE
  1.  S (BARFRPL,BARCNT)=0
  1.  ; Loop through facilities in A/R FLAT RATE POSTING File
  1.  F  S BARFRPL=$O(^BARFRP(DUZ(2),BARIEN,2,BARFRPL)) Q:'+BARFRPL  D
  1.  . ; IEN to VISIT LOCATION multiple in A/R COLLECTION BATCH
  1.  . S BAREOB=$$VALI^XBDIQ1(90054.0102,"BARIEN,BARFRPL",.01)
  1.  . S K=0
  1.  . ; Loop through bills (within facility) in A/R FLAT RATE POSTING File
  1.  . F  S K=$O(^BARFRP(DUZ(2),BARIEN,2,BARFRPL,3,K)) Q:'+K  D
  1.  . . S BARBLIEN=$P(^BARFRP(DUZ(2),BARIEN,2,BARFRPL,3,K,0),U) ; IEN to A/R BILL
  1.  . . S BARBLPAT=$$VALI^XBDIQ1(90050.01,BARBLIEN,101)  ; A/R Patient IEN
  1.  . . S BARBLAC=$$VALI^XBDIQ1(90050.01,BARBLIEN,3)     ; A/R Account
  1.  . . S BARBLCR=$S(+BARTMP:$P(BARADJ(J),U),'+BARTMP:BARPAY,1:"") ; Credit
  1.  . . S BARTRAN=$S(+BARTMP:43,'+BARTMP:40,1:"")        ; Transaction code
  1.  . . S BARTRIEN=$$NEW^BARTR               ; Create Transaction
  1.  . . ; Populate Transaction file
  1.  . . S DA=BARTRIEN                        ; IEN to A/R TRANSACTION
  1.  . . I BARTRIEN<1 S BARNOT(BARBLIEN,BARTRAN,$S(BARTRAN=43:$G(J),1:99999))="" Q
  1.  . . S BARCNT=BARCNT+1         ; Bill counter
  1.  . . S DIE=90050.03
  1.  . . S DR="2////^S X=BARBLCR"             ; Credit
  1.  . . S DR=DR_";4////^S X=BARBLIEN"        ; A/R Bill
  1.  . . S DR=DR_";5////^S X=BARBLPAT"        ; A/R Patient
  1.  . . S DR=DR_";6////^S X=BARBLAC"         ; A/R Account
  1.  . . S DR=DR_";8////^S X=DUZ(2)"          ; Parent Location
  1.  . . S DR=DR_";9////^S X=DUZ(2)"          ; Parent ASUFAC
  1.  . . S DR=DR_";10////^S X=BARSECT"        ; A/R Section
  1.  . . S DR=DR_";11////^S X=BAREOB"         ; Visit Location
  1.  . . S DR=DR_";12////^S X=$P(BARDT,""."")"  ; Date
  1.  . . S DR=DR_";13////^S X=DUZ"            ; Entry by
  1.  . . S DR=DR_";14////^S X=BARCOL"         ; IEN to A/R COLLECTION BATCH
  1.  . . S DR=DR_";15////^S X=BARITM"         ; IEN to ITEM mult in A/R COL
  1.  . . S DR=DR_";101////^S X=BARTRAN"       ; Transaction Type
  1.  . . I BARTRAN=43 D                       ; If Adjustment
  1.  . . . S DR=DR_";102////^S X=$P(BARADJ(J),U,2)"  ; Adjustment Category
  1.  . . . S DR=DR_";103////^S X=$P(BARADJ(J),U,4)"  ; Adjustment Type
  1.  . . S DIDEL=90050
  1.  . . D ^DIE
  1.  . . K DIDEL,DIE,DA,DR
  1.  . . ; Post from transaction file to related files
  1.  . . D TR^BARTDO(BARTRIEN)
  1.  . . S BARROLL(BARBLIEN)=""               ; Needed for rollback
  1.  Q
  1.  ; *********************************************************************
  1. ERROR ;
  1.  N L,T,A
  1.  W !!!,$$EN^BARVDF("BLN")
  1.  W $$CJ^XLFSTR("The system could not create at least 1 entry in the A/R Transaction File")
  1.  W !,$$CJ^XLFSTR("Please verify postings for the following bills and repost if necessary")
  1.  W $$EN^BARVDF("BLF")
  1.  S L=0
  1.  F  S L=$O(BARNOT(L)) Q:'+L  D
  1.  . S T=0
  1.  . F  S T=$O(BARNOT(L,T)) Q:'+T  D
  1.  . . S A=0
  1.  . . F  S A=$O(BARNOT(L,T,A)) Q:'+A  D
  1.  . . . W !,$$GET1^DIQ(90050.01,L,.01)                     ; Bill
  1.  . . . I T=40 W ?15,"PAYMENT OF ",$J(BARPAY,9,2)
  1.  . . . E  W ?15,$P(BARADJ(A),U,3),", ",$P(BARADJ(A),U,5)," OF ",$J($P(BARADJ(A),U),9,2)
  1.  Q
  1.  ; *********************************************************************
  1. CANCEL ;  
  1.  ; Cancel Entries
  1.  N BARSTAT
  1.  S BARSTAT=$$VALI^XBDIQ1(90054.01,BARIEN,.13)
  1.  I BARSTAT="P" D  Q
  1.  . S BARCAN=0
  1.  . W !,"This FRP Batch has already been posted.  It may not be cancelled"
  1.  S DIR(0)="Y"
  1.  S BARCAN=1
  1.  S DIR("A",2)="Everything entered into the A/R FLAT RATE POSTING file"
  1.  S DIR("A",3)="for Collection Batch "_BARBNM
  1.  S DIR("A",4)="and ITEM "_BARINM_" will be deleted."
  1.  S DIR("A")="Continue"
  1.  S DIR("B")="No"
  1.  D ^DIR
  1.  K DIR
  1.  I Y'=1 S BARCAN=0 Q
  1.  ; Kill Visit Location multiple which will subsequently kill the 
  1.  ; A/R Bill multiple.
  1. NOSESS  ; EP IHS/SD/PKD 1.8*21 Heat20490 3/21/11
  1.  ; Kill Flat Rate Batch if Session not open
  1.  S BARCAN=1
  1.  ; END 1.8*21
  1.  S DA=BARIEN
  1.  S DIK="^BARFRP(DUZ(2),"
  1.  D ^DIK
  1.  Q
  1.  ; *********************************************************************
  1. DELFRP ; EP
  1.  ; EP - Called from MAN,FRD
  1.  D DELFRPE                         ; Get Flat Rate Posting Entry
  1.  I Y<1 D EXIT^BARFPST Q
  1.  D DELFRPD
  1.  Q
  1.  ; *********************************************************************
  1. DELFRPE ;
  1.  ; Get Flat Rate Posting Entry
  1.  W !
  1.  K DIC
  1.  S DIC="^BARFRP(DUZ(2),"
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Select FRP Batch: "
  1.  S DIC("S")="I $P(^(0),U,13)=""P"""    ; Only posted batches
  1.  D ^DIC
  1.  I Y<1 Q
  1.  S BARIEN=+Y
  1.  S BARNAME=Y(0,0)
  1.  Q
  1.  ; *********************************************************************
  1. DELFRPD ;
  1.  ; Delete FRP Batch
  1.  K DIR
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Delete "_BARNAME
  1.  S DIR("B")="No"
  1.  D ^DIR
  1.  K DIR
  1.  I Y'=1 W !,"Not Deleted." Q
  1.  ; Kill batch
  1.  S DA=BARIEN
  1.  S DIK="^BARFRP(DUZ(2),"
  1.  D ^DIK
  1.  W !,"Deleted!"
  1.  Q
  1.  ; *********************************************************************
  1. ROLFIX ;  
  1.  ; Mark bills for rollback that were posted before the code was
  1.  ; changed to accomodate 6/29/00
  1.  D ^BARVKL0                               ; Kill namespace variables
  1.  K DA,DR,DIE
  1.  S (L,BARCNT,BARIEN,BARRAYGO)=0
  1.  ; Loop through FRP batches (only posted)
  1.  F  S BARIEN=$O(^BARFRP(DUZ(2),BARIEN)) Q:'+BARIEN  D
  1.  . Q:$P($G(^BARFRP(DUZ(2),BARIEN,0)),U,13)'="P"
  1.  . ; Loop through facilities in A/R FLAT RATE POSTING File
  1.  . S L=0
  1.  . F  S L=$O(^BARFRP(DUZ(2),BARIEN,2,L)) Q:'+L  D
  1.  . . ; IEN to VISIT LOCATION multiple in A/R COLLECTION BATCH
  1.  . . S BAREOB=$$VALI^XBDIQ1(90054.0102,"BARIEN,L",.01)
  1.  . . S K=0
  1.  . . ; Loop through bills (within facility) in A/R FLAT RATE POSTING File
  1.  . . F  S K=$O(^BARFRP(DUZ(2),BARIEN,2,L,3,K)) Q:'+K  D
  1.  . . . S BARBLIEN=$P(^BARFRP(DUZ(2),BARIEN,2,L,3,K,0),U) ; IEN to A/R BILL
  1.  . . . Q:$P(^BARBL(DUZ(2),BARBLIEN,2),U,8)]""  ; Q if rollback populated
  1.  . . . S BARROLL(BARBLIEN)=""               ; Needed for rollback
  1.  . . . D EN^BARROLL
  1.  . . . K BARROLL
  1.  D ^BARVKL0
  1.  K DA,DR,DIC,DIE,K,L
  1.  Q
  1.  ; *********************************************************************
  1. CKBAL(BARA,BARPAY,BARCOL,BARITM) ;EP; CHECK IF TX'S WILL CREATE NEGATIVE BALANCE;BAR*1.8*6 DD 4.2.5
  1.  ;ENTERS WITH BARA   = BATCH IEN
  1.  ;            BARPAY = FLAT RATE PAY AMOUNT
  1.  ;            BARCOL = COLLECTION BATCH
  1.  ;            BARITM = COLLECTION BATCH ITEM
  1.  ;
  1.  Q:'$$IHS^BARUFUT(DUZ(2))           ;ONLY CHECK IHS SITES 
  1.  ;;;Q:'$$IHSERA^BARUFUT(DUZ(2)) ;QUIT IF IHS SITE OR TRIBAL WITH RESTRICTED POSTING ;P.OTT
  1.  N BAR,BARF,BARK,BARPTOT,BARMULT
  1.  S BARMULT=+$P(^BAR(90052.06,DUZ(2),DUZ(2),0),U,2)       ;MULTIPLE 3P EOB FLAG
  1.  S (BARF,BARCT,BARPTOT)=0
  1.  ; Loop through facilities in A/R FLAT RATE POSTING File
  1.  F  S BARF=$O(^BARFRP(DUZ(2),BARA,2,BARF)) Q:'+BARF  D
  1.  .; IEN to VISIT LOCATION multiple in A/R COLLECTION BATCH
  1.  .S BAR=$$VALI^XBDIQ1(90054.0102,"BARA,BARF",.01)
  1.  .S BARK=0
  1.  .F  S BARK=$O(^BARFRP(DUZ(2),BARA,2,BARF,3,BARK)) Q:'+BARK  D
  1.  ..S BARCT=BARCT+1
  1.  ..S:BARMULT BAR(BARF,BAR)=$G(BAR(BARF,BAR))+BARPAY
  1.  S BARPTOT=BARCT*BARPAY
  1.  I BARMULT N BAREOB
  1.  D CKCOL^BARPSTU                    ;RETURNS BATCH TOTAL ARRAYS
  1.  I (BARITV(19)-BARPTOT)<0 D STOP("COLLECTION ITEM",(BARITV(19)-BARPTOT))
  1.  I (BARCLV(17)-BARPTOT)<0 D STOP("COLLECTION BATCH",(BARCLV(17)-BARPTOT))
  1.  Q:'BARMULT
  1.  S BARF=0
  1.  F  S BARF=$O(BAR(BARF)) Q:'BARF  D
  1.  .S BAREOB=0
  1.  .F  S BAREOB=$O(BAR(BARF,BAREOB)) Q:'BAREOB  D
  1.  ..D CKCOL^BARPSTU                    ;RETURNS BATCH TOTAL ARRAYS
  1.  ..S BARPTOT=BAR(BARF,BAREOB)
  1.  ..I +$G(BAREOB),(BAREOV(4)-BARPTOT)<0 D
  1.  ...D STOP($P(^AUTTLOC(BAREOB,0),U,2)_" VISIT LOCATION",(BAREOV(4)-BARPTOT))
  1.  Q
  1.  ;
  1. STOP(TYPE,BARDIF) ;EP; BAR*1.8*6 DD 4.2.5
  1.  Q:'$$IHS^BARUFUT(DUZ(2))           ;ONLY CHECK IHS SITES
  1.  ;;;Q:'$$IHSERA^BARUFUT(DUZ(2))           ;Q: IHS OR TRIBAL WITH RESTRICTION ; P.OTT
  1.  W !!,"THE TRANSACTION(S) YOU ARE ATTEMPTING TO POST WILL PUT"
  1.  W !,"THE ",TYPE," INTO A NEGATIVE BALANCE BY $"_-BARDIF
  1.  W:TYPE="BILL" !,"Bill will not be included when posting"
  1.  I TYPE'="BILL" D
  1.  .W !?10,"PLEASE CANCEL, OR USE 'E' TO EDIT THE TRANSACTIONS"
  1.  .W !?15,"TO PREVENT THE NEGATIVE BALANCE"
  1.  S BARSTOP=1
  1.  D EOP^BARUTL(1)
  1.  Q