Routine: BARDMAN3

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.

 ; ********************************************************************

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

 ; ********************************************************************

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

 ; ********************************************************************

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

 ; ********************************************************************

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

 ; ********************************************************************

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

BARDMAN3.m