BARDMAN3 ; IHS/SD/LSL - A/R Debt Collection Process (3) ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;
; IHS/SD/LSL - 04/08/2004 - V1.8
; Routine created. Moved (modified) from BBMDC2
; All entry points called from BARDMAN2. Creates one of four
; temporary globals containing records of data for that file type.
;
; ********************************************************************
Q
;
SSELFILE ; EP
; Build temp global of self pay stops records
; ------------------------------------------------
; File layout
; ---------------
; 1 - 5 Client Number TSI Assigned Number
; 6 - 25 Transmittal number (AR bill - strip dashes)
; 26 - 26 Code (5=Paid, 1=Cancel, A=adjusted)
; 27 - 34 New Balance (AR Bill balance)
; ------------------------------------------------
;
I $L(BARBLNM)<21 S BARBLNM=$$LJ(BARBLNM,20)
E S BARBLNM=$E(BARBLNM,1,20)
;
I $L(BARBAL)<9 S BARBAL=$$PAD(BARBAL,8)
;
S ^BARSSELF($J,BARBL)=BARSNUM
S ^BARSSELF($J,BARBL)=^BARSSELF($J,BARBL)_BARBLNM
S ^BARSSELF($J,BARBL)=^BARSSELF($J,BARBL)_BARACT
S ^BARSSELF($J,BARBL)=^BARSSELF($J,BARBL)_BARBAL
Q
; ********************************************************************
;
SINSFILE ; EP
; Build temp global of insurer stops records
; ------------------------------------------------
; File layout
; ---------------
; 1 - 5 Client Number TSI Assigned Number
; 6 - 25 Transmittal number (AR bill - strip dashes)
; 26 - 26 Code (5=Paid, 1=Cancel, A=adjusted)
; 27 - 34 New Balance (AR Bill balance)
; ------------------------------------------------
;
I $L(BARBLNM)<21 S BARBLNM=$$LJ(BARBLNM,20)
E S BARBLNM=$E(BARBLNM,1,20)
;
I $L(BARBAL)<9 S BARBAL=$$PAD(BARBAL,8)
;
S ^BARSTOPS($J,BARBL)=BARINUM
S ^BARSTOPS($J,BARBL)=^BARSTOPS($J,BARBL)_BARBLNM
S ^BARSTOPS($J,BARBL)=^BARSTOPS($J,BARBL)_BARACT
S ^BARSTOPS($J,BARBL)=^BARSTOPS($J,BARBL)_BARBAL
Q
; ********************************************************************
;
TSELFILE ; EP
; Build temp global of self pay starts records
; ------------------------------------------------
; File layout
; ---------------
; 1 - 5 Client Number TSI Assigned Number
; 6 - 35 Patient Name (Last, First I)
; 36 - 65 Optional Address (If 2 line street addr)
; 66 - 95 Street Address
; 96 - 110 City
; 111 - 112 State
; 113 - 117 Zip Code
; 118 - 118 Service code (always 1)
; 119 - 138 Transmittal Number (AR bill - strip dashes)
; 139 - 144 Date last pay/charge (use DOS)
; 145 - 152 Amount Due
; ------------------------------------------------
;
S BARPAT=$$GET1^DIQ(90050.01,BARBL,101)
S BARPAT=$P(BARPAT,",")_", "_$P(BARPAT,",",2)
S BARPAT=$TR(BARPAT,".","")
S BARPAT=$$LJ(BARPAT,30)
;
S BARPTIEN=$$GET1^DIQ(90050.01,BARBL,101,"I")
S BARADDR=$$LJ($$GET1^DIQ(2,BARPTIEN,.111),30)
S BARADDR2=$$GET1^DIQ(2,BARPTIEN,.112)
I BARADDR2]"" S BARADDR2=$$LJ(BARADDR2,30)
;
S BARCITY=$$LJ($$GET1^DIQ(2,BARPTIEN,.114),15)
S BARSTATE=$$GET1^DIQ(2,BARPTIEN,".115:1")
S BARZIP=$$GET1^DIQ(2,BARPTIEN,.116)
S:BARZIP="" BARZIP="00000"
;
I $L(BARBLNM)<21 S BARBLNM=$$LJ(BARBLNM,20)
E S BARBLNM=$E(BARBLNM,1,20)
;
I +BARDOS S BARDOS=$E(BARDOS,4,7)_$E($E(BARDOS,1,3)+1700,3,4)
E S BARDOS=" "
;
S BARCHRG=$P($G(^BARTSELF(DUZ(2),BARBL,0)),U,13)
S BARX=$P(BARCHRG,".")_"."_$P(BARCHRG,".",2)_"00"
S BARCHRG=$P(BARX,".")_$E($P(BARX,".",2),1,2)
I $L(BARCHRG)<9 S BARCHRG=$$PAD(BARCHRG,8)
I $L(BARBAL)<9 S BARBAL=$$PAD(BARBAL,8)
;
S $P(BARSP," ",31)=""
;
S ^BARTSELF($J,BARBL)=BARSNUM
S ^BARTSELF($J,BARBL)=^BARTSELF($J,BARBL)_BARPAT
S ^BARTSELF($J,BARBL)=^BARTSELF($J,BARBL)_$S($L($TR(BARADDR2," ",""))>0:BARADDR,1:BARSP)
S ^BARTSELF($J,BARBL)=^BARTSELF($J,BARBL)_$S($L($TR(BARADDR2," ",""))>0:BARADDR2,1:BARADDR)
S ^BARTSELF($J,BARBL)=^BARTSELF($J,BARBL)_BARCITY
S ^BARTSELF($J,BARBL)=^BARTSELF($J,BARBL)_BARSTATE
S ^BARTSELF($J,BARBL)=^BARTSELF($J,BARBL)_BARZIP
S ^BARTSELF($J,BARBL)=^BARTSELF($J,BARBL)_1
S ^BARTSELF($J,BARBL)=^BARTSELF($J,BARBL)_BARBLNM
S ^BARTSELF($J,BARBL)=^BARTSELF($J,BARBL)_BARDOS
S ^BARTSELF($J,BARBL)=^BARTSELF($J,BARBL)_BARBAL
Q
; ********************************************************************
;
TINSFILE ; EP
; Build temp global of insurer starts records
; ------------------------------------------------
; File layout
; ---------------
; 1 - 5 Client Number TSI Assigned Number
; 6 - 35 Insurance Company Name (AR Account)
; 36 - 65 Optional Address
; 66 - 95 Street Address
; 96 - 110 City
; 111 - 112 State
; 113 - 117 Zip Code
; 118 - 121 Zip Code Extension
; 122 - 151 Policy Number
; 152 - 171 Claim Number (AR Bill - with dashes)
; 172 - 201 Insured's Name
; 202 - 210 Insured's SS #
; 211 - 240 Patient Name
; 241 - 260 Transmittal Number (AR Bill - strip dashes)
; 261 - 261 Service Code (1)
; 262 - 267 Date of Service (MMDDYY)
; 268 - 275 Charges
; 276 - 281 Date of Service 2 (MMDDYY)
; 282 - 289 Charges 2
; 290 - 295 Date of Service 3 (MMDDYY)
; 296 - 303 Charges 3
; 304 - 309 Date of Service 4 (MMDDYY)
; 310 - 317 Charges 4
; 318 - 323 Date of Service 5 (MMDDYY)
; 324 - 331 Charges 5
;
; Dates of service 2-5 are not sent, zero fill
; Charges 2-5 are not sent, zero fill
; ------------------------------------------------
;
K ABMP
S BARINSN=$$LJ($$GET1^DIQ(90050.01,BARBL,3),30)
S BARIIEN=$$GET1^DIQ(90050.01,BARBL,"3:1.001")
S BARIADDR=$$LJ($$GET1^DIQ(9999999.18,BARIIEN,.02),30)
S BARICITY=$$LJ($$GET1^DIQ(9999999.18,BARIIEN,.03),15)
S BARIST=$$GET1^DIQ(9999999.18,BARIIEN,".04:1")
S BARIZIP=$$GET1^DIQ(9999999.18,BARIIEN,.05)
I BARIZIP["-" S BARZEXT=$P(BARIZIP,"-",2)
S BARIZIP=$P(BARIZIP,"-")
S:$G(BARZEXT)="" BARZEXT="0000"
S:BARIZIP="" BARIZIP="00000"
;
D SBR^BARUTL(DUZ(2),BARBL) ; Get policy holder info
S BARPOLN=$G(ABMP("PNUM"))
S:BARPOLN="" BARPOLN=$$GET1^DIQ(90050.01,BARBL,702)
S BARPOLN=$$LJ(BARPOLN,30)
S BARPLNM=$$LNM^ABMUTLN($P(BARSBR,"-"),$P(BARSBR,"-",2))
S BARPFNM=$$FNM^ABMUTLN($P(BARSBR,"-"),$P(BARSBR,"-",2))
S BARPMI=$$MI^ABMUTLN($P(BARSBR,"-"),$P(BARSBR,"-",2))
I BARPLNM]"" S BARPNAM=BARPLNM_", "_BARPFNM_" "_BARPMI
E S BARPNAM=$$GET1^DIQ(90050.01,BARBL,701)
S BARPNAM=$$LJ(BARPNAM,30)
;
S BARPAT=$$GET1^DIQ(90050.01,BARBL,101)
S BARPAT=$P(BARPAT,",")_", "_$P(BARPAT,",",2)
S BARPAT=$TR(BARPAT,".","")
S BARPAT=$$LJ(BARPAT,30)
;
;bill number with dashes - claim number
I $L(BARBLNMD)<21 S BARBLNMD=$$LJ(BARBLNMD,20)
E S BARBLNMD=$E(BARBLNMD,1,20)
;
;bill number strip dashes - transmittal number
I $L(BARBLNM)<21 S BARBLNM=$$LJ(BARBLNM,20)
E S BARBLNM=$E(BARBLNM,1,20)
;
I +BARDOS S BARDOS=$E(BARDOS,4,7)_$E($E(BARDOS,1,3)+1700,3,4)
E S BARDOS="000000"
;
S BARCHRG=$P($G(^BARBL(DUZ(2),BARBL,0)),U,13)
S BARX=$P(BARCHRG,".")_"."_$P(BARCHRG,".",2)_"00"
S BARCHRG=$P(BARX,".")_$E($P(BARX,".",2),1,2)
I $L(BARCHRG)<9 S BARCHRG=$$PAD(BARCHRG,8)
;
S $P(BARSP," ",31)=""
S $P(BARDOSFL,"0",7)=""
S $P(BARCHGFL,"0",9)=""
;
S ^BARSTART($J,BARBL)=BARINUM
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARINSN
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARSP
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARIADDR
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARICITY
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARIST
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARIZIP
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARZEXT
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARPOLN
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARBLNMD
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARPNAM
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_" "
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARPAT
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARBLNM
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_1
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARDOS
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARCHRG
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARDOSFL
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARCHGFL
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARDOSFL
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARCHGFL
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARDOSFL
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARCHGFL
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARDOSFL
S ^BARSTART($J,BARBL)=^BARSTART($J,BARBL)_BARCHGFL
Q
; ********************************************************************
;
PAD(BARVAR,BARLNG) ; EP
; Right justify, zero fill value BARVAR for length BARLNG
K BARZERO
S $P(BARZERO,"0",BARLNG+1)=""
S BARVAR=BARZERO_BARVAR
S BARVAR=$E(BARVAR,$L(BARVAR)-(BARLNG-1),$L(BARVAR))
Q BARVAR
; ********************************************************************
;
LJ(BARVAR,BARLNG) ; EP
; Left justify, space fill value BARVAR for length BARLNG
I $L(BARVAR)>(BARLNG-1) D Q BARVAR
. S BARVAR=$E(BARVAR,1,BARLNG)
S $P(BARSPACE," ",BARLNG+1)=""
S BARVAR=BARVAR_BARSPACE
S BARVAR=$E(BARVAR,1,BARLNG)
Q BARVAR
BARDMAN3 ; IHS/SD/LSL - A/R Debt Collection Process (3) ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;
+3 ; IHS/SD/LSL - 04/08/2004 - V1.8
+4 ; Routine created. Moved (modified) from BBMDC2
+5 ; All entry points called from BARDMAN2. Creates one of four
+6 ; temporary globals containing records of data for that file type.
+7 ;
+8 ; ********************************************************************
+9 QUIT
+10 ;
SSELFILE ; EP
+1 ; Build temp global of self pay stops records
+2 ; ------------------------------------------------
+3 ; File layout
+4 ; ---------------
+5 ; 1 - 5 Client Number TSI Assigned Number
+6 ; 6 - 25 Transmittal number (AR bill - strip dashes)
+7 ; 26 - 26 Code (5=Paid, 1=Cancel, A=adjusted)
+8 ; 27 - 34 New Balance (AR Bill balance)
+9 ; ------------------------------------------------
+10 ;
+11 IF $LENGTH(BARBLNM)<21
SET BARBLNM=$$LJ(BARBLNM,20)
+12 IF '$TEST
SET BARBLNM=$EXTRACT(BARBLNM,1,20)
+13 ;
+14 IF $LENGTH(BARBAL)<9
SET BARBAL=$$PAD(BARBAL,8)
+15 ;
+16 SET ^BARSSELF($JOB,BARBL)=BARSNUM
+17 SET ^BARSSELF($JOB,BARBL)=^BARSSELF($JOB,BARBL)_BARBLNM
+18 SET ^BARSSELF($JOB,BARBL)=^BARSSELF($JOB,BARBL)_BARACT
+19 SET ^BARSSELF($JOB,BARBL)=^BARSSELF($JOB,BARBL)_BARBAL
+20 QUIT
+21 ; ********************************************************************
+22 ;
SINSFILE ; EP
+1 ; Build temp global of insurer stops records
+2 ; ------------------------------------------------
+3 ; File layout
+4 ; ---------------
+5 ; 1 - 5 Client Number TSI Assigned Number
+6 ; 6 - 25 Transmittal number (AR bill - strip dashes)
+7 ; 26 - 26 Code (5=Paid, 1=Cancel, A=adjusted)
+8 ; 27 - 34 New Balance (AR Bill balance)
+9 ; ------------------------------------------------
+10 ;
+11 IF $LENGTH(BARBLNM)<21
SET BARBLNM=$$LJ(BARBLNM,20)
+12 IF '$TEST
SET BARBLNM=$EXTRACT(BARBLNM,1,20)
+13 ;
+14 IF $LENGTH(BARBAL)<9
SET BARBAL=$$PAD(BARBAL,8)
+15 ;
+16 SET ^BARSTOPS($JOB,BARBL)=BARINUM
+17 SET ^BARSTOPS($JOB,BARBL)=^BARSTOPS($JOB,BARBL)_BARBLNM
+18 SET ^BARSTOPS($JOB,BARBL)=^BARSTOPS($JOB,BARBL)_BARACT
+19 SET ^BARSTOPS($JOB,BARBL)=^BARSTOPS($JOB,BARBL)_BARBAL
+20 QUIT
+21 ; ********************************************************************
+22 ;
TSELFILE ; EP
+1 ; Build temp global of self pay starts records
+2 ; ------------------------------------------------
+3 ; File layout
+4 ; ---------------
+5 ; 1 - 5 Client Number TSI Assigned Number
+6 ; 6 - 35 Patient Name (Last, First I)
+7 ; 36 - 65 Optional Address (If 2 line street addr)
+8 ; 66 - 95 Street Address
+9 ; 96 - 110 City
+10 ; 111 - 112 State
+11 ; 113 - 117 Zip Code
+12 ; 118 - 118 Service code (always 1)
+13 ; 119 - 138 Transmittal Number (AR bill - strip dashes)
+14 ; 139 - 144 Date last pay/charge (use DOS)
+15 ; 145 - 152 Amount Due
+16 ; ------------------------------------------------
+17 ;
+18 SET BARPAT=$$GET1^DIQ(90050.01,BARBL,101)
+19 SET BARPAT=$PIECE(BARPAT,",")_", "_$PIECE(BARPAT,",",2)
+20 SET BARPAT=$TRANSLATE(BARPAT,".","")
+21 SET BARPAT=$$LJ(BARPAT,30)
+22 ;
+23 SET BARPTIEN=$$GET1^DIQ(90050.01,BARBL,101,"I")
+24 SET BARADDR=$$LJ($$GET1^DIQ(2,BARPTIEN,.111),30)
+25 SET BARADDR2=$$GET1^DIQ(2,BARPTIEN,.112)
+26 IF BARADDR2]""
SET BARADDR2=$$LJ(BARADDR2,30)
+27 ;
+28 SET BARCITY=$$LJ($$GET1^DIQ(2,BARPTIEN,.114),15)
+29 SET BARSTATE=$$GET1^DIQ(2,BARPTIEN,".115:1")
+30 SET BARZIP=$$GET1^DIQ(2,BARPTIEN,.116)
+31 IF BARZIP=""
SET BARZIP="00000"
+32 ;
+33 IF $LENGTH(BARBLNM)<21
SET BARBLNM=$$LJ(BARBLNM,20)
+34 IF '$TEST
SET BARBLNM=$EXTRACT(BARBLNM,1,20)
+35 ;
+36 IF +BARDOS
SET BARDOS=$EXTRACT(BARDOS,4,7)_$EXTRACT($EXTRACT(BARDOS,1,3)+1700,3,4)
+37 IF '$TEST
SET BARDOS=" "
+38 ;
+39 SET BARCHRG=$PIECE($GET(^BARTSELF(DUZ(2),BARBL,0)),U,13)
+40 SET BARX=$PIECE(BARCHRG,".")_"."_$PIECE(BARCHRG,".",2)_"00"
+41 SET BARCHRG=$PIECE(BARX,".")_$EXTRACT($PIECE(BARX,".",2),1,2)
+42 IF $LENGTH(BARCHRG)<9
SET BARCHRG=$$PAD(BARCHRG,8)
+43 IF $LENGTH(BARBAL)<9
SET BARBAL=$$PAD(BARBAL,8)
+44 ;
+45 SET $PIECE(BARSP," ",31)=""
+46 ;
+47 SET ^BARTSELF($JOB,BARBL)=BARSNUM
+48 SET ^BARTSELF($JOB,BARBL)=^BARTSELF($JOB,BARBL)_BARPAT
+49 SET ^BARTSELF($JOB,BARBL)=^BARTSELF($JOB,BARBL)_$SELECT($LENGTH($TRANSLATE(BARADDR2," ",""))>0:BARADDR,1:BARSP)
+50 SET ^BARTSELF($JOB,BARBL)=^BARTSELF($JOB,BARBL)_$SELECT($LENGTH($TRANSLATE(BARADDR2," ",""))>0:BARADDR2,1:BARADDR)
+51 SET ^BARTSELF($JOB,BARBL)=^BARTSELF($JOB,BARBL)_BARCITY
+52 SET ^BARTSELF($JOB,BARBL)=^BARTSELF($JOB,BARBL)_BARSTATE
+53 SET ^BARTSELF($JOB,BARBL)=^BARTSELF($JOB,BARBL)_BARZIP
+54 SET ^BARTSELF($JOB,BARBL)=^BARTSELF($JOB,BARBL)_1
+55 SET ^BARTSELF($JOB,BARBL)=^BARTSELF($JOB,BARBL)_BARBLNM
+56 SET ^BARTSELF($JOB,BARBL)=^BARTSELF($JOB,BARBL)_BARDOS
+57 SET ^BARTSELF($JOB,BARBL)=^BARTSELF($JOB,BARBL)_BARBAL
+58 QUIT
+59 ; ********************************************************************
+60 ;
TINSFILE ; EP
+1 ; Build temp global of insurer starts records
+2 ; ------------------------------------------------
+3 ; File layout
+4 ; ---------------
+5 ; 1 - 5 Client Number TSI Assigned Number
+6 ; 6 - 35 Insurance Company Name (AR Account)
+7 ; 36 - 65 Optional Address
+8 ; 66 - 95 Street Address
+9 ; 96 - 110 City
+10 ; 111 - 112 State
+11 ; 113 - 117 Zip Code
+12 ; 118 - 121 Zip Code Extension
+13 ; 122 - 151 Policy Number
+14 ; 152 - 171 Claim Number (AR Bill - with dashes)
+15 ; 172 - 201 Insured's Name
+16 ; 202 - 210 Insured's SS #
+17 ; 211 - 240 Patient Name
+18 ; 241 - 260 Transmittal Number (AR Bill - strip dashes)
+19 ; 261 - 261 Service Code (1)
+20 ; 262 - 267 Date of Service (MMDDYY)
+21 ; 268 - 275 Charges
+22 ; 276 - 281 Date of Service 2 (MMDDYY)
+23 ; 282 - 289 Charges 2
+24 ; 290 - 295 Date of Service 3 (MMDDYY)
+25 ; 296 - 303 Charges 3
+26 ; 304 - 309 Date of Service 4 (MMDDYY)
+27 ; 310 - 317 Charges 4
+28 ; 318 - 323 Date of Service 5 (MMDDYY)
+29 ; 324 - 331 Charges 5
+30 ;
+31 ; Dates of service 2-5 are not sent, zero fill
+32 ; Charges 2-5 are not sent, zero fill
+33 ; ------------------------------------------------
+34 ;
+35 KILL ABMP
+36 SET BARINSN=$$LJ($$GET1^DIQ(90050.01,BARBL,3),30)
+37 SET BARIIEN=$$GET1^DIQ(90050.01,BARBL,"3:1.001")
+38 SET BARIADDR=$$LJ($$GET1^DIQ(9999999.18,BARIIEN,.02),30)
+39 SET BARICITY=$$LJ($$GET1^DIQ(9999999.18,BARIIEN,.03),15)
+40 SET BARIST=$$GET1^DIQ(9999999.18,BARIIEN,".04:1")
+41 SET BARIZIP=$$GET1^DIQ(9999999.18,BARIIEN,.05)
+42 IF BARIZIP["-"
SET BARZEXT=$PIECE(BARIZIP,"-",2)
+43 SET BARIZIP=$PIECE(BARIZIP,"-")
+44 IF $GET(BARZEXT)=""
SET BARZEXT="0000"
+45 IF BARIZIP=""
SET BARIZIP="00000"
+46 ;
+47 ; Get policy holder info
DO SBR^BARUTL(DUZ(2),BARBL)
+48 SET BARPOLN=$GET(ABMP("PNUM"))
+49 IF BARPOLN=""
SET BARPOLN=$$GET1^DIQ(90050.01,BARBL,702)
+50 SET BARPOLN=$$LJ(BARPOLN,30)
+51 SET BARPLNM=$$LNM^ABMUTLN($PIECE(BARSBR,"-"),$PIECE(BARSBR,"-",2))
+52 SET BARPFNM=$$FNM^ABMUTLN($PIECE(BARSBR,"-"),$PIECE(BARSBR,"-",2))
+53 SET BARPMI=$$MI^ABMUTLN($PIECE(BARSBR,"-"),$PIECE(BARSBR,"-",2))
+54 IF BARPLNM]""
SET BARPNAM=BARPLNM_", "_BARPFNM_" "_BARPMI
+55 IF '$TEST
SET BARPNAM=$$GET1^DIQ(90050.01,BARBL,701)
+56 SET BARPNAM=$$LJ(BARPNAM,30)
+57 ;
+58 SET BARPAT=$$GET1^DIQ(90050.01,BARBL,101)
+59 SET BARPAT=$PIECE(BARPAT,",")_", "_$PIECE(BARPAT,",",2)
+60 SET BARPAT=$TRANSLATE(BARPAT,".","")
+61 SET BARPAT=$$LJ(BARPAT,30)
+62 ;
+63 ;bill number with dashes - claim number
+64 IF $LENGTH(BARBLNMD)<21
SET BARBLNMD=$$LJ(BARBLNMD,20)
+65 IF '$TEST
SET BARBLNMD=$EXTRACT(BARBLNMD,1,20)
+66 ;
+67 ;bill number strip dashes - transmittal number
+68 IF $LENGTH(BARBLNM)<21
SET BARBLNM=$$LJ(BARBLNM,20)
+69 IF '$TEST
SET BARBLNM=$EXTRACT(BARBLNM,1,20)
+70 ;
+71 IF +BARDOS
SET BARDOS=$EXTRACT(BARDOS,4,7)_$EXTRACT($EXTRACT(BARDOS,1,3)+1700,3,4)
+72 IF '$TEST
SET BARDOS="000000"
+73 ;
+74 SET BARCHRG=$PIECE($GET(^BARBL(DUZ(2),BARBL,0)),U,13)
+75 SET BARX=$PIECE(BARCHRG,".")_"."_$PIECE(BARCHRG,".",2)_"00"
+76 SET BARCHRG=$PIECE(BARX,".")_$EXTRACT($PIECE(BARX,".",2),1,2)
+77 IF $LENGTH(BARCHRG)<9
SET BARCHRG=$$PAD(BARCHRG,8)
+78 ;
+79 SET $PIECE(BARSP," ",31)=""
+80 SET $PIECE(BARDOSFL,"0",7)=""
+81 SET $PIECE(BARCHGFL,"0",9)=""
+82 ;
+83 SET ^BARSTART($JOB,BARBL)=BARINUM
+84 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARINSN
+85 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARSP
+86 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARIADDR
+87 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARICITY
+88 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARIST
+89 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARIZIP
+90 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARZEXT
+91 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARPOLN
+92 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARBLNMD
+93 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARPNAM
+94 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_" "
+95 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARPAT
+96 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARBLNM
+97 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_1
+98 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARDOS
+99 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARCHRG
+100 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARDOSFL
+101 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARCHGFL
+102 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARDOSFL
+103 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARCHGFL
+104 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARDOSFL
+105 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARCHGFL
+106 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARDOSFL
+107 SET ^BARSTART($JOB,BARBL)=^BARSTART($JOB,BARBL)_BARCHGFL
+108 QUIT
+109 ; ********************************************************************
+110 ;
PAD(BARVAR,BARLNG) ; EP
+1 ; Right justify, zero fill value BARVAR for length BARLNG
+2 KILL BARZERO
+3 SET $PIECE(BARZERO,"0",BARLNG+1)=""
+4 SET BARVAR=BARZERO_BARVAR
+5 SET BARVAR=$EXTRACT(BARVAR,$LENGTH(BARVAR)-(BARLNG-1),$LENGTH(BARVAR))
+6 QUIT BARVAR
+7 ; ********************************************************************
+8 ;
LJ(BARVAR,BARLNG) ; EP
+1 ; Left justify, space fill value BARVAR for length BARLNG
+2 IF $LENGTH(BARVAR)>(BARLNG-1)
Begin DoDot:1
+3 SET BARVAR=$EXTRACT(BARVAR,1,BARLNG)
End DoDot:1
QUIT BARVAR
+4 SET $PIECE(BARSPACE," ",BARLNG+1)=""
+5 SET BARVAR=BARVAR_BARSPACE
+6 SET BARVAR=$EXTRACT(BARVAR,1,BARLNG)
+7 QUIT BARVAR
