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

BARPSTU.m

Go to the documentation of this file. 
  1. BARPSTU ; IHS/SD/LSL - PAYMENT TRANSACTION EXECUTION ; 06/09/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,6,21,23**;OCT 26, 2005
  1.  ;** posting utilities
  1.  ;
  1.  ; IHS/SD/LSL - 09/23/02 - V1.6 Patch 3 - HIPAA
  1.  ;     Don't update files if Adjustment Category is PENDING or
  1.  ;     GENERAL INFORMATION
  1.  ;
  1.  ; IHS/SD/LSL - 10/17/02 - V1.7 - QAA-1200-130051
  1.  ;      Provide Q conditions if failed getting a new A/R transaction
  1.  ;
  1.  ; ********************************************************************
  1.  Q
  1.  ;
  1. AMT(X,BARMIN,BARMAX) ;EP - ** number function
  1.  ;** quits with "^" to exit
  1.  ;** quits with "?" for incorrect entry
  1.  I '$D(X) Q "^"
  1.  I X["^"!('$L(X)) Q "^"
  1.  S:X["$" X=$P(X,"$",2)
  1.  I X'?."-".N.1".".2N Q "?"
  1.  I $D(BARMIN),X'>BARMIN Q "?"
  1.  I $D(BARMAX),X'<BARMAX Q "?"
  1.  Q X
  1.  ; *********************************************************************
  1.  ;
  1. COMHLP ;EP - help processor
  1.  N X,J
  1.  W $$EN^BARVDF("IOF"),!!
  1.  S X="Select Command Options"
  1.  W ?IOM-$L(X)\2,X
  1.  W !?IOM-$L(X)\2 F J=1:1:$L(X) W "-"
  1.  W !!
  1.  D:$D(BARHLP)<10 SETHLP
  1.  S J=""
  1.  F  S J=$O(BARHLP(J)) Q:J=""  W !?2,BARHLP(J)
  1.  W !!
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. SETHLP ;EP - sethelp
  1.  S BARHLP("A")="A or 2 = Adjustments (Write-Off, Deductible, Non-Covered, Non-Pay, Penalty)"
  1.  S BARHLP("C")="C = Itemized Charges - allows posting by line item"
  1.  S BARHLP("D")="D = Patient Demographics"
  1. B S BARHLP("B")="B = Bill Inquire"
  1.  S BARHLP("E")="E = Edit a transaction not yet posted to A/R"
  1.  S BARHLP("I")="I = Insurer Demographics"
  1.  S BARHLP("H")="H = History of BIll Transactions ($ only)"
  1.  S BARHLP("M")="M = Message"
  1.  S BARHLP("P")="P or 1 = Payment"
  1.  S BARHLP("Q")="Q or 3 = Quit - Ends the data entry for this Patient and allows for posting to A/R"
  1.  S BARHLP("R")="R = Rollover"
  1.  S BARHLP("T")="T = Toggle Display - Current transaction list."
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. POSTTX ;EP - poster  ;Heavily modified for BAR*1.8*4 DD 4.1.7.2
  1.  ;CALLED BY PAY/ADJ/REF POSTING OPTIONS ;BAR*1.8*4 DD 4.1.7.2
  1.  ;
  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.  W !!,"Please wait... Posting Transactions."
  1.  K DD,DO,BARBLV
  1.  N DA,DR,DIE,DIC,DIQ
  1.  N REVERSAL,REVSCHED             ;BAR*1.8*3 UFMS
  1.  S BARLIN=0
  1.  F  S BARLIN=$O(BARTR(BARLIN)) Q:'BARLIN  D
  1.  .S BARBDFN=$O(^BARTMP($J,"B",BARLIN,""))
  1.  .S BARAC=$$GET1^DIQ(90050.01,BARBDFN,3,"I")
  1.  .S BARROLL(BARBDFN)=""
  1.  .S BARBLV(15)=$$GET1^DIQ(90050.01,BARBDFN,15,"I")
  1.  .D CKBAL(BARLIN,BARBLV(15))     ;BAR*1.8*4 DD 4.1.7.2
  1.  .Q:BARSTOP                      ;BAR*1.8*4 DD 4.1.7.2
  1.  .S (BARBTOT,BARJ)=0
  1.  .F  S BARJ=$O(BARTR(BARLIN,BARJ)) Q:'BARJ  D
  1.  ..S BARREC=BARTR(BARLIN,BARJ)
  1.  ..S BARTXT=$P(BARREC,U,1)
  1.  ..S BARAMT=$P(BARREC,U,2)
  1.  ..S BARBTOT=BARBTOT+BARAMT
  1.  ..S BARCAT=$P(BARREC,U,3)
  1.  ..S:BARTXT="P" BARTT=$O(^BARTBL("B","PAYMENT",""))
  1.  ..S:BARTXT="A" BARTT=$O(^BARTBL("B","ADJUST ACCOUNT",""))
  1.  ..S:BARTXT="R" BARTT=39 ;BAR*1.8*4 DD 4.1.7.2 ;change from 55 wrong account number
  1.  ..S BARATYP=$P(BARREC,U,4)
  1.  ..S REVERSAL=$P(BARREC,U,5)      ;BAR*1.8*3 UFMS
  1.  ..S REVSCHED=$P(BARREC,U,6)      ;BAR*1.8*4 UFMS SCR56,SCR58
  1.  ..;
  1.  ..D P1
  1.  .K REVERSAL,REVSCHED            ;BAR*1.8*4 UFMS SCR56,SCR58
  1.  .K BARTR(BARLIN),BARPMT,BARADJ,BARCAT,BARATYP,BARBTOT,BARBLV  ;BAR*1.8*4 DD 4.1.7.2
  1.  ;K ^BARTMP($J)                   ;BAR*1.8*4 DD 4.1.7.2
  1.  ;K BARTR,BARPMT,BARADJ,BARCAT,BARATYP,BARBTOT,BARBLV   ;BAR*1.8*4 DD 4.1.7.2
  1.  Q
  1. CKBAL(BARL,BARB) ;EP; CHECK IF TX'S WILL CREATE NEGATIVE BALANCE
  1.  ;BAR*1.8*4 DD 4.1.7.2
  1.  ;ENTERS WITH BARL = LINE  = BILL
  1.  ;            BARB = BILL BALANCE
  1.  S BARSTOP=0
  1.  Q:'$$IHS^BARUFUT(DUZ(2))
  1.  ;;;Q:'$$IHSERA^BARUFUT(DUZ(2)) ;P.OTT
  1.  N BARTOT,BARJ,BARDIF,BARTAMT,BARPTOT,BARCAT
  1.  S (BARTOT,BARJ,BARPTOT)=0
  1.  F  S BARJ=$O(BARTR(BARL,BARJ)) Q:'BARJ  D
  1.  .S BARREC=BARTR(BARLIN,BARJ)
  1.  .S BARTYP=$P(BARREC,U)
  1.  .S BARTAMT=$P(BARREC,U,2)
  1.  .S BARCAT=$P(BARREC,U,3)
  1.  .I BARCAT'=21&(BARCAT'=22) D
  1.  ..S BARTOT=BARTOT+BARTAMT
  1.  .S:BARTYP="P" BARPTOT=BARPTOT+BARTAMT
  1.  I BARB-BARTOT<0 D
  1.  .D STOP("BILL",BARB-BARTOT)
  1.  Q:'$G(BARCOL)                      ;NO COLLECTION BATCH TO CHECK
  1.  Q:$G(BARZZZZ)  ;DON'T CHECK BATCH/ITEM WHEN ENTERED FROM PUC ;BAR*1.8*6 DD 4.2.5
  1.  D CKCOL
  1.  I +$G(BAREOB),(BAREOV(4)-BARPTOT)<0 D STOP("VISIT LOCATION",(BAREOV(4)-BARPTOT))
  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
  1.  ;
  1. STOP(TYPE,BARDIF) ;EP; BAR*1.8*4 DD 4.1.7.2
  1.  W !!,"THE TRANSACTION(S) YOU ARE ATTEMPTING TO POST WILL PUT"
  1.  W !,"THE ",TYPE," INTO A NEGATIVE BALANCE BY $"_-BARDIF
  1.  W !,"PLEASE CANCEL, OR USE 'M' FOR MORE TO EDIT YOUR TRANSACTION"
  1.  W !,"TO PREVENT THE NEGATIVE BALANCE"
  1.  S BARSTOP=1
  1.  D EOP^BARUTL(1)
  1.  Q
  1.  ; *********************************************************************
  1. P1 ;
  1.  S DIE="^BARTR(DUZ(2),"
  1.  S BARCR=$S(+BARAMT>0:BARAMT,1:"")
  1.  S BARDB=$S(+BARAMT<0:BARAMT,1:"")
  1.  S BARDB=-BARDB
  1.  S BARPT=+BARPAT
  1.  ;Begin changes for BAR*1.8*4 DD 4.1.7.2
  1.  ;S BARAC=$P(BARITM(0),U,7)
  1.  ;S BARPAR=$P(BARCOL(0),U,8)
  1.  ;S BARASFAC=$P(BARCOL(0),U,9)
  1.  ;S BARSECT=$P(BARCOL(0),U,10)
  1.  ;S BARSITE=$P(BARITM(0),U,8)
  1.  S:$G(BARITM(0)) BARAC=$P(BARITM(0),U,7)
  1.  S BARPAR=$P($G(BARCOL(0)),U,8)
  1.  S BARASFAC=$P($G(BARCOL(0)),U,9)
  1.  S BARSECT=$P($G(BARCOL(0)),U,10)
  1.  S BARSITE=$P($G(BARITM(0)),U,8)
  1.  S:$G(BAREOB) BARSITE=BAREOB
  1.  ;End changes for BAR*1.8*4 DD 4.1.7.2
  1.  ; -------------------------------
  1. PX ;
  1.  S X=$$NEW^BARTR
  1.  S BARTRIEN=X
  1.  I X<1 D MSG^BARTR(BARBDFN) Q
  1.  K DIE,DIC,DR,DA
  1.  S DA=X,DIE=90050.03
  1.  S DR="2////^S X=BARCR"
  1.  S DR=DR_";3////^S X=BARDB"
  1.  S DR=DR_";4////^S X=BARBDFN"
  1.  S DR=DR_";5////^S X=BARPT"
  1.  S DR=DR_";6////^S X=BARAC"
  1.  S DR=DR_";8////^S X=BARPAR"
  1.  S DR=DR_";9////^S X=BARASFAC"
  1.  S DR=DR_";10////^S X=BARSECT"
  1.  S DR=DR_";11////^S X=BARSITE"
  1.  S DR=DR_";12////^S X=DT"
  1.  S DR=DR_";13////^S X=DUZ"
  1.  ;S DR=DR_";14////^S X=BARCOL"              ;BAR*1.8*4 DD 4.1.7.2
  1.  ;S DR=DR_";15////^S X=$P(BARITM(0),U,1)"   ;BAR*1.8*4 DD 4.1.7.2
  1.  S:$G(BARCOL) DR=DR_";14////^S X=BARCOL"    ;BAR*1.8*4 DD 4.1.7.2
  1.  S:$G(BARITM(0)) DR=DR_";15////^S X=$P(BARITM(0),U,1)" ;BAR*1.8*4 DD 4.1.7.2
  1.  S DR=DR_";101////^S X=BARTT"
  1.  ;I BARTXT="A" D                             ;BAR*1.8*4 DD 4.1.7.2
  1.  I "RA"[BARTXT D                             ;BAR*1.8*4 DD 4.1.7.2
  1.  . S DR=DR_";102////^S X=BARCAT"
  1.  . S DR=DR_";103////^S X=BARATYP"
  1.  S DR=DR_";10////^S X=$$VALI^XBDIQ1(200,DUZ,29)"
  1.  ;S DR=DR_";110////^S X=REVERSAL"  ;ISH/SD/TPF BAR*1.8*3 UFMS
  1.  I $G(REVERSAL) D
  1.  .S DR=DR_";110////^S X=REVERSAL"  ;ISH/SD/TPF BAR*1.8*4 UFMS
  1.  .S DR=DR_";111////^S X=REVSCHED"  ;ISH/SD/TPF BAR*1.8*4 UFMS SCR56,SCR58
  1.  S DIDEL=90050
  1.  D ^DIE
  1.  K DIDEL
  1.  I ",21,22,"[(","_BARCAT_",") Q
  1.  D TR^BARTDO(BARTRIEN)
  1.  W "."
  1. DONE ;
  1.  Q
  1.  ; ------------------------------------------
  1. CKCOL ;EP; CHECK COLLECTION BATCH/ITEM BALANCES;BAR*1.8*4 DD 4.1.7.2
  1.  K BARCLV,BARITV,BAREOV
  1.  N DA,DIC,DIQ,DR
  1.  S DIC=90051.01
  1.  S DIQ="BARCLV("
  1.  S DR=17
  1.  S DA=+BARCOL
  1.  D EN^XBDIQ1
  1.  ;
  1.  S DIC=90051.1101
  1.  S DIQ="BARITV("
  1.  S DR=19
  1.  S DA=+BARITM
  1.  S DA(1)=+BARCOL
  1.  D EN^XBDIQ1
  1.  ;
  1.  I +$G(BAREOB) D
  1.  . S DIC=90051.1101601
  1.  . S DIQ="BAREOV("
  1.  . S DR=4
  1.  . S DA=+BAREOB
  1.  . S DA(2)=+BARCOL
  1.  . S DA(1)=+BARITM
  1.  . D EN^XBDIQ1
  1.  Q