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

BARPST5.m

Go to the documentation of this file. 
  1. BARPST5 ; IHS/SD/LSL - LIST TRANSACTION HISTORY OF A BILL ; 03/31/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,4,5,6,20,23,24**;OCT 26,2005;Build 69
  1.  ;
  1.  ; IHS/SD/SDR - 03/11/2002 - V1.6 Patch 2 - NOIS HQW-0801-100024
  1.  ;     Modified routine to output insurer field as well as Entry By,
  1.  ;     Complete entry for Transaction Type, and A/R Account.  Also fixed
  1.  ;     line in CHKLINE to fix unrelated <DPARM> error if "^" out of bill
  1.  ;
  1.  ; IHS/SD/SDR - 4/4/2002 - V1.6 Patch 2 - NOIS HQW-0302-100166
  1.  ;     Modified so it won't display any of the following transaction
  1.  ;     types.  They are causing confusion and are not necessary to 
  1.  ;     display.
  1.  ;          COL BAT TO ACC POST - 115
  1.  ;          COL BAT TO ACC UN-DIST -116 
  1.  ;          COL BAT TO FACILITY -117 
  1.  ;          COL BAT TO UN-DIST -118
  1.  ;
  1.  ; IHS/SD/LSL - 09/23/02 - V1.6 Patch 3 - HIPAA
  1.  ;     Display PENDING and GENERAL INFORMATION (2 new Adjustment
  1.  ;     Categories) on the Transaction History.  These categories
  1.  ;     should not affect the balance.
  1.  ;
  1.  ; IHS/SD/LSL - 10/17/03 - V1.7 Patch 4 - HIPAA
  1.  ;      Display "e" next to transactions that were posted via Post
  1.  ;      ERA Claims.
  1.  ;
  1.  ; IHS/SD/LSL - 02/13/04 - V1.7 Patch 5 - Remark Codes
  1.  ;       Display Remark Code and NCPDP Reject/Payment codes
  1.  ;       on Transaction on history
  1.  ;       
  1.  ;IHS/SD/RLT - 02/15/05 - V1.8 Patch 1 - IM15887
  1.  ;       balances should not be affected by transaction
  1.  ;       types of PENDING or GENERAL INFORMATION but should always
  1.  ;       be displayed
  1.  ; *********************************************************************
  1.  ;
  1.  ;** List Detail command from posting command prompt
  1.  ;** lists details from a single bill
  1.  ;
  1.  ;
  1.  ;IHS/SD/POT JUL 2012 HEAT# 76003 ADDED TR IEN - BAR*1.8*23
  1.  ;IHS/SD/POT APR 2013 CONDITIONAL DISPLAY OF TXD AND MESSSAGES - BAR*1.8*23
  1.  ;IHS/SD/POT SEP 2013 FIXED INITIALS @ MESSAGES - BAR*1.8*23
  1.  ;IHS/SD/POT OCT 2013 WRAP AND POSITION LONG MESSAGES 10/24/2013  - BAR*1.8*23
  1.  ;IHS/SD/POT DEC 2013 ASSIGNED BARFLGRP="N" 12/12/13 DEFAULT VAL FOR EXT CALLS - BAR*1.8*23
  1.  ;IHS/SD/SDR belcourt HEAT118656 - BAR*1.8*24
  1.  ;IHS/SD/POT A/R P24 BETA: FIXING WRONGLY DISPLAYED TR TYPES 115,116,117,118 - BAR*1.8*24
  1. EN(BARBLDA) ; EP - Display bill history
  1.  ;
  1. EN1 ;
  1.  N DIC,DR,BARCL,BARHLP,BARCLV,BARCLIT,BARITV,BARPSAT,BARSITE,BARSPAR,BARUSR
  1.  N BARVSIT,BAREOV,BARBL,BARTRX,BARTR,BARBAL,BARX,BARQ,BARTRDA,BARBAL,BARPTA,BARMSG ; - BAR*1.8*23
  1.  I $G(BARFLGRP)="" S BARFLGRP="N" ;DEFAULT VAL FOR EXT CALLS  - BAR*1.8*23
  1.  S DR=".01;3;14;15;101;102;103;104;108"
  1.  S DIC=$$DIC^XBSFGBL(90050.01)
  1.  D ENP^XBDIQ1(DIC,BARBLDA,DR,"BARBL(","")
  1.  S BARBL(101,"I")=$$GET1^DIQ(90050.01,BARBLDA,101,"I")
  1.  ; -------------------------------
  1.  ;
  1. GETPT ;
  1.  I 'BARBL(101,"I") S BARBL(101,"I")=$G(BARPAT)
  1.  I 'BARBL(101,"I") D  G GETTX
  1.  .F BARJ=.111,.114,.115,.116,.131 S BARPTA(BARJ)=""
  1.  S DIC="^DPT("
  1.  S DR=".111;.114;.115;.116;.131"
  1.  D ENP^XBDIQ1(DIC,BARBL(101,"I"),DR,"BARPTA(","")
  1.  ; -------------------------------
  1.  ;
  1. GETTX ;
  1.  S DR="2;3;6;13;14;15;101;102;103;107;108;110;111;112"  ;BARHDR
  1.  S DIC=$$DIC^XBSFGBL(90050.03)
  1.  S BARTRDA=0
  1.  F  S BARTRDA=$O(^BARTR(DUZ(2),"AC",BARBLDA,BARTRDA)) Q:'BARTRDA  D
  1.  . I '$D(^BARTR(DUZ(2),BARTRDA)) K ^BARTR(DUZ(2),"AC",BARBLDA,BARTRDA) Q
  1.  . I $D(^BARTR(DUZ(2),"AM4",BARBLDA,BARTRDA)) I BARFLGRP="M"!(BARFLGRP="B")!(BARFLGRP="O") D  Q  ; - BAR*1.8*23
  1.  . . S BARMSG(BARTRDA)=""
  1.  . . S BARTRX(BARTRDA)="MESSAGE"
  1.  .S BARTEST=","_$P($G(^BARTR(DUZ(2),BARTRDA,1)),U)_","
  1.  . ;----start old code ---------------
  1.  . ;S BARTEST=BARTEST_$P($G(^BARTR(DUZ(2),BARTRDA,1)),U,2)_","  ;IHS/SD/SDR belcourt HEAT118656  - BAR*1.8*.24
  1.  . ; ;Q:BARTEST=",,"               ; No transaction type  ;IHS/SD/SDR belcourt HEAT118656 - BAR*1.8*.24
  1.  . ; Q:BARTEST=",,,"               ; No transaction type  ;IHS/SD/SDR belcourt HEAT118656 - BAR*1.8*.24
  1.  . ;I ",115,116,117,118,"[BARTEST Q
  1.  . ;--------new code-----------------
  1.  . I ",115,116,117,118,"[BARTEST Q
  1.  . I $P($G(^BARTR(DUZ(2),BARTRDA,1)),U)="" I $P($G(^BARTR(DUZ(2),BARTRDA,1)),U,2)="" QUIT  ;both [tr.type;adj cat] nil
  1.  .W "."
  1.  .D ENP^XBDIQ1(DIC,BARTRDA,DR,"BARTRX(","1")
  1.  .S BARTRX(BARTRDA,12)=$$GET1^DIQ(90050.03,BARTRDA,12,"I")
  1.  .S BARTRX(BARTRDA,13)=$$GET1^DIQ(90050.03,BARTRDA,13,"I")
  1.  .S BARTRX(BARTRDA,14,"I")=$$GET1^DIQ(90050.03,BARTRDA,14,"I") ;BARHDR
  1.  .S BARTRX(BARTRDA,15,"I")=$$GET1^DIQ(90050.03,BARTRDA,15,"I") ;
  1.  .S BARTRX(BARTRDA,106)=$$GET1^DIQ(90050.03,BARTRDA,106,"I")
  1.  .S BARTRX(BARTRDA,110)=$$GET1^DIQ(90050.03,BARTRDA,110,"I")  ;REVERSAL DATE;BARHDR
  1.  .S BARTRX(BARTRDA,111)=$$GET1^DIQ(90050.03,BARTRDA,111,"E")  ;SCHEDULE NUMBER/IPAC;BARHDR  ;IHS/SD/SDR BAR*1.8*6 4.2.3
  1.  .S BARTRX(BARTRDA,112)=$$GET1^DIQ(90050.03,BARTRDA,112,"E")  ;IGNORE FLAG; SCR80 4.1.1
  1.  .S BARTRX(BARTRDA,501)=$$GET1^DIQ(90050.03,BARTRDA,501,"E")  ;PAYMENT CREDIT APPLIED TO ;BAR*1.8*5 IHS/SD/TPF 6/17/2008
  1.  .S BARTRX(BARTRDA,502)=$$GET1^DIQ(90050.03,BARTRDA,502,"E")  ;PAYMENT CREDIT APPLIED FROM ;BAR*1.8*5 IHS/SD/TPF 6/17/2008
  1.   ;W !
  1.  D HEAD
  1.  S BARTRDA=0,BARBAL=0,BARQ=0,BARMCNT=0
  1.  F  S BARTRDA=$O(BARTRX(BARTRDA)) Q:'BARTRDA  D  Q:BARQ
  1.  . S BARQ=$$CHKLINE()
  1.  . Q:BARQ
  1.  . I BARFLGRP="M"!(BARFLGRP="B")!(BARFLGRP="O") I $D(BARMSG(BARTRDA)) D MESSAGE(BARTRDA) S BARMCNT=BARMCNT+1 Q  ; - BAR*1.8*23
  1.  . I $G(BARTRX(BARTRDA))="MESSAGE" Q
  1.  . I BARFLGRP="O" QUIT
  1.  . W !
  1.  . W $$SDT^BARDUTL($G(BARTRX(BARTRDA,12))) ;DT
  1.  . I $G(BARTRX(BARTRDA,13))'="" W ?11,$P($G(^VA(200,BARTRX(BARTRDA,13),0)),U,2) ;INITIALS
  1.  . S BARBATCH=$S($L($G(BARTRX(BARTRDA,14))):BARTRX(BARTRDA,14),1:"NO BATCH")
  1.  . S BARITEM=$S($L($G(BARTRX(BARTRDA,15))):BARTRX(BARTRDA,15),1:"")
  1.  . S:$G(BARTRX(BARTRDA,102))'="" BARTRX(BARTRDA,102)=$E(BARTRX(BARTRDA,102),1,19)_"/"_$E($G(BARTRX(BARTRDA,103)),1,19)  ;bar*1.8*20
  1.  . S BARTT=$S($G(BARTRX(BARTRDA,101))["REFUND":BARTRX(BARTRDA,101),$L($G(BARTRX(BARTRDA,102))):BARTRX(BARTRDA,102),1:$G(BARTRX(BARTRDA,101)))
  1.  . S BARPRE=""
  1.  . I BARTRX(BARTRDA,106)="e" S BARPRE="e "
  1.  . I BARTT["PENDING" S BARPRE="* "
  1.  . I BARTRX(BARTRDA,106)="e",BARTT["PENDING" S BARPRE="*e "
  1.  . S BARTT=BARPRE_BARTT
  1.   .W ?15,BARTT ;TRTYPE
  1.  . I BARTT["REMARK" W ?45,BARTRX(BARTRDA,107)
  1.  . I BARTT["NCPDP" W ?45,BARTRX(BARTRDA,108)
  1.  . S (BARX,X)=$S($G(BARTRX(BARTRDA,2)):-BARTRX(BARTRDA,2),1:$G(BARTRX(BARTRDA,3)))
  1.  . S X2=2
  1.  . S X3=11
  1.  . D COMMA^%DTC
  1.  . I BARTT["PENDING" S X="**"_X_"**"
  1.  . W ?54,X
  1.  . N X
  1.  . I BARTT'["PENDING"&(BARTT'["GENERAL") D
  1.  . . S BARBAL=BARBAL+BARX
  1.  . S X=BARBAL,X2=2,X3=11 D COMMA^%DTC
  1.  . W ?68,X
  1.  . W !
  1.  . W ?15,BARTRX(BARTRDA,6)          ; A/R Account
  1.  . W ?45,BARBATCH
  1.  . W ?67,$J(BARITEM,3,0)
  1.  . I BARTRX(BARTRDA,14,"I")'="",(BARTRX(BARTRDA,15,"I")'="") D
  1.  . .N IENS
  1.  . .S IENS=BARTRX(BARTRDA,15,"I")_","_BARTRX(BARTRDA,14,"I")_","
  1.  . .W !?15,$$GET1^DIQ(90051.1101,IENS,20,"E")  ;SCHEDULE #\IPAC
  1.  . .K IENS
  1.  . I BARTT["REMARK" D
  1.  . . S BARMKDSC=$$GET1^DIQ(90050.03,BARTRDA,"107:.02")
  1.  . . W !?15,$E(BARMKDSC,1,40)
  1.  . . I $L(BARMKDSC)>40 W !?15,$E(BARMKDSC,41,80)
  1.  . I BARTT["NCPDP" D
  1.  . . S BARNCPDP=$$GET1^DIQ(90050.03,BARTRDA,"108:.02")
  1.  . . W !?15,$E(BARNCPDP,1,40)
  1.  . . I $L(BARNCPDP)>40 W !?15,$E(BARNCPDP,41,80)
  1.  . I $G(BARTRX(BARTRDA,110)) D
  1.  . . S Y=BARTRX(BARTRDA,110) X ^DD("DD")
  1.  . . W !?5,"REVERSAL DATE: ",Y  ;BARHDR
  1.  . . W !?5,"REV TREASURY DEPOSIT NUMBER/IPAC: ",$G(BARTRX(BARTRDA,111))
  1.  . I $G(BARTRX(BARTRDA,112))]"" W !?15,BARTRX(BARTRDA,112)
  1.  . I BARTRX(BARTRDA,501)'="" W !?15,"PAYMENT CREDIT APPLIED TO: ",BARTRX(BARTRDA,501)
  1.  . I BARTRX(BARTRDA,502)'="" W !?15,"PAYMENT CREDIT APPLIED FROM: ",BARTRX(BARTRDA,502)
  1.  . I BARFLGRP="T"!(BARFLGRP="B") W !,?15,BARTRDA ; - BAR*1.8*23
  1.  Q:BARQ
  1.  I BARFLGRP="O",BARMCNT=0 W !!!,"NO MESSAGES FOUND.",!!
  1.  D EOP^BARUTL(1)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1.  W $$EN^BARVDF("IOF") ;,!
  1.  S X="List of Transactions for Bill "_BARBL(.01)
  1.  W ?80-$L(X)\2,X
  1.  W !!,"Patient: "_BARBL(101),?45,"Beg DOS : "_BARBL(102)
  1.  W !,"Address: "_$G(BARPTA(.111)),?45,"End DOS : "_BARBL(103)
  1.  W !,$G(BARPTA(.114))_", "_$G(BARPTA(.115))_" "_$G(BARPTA(.116))
  1.  W ?45,"LST STMT: "
  1.  W !!,"Phone #: "_$G(BARPTA(.131)),?45,"Insurer: "_$G(BARBL(3))
  1.  W !?45,"Balance: "_$J(BARBL(15),0,2)
  1.  W !!,"Trans Dt",?11,"By",?15,"Trans Type",?57,"Amount",?70,"Balance"
  1.  W !?15,"A/R Account",?45,"Batch",?67,"Item"
  1.  I BARFLGRP="T"!(BARFLGRP="B") W !?15,"Transaction #" ;,! ; - BAR*1.8*23
  1.  S BARDSH="",$P(BARDSH,"-",IOM)="" W !,BARDSH
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. CHKLINE() ;
  1.  ; Q 0 = CONTINUE
  1.  ; Q 1 = STOP
  1.  N X
  1.  I ($Y+4)<IOSL Q 0
  1.  I $E(IOST,1)="C" D  I 'Y Q 1
  1.  .W !?(IOM-15),"continued==>"
  1.  .D EOP^BARUTL(0)
  1.  D HEAD
  1.  Q 0
  1.  ;
  1. MESSAGE(BARTRDA) ;
  1.  ;^BARTR(DUZ(2),BARTRDA,10,0)="^^2^2^3120216"
  1.  ;^BARTR(DUZ(2),BARTRDA,10,1,0)="ORIGINAL ON 3120216.120259, GCN: 101126"
  1.  ;^BARTR(DUZ(2),BARTRDA,10,2,0)="REASON: "
  1.  N BARMSG1,BARMSG2,I,BARINIT,BARTXT,BARLINE,BAROK,BARST,BARWD
  1.  S BARWD=43-15-1,BARST=1
  1.  S BARINIT=$$SDT^BARDUTL(BARTRDA) ;DT
  1.  S BARMSG1=$P($G(^BARTR(DUZ(2),BARTRDA,10,0)),U,3)
  1.  S BARTXT=""
  1.  F I=1:1:BARMSG1 D  ;------------------10/24/13----- - BAR*1.8*23
  1.  . S BARLINE=$G(^BARTR(DUZ(2),BARTRDA,10,I,0))
  1.  . I BARLINE]"" S BARTXT=BARTXT_" "_BARLINE
  1.  F I=1:1 Q:$E(BARTXT)'=" "  S $E(BARTXT,1)=""
  1.  S BAROK=0 I BARTXT]"" D
  1.  . F I=1:1 D  Q:BAROK
  1.  . . S BARLINE=$E(BARTXT,BARST,BARST+BARWD)
  1.  . . I BARLINE="" S BAROK=1 Q
  1.  . . W !
  1.  . . I I=1 D
  1.  . . . W BARINIT
  1.  . . . W ?11,$$INITIALS(BARTRDA)
  1.  . . S BARST=BARST+BARWD+1
  1.  . . W ?15,BARLINE
  1.  I BARFLGRP="B" W !?15,BARTRDA ; - BAR*1.8*23
  1.  Q
  1. INITIALS(BARTRDA) ; - BAR*1.8*23
  1.  N BARTMP,BARTMP2,BARINIT
  1.  S BARTMP=$G(^BARTR(DUZ(2),BARTRDA,0)),BARINIT=$P(BARTMP,"^",13)
  1.  S BARTMP2=""
  1.  I BARINIT]"" S BARTMP2=$P($G(^VA(200,BARINIT,0)),U,2)
  1.  Q $E(BARTMP2,1,3)
  1.  ;-EOR-