- BAR50P10 ; IHS/SD/LSL - NEW REPORT ERA CLAIMS ;
- ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,20,21,22**;OCT 26,2005;Build 38
- ;
- ; IHS/SD/LSL - 10/1/03 - V1.7 Patch 4 - HIPAA
- ; Routine Created
- ;
- ; IHS/SD/LSL - 02/26/04 - V1.7 Patch 5
- ; Change check to chk/eft
- ;
- ; IHS/SD/RTL - 04/8/05 - V1.8 Patch 1
- ; Can't view check detail in ERA Claim Report
- ; IHS/SD/SDR - 1/5/2011 - V1.8 P20 - Included new status Exception (E)
- ;
- ; ********************************************************************
- ;;
- EN ; EP
- D DISP ; Display File and Check choice
- D INIT ; Initialize Variables
- F D Q:+BARDONE Q:($D(BARINDX)&$D(BARTYP)&$D(BARMEDIA))
- . D STATUS ; Ask which Claim status to report
- . Q:'$D(BARINDX)
- . F D Q:'$D(BARTYP) Q:($D(BARTYP)&$D(BARMEDIA))
- . . D RPTYP ; Ask report type
- . . Q:'$D(BARTYP)
- . . F D Q:$D(DIRUT) Q:$D(BARMEDIA) ; Ask Browse or print
- . . . D ASK
- I ('$D(BARINDX)!('$D(BARTYP))!('$D(BARMEDIA))) D Q
- . D PAZ^BARRUTL
- . D XIT
- D SETHDR ; Set up report header
- I BARMEDIA="B" D BROWSE
- E D PRINT
- ;D PAZ^BARRUTL
- D XIT
- Q
- ; ********************************************************************
- ;
- DISP ;
- ; Display File and Check Choices for report
- K IMP
- D ENP^XBDIQ1(90056.02,IMPDA,".01;.05","IMP(")
- W !,@IOF,!,"Reports for : ",?20,IMP(.01)
- W !,?20,IMP(.05),?50,"CHK/EFT #: ",$E(BARCHK,1,23)
- Q
- ; ********************************************************************
- INIT ;
- ;
- S BARDONE=0
- S BAR("PRIVACY")=1 ; Privacy act applies (used BARRHD)
- S $P(BARDASH,"-",81)=""
- S $P(BARSTAR,"*",81)=""
- F I=0,2 S BARCHK(I)=$G(^BARECHK(BARCKIEN,I))
- S BARZ("C")="CLAIM UNMATCHED"
- S BARZ("C","HDR")="= = = = = = = = = = = = C L A I M U N M A T C H E D = = = = = = = = = = ="
- S BARZ("P")="POSTED"
- S BARZ("P","HDR")="= = = = = = = = = = = = = = = = P O S T E D = = = = = = = = = = = = = = = ="
- S BARZ("M")="MATCHED"
- S BARZ("M","HDR")="= = = = = = = = = = = = = = = = M A T C H E D = = = = = = = = = = = = = = ="
- S BARZ("N")="NOT TO POST"
- S BARZ("N","HDR")="= = = = = = = = = = = = = = N O T T O P O S T = = = = = = = = = = = = ="
- S BARZ("X")="CLAIM & REASON UNMATCHED"
- S BARZ("X","HDR")="= = = = = = = C L A I M & R E A S O N U N M A T C H E D = = = = = = ="
- S BARZ("R")="REASON UNMATCHED"
- S BARZ("R","HDR")="= = = = = = = = = = = R E A S O N U N M A T C H E D = = = = = = = = = = ="
- ;start new code bar*1.8*20 REQ7
- S BARZ("E")="EXCEPTION"
- S BARZ("E","HDR")="= = = = = = = = = = = = = = = E X C E P T I O N= = = = = = = = = = = = = = ="
- ;end new code REQ7
- ;start new code bar*1.8*20
- S BARZ("W")="MATCHED W/REASON NOT TO POST"
- S BARZ("W","HDR")="= = = = = M A T C H E D W / R E A S O N N O T T O P O S T = = = = = ="
- ;end new code
- Q
- ; ********************************************************************
- ;
- STATUS ;
- ; Select claim status for reports
- W !!,"Enter the list of Claim Status(s) you desire to print,"
- W !,"and in the sequence to be printed out.",!
- W !,"C - Claim Unmatched",?25,"R - Reason Unmatched",?50,"N - Not to Post"
- W !,"M - Matched",?25,"P - Posted",?50,"X - Claim & Reason Unmatched"
- ;W !,"A - All Categories",!,?5,"Example: CRXN",! ;bar*1.8*20 REQ7
- W !,"A - All Categories",?25,"E - Exception",!,?5,"Example: CRXN",! ;bar*1.8*20 REQ7
- S BARBAD=0
- K DIR,BARINDX
- ;S DIR(0)="FO^0:6" ;bar*1.8*20 REQ7
- S DIR(0)="FO^0:7" ;bar*1.8*20 REQ7
- D ^DIR
- K DIR
- S Y=$$UPC^BARUTL(Y) ;bar*1.8*20
- I $L(Y)'>0 D Q
- . W !!,"NONE SELECTED - EXITING",!
- . S BARDONE=1
- I Y="^" S BARDONE=1 Q
- ;S Z="CRNMPX" ;bar*1.8*20 REQ7
- S Z="CRNMPXE" ;bar*1.8*20 REQ7
- I Y="A" S Y=Z
- ;S Z="CRNMPX" ;bar*1.8*20 REQ7
- S Z="CRNMPXE" ;bar*1.8*20 REQ7
- F I=1:1:$L(Y) I Z'[$E(Y,I) D Q
- . W !!,">>>BAD ENTRY<<<>>> ",Y
- . S BARBAD=1
- Q:+BARBAD
- S BARINDX=Y
- Q
- ; ********************************************************************
- ;
- RPTYP ;
- ; Select Report Type
- W !
- K DIR,BARTYP
- S DIR(0)="SOB^D:Detailed;B:Brief - One Line;S:Summary - Totals Only"
- S DIR("A")="Select the type of report: "
- D ^DIR
- K DIR
- I $D(DUOUT)!($D(DTOUT)) Q
- Q:(",D,B,S,"'[(","_Y_","))
- S BARTYP=Y
- S BARTYP("NAME")=Y(0)
- Q
- ; ********************************************************************
- ;
- ASK ;
- ; Ask Browse or Print
- K DIRUT,DIR,Y
- S Y=$$DIR^XBDIR("S^P:PRINT Output;B:BROWSE Output on Screen","Do you wish to ","P","","","",1)
- K DA
- Q:$D(DIRUT)
- S BARMEDIA=Y
- S BARMEDIA("NAME")=Y(0)
- Q
- ; ********************************************************************
- ;
- SETHDR ;
- ; Set up Report Header lines
- K BARPCIEN,BARPC,BARIIEN,BARAIEN
- ; Find payer contact.
- ; BARPC(Count)=#^type of number^name
- S BARPCIEN=0
- F S BARPCIEN=$O(^BARECHK(BARCKIEN,3,BARPCIEN)) Q:'+BARPCIEN D
- . S BARPC(BARPCIEN)=$G(^BARECHK(BARCKIEN,3,BARPCIEN,0))
- I '$D(BARPC) D
- . I $P(BARCHK(0),U,3)="" S BARPC(1)="" Q
- . I $P(BARCHK(0),U,4)="" S BARPC(1)="" Q
- . S BARAIEN=$P($G(^BARCOL(DUZ(2),$P(BARCHK(0),U,3),1,$P(BARCHK(0),U,4),0)),U,7)
- . I BARAIEN="" S BARPC(1)="" Q
- . S BARIIEN=$P($G(^BARAC(DUZ(2),BARAIEN,0)),U,1)
- . I BARIIEN'["AUTNINS" S BARPC(1)="" Q
- . S BARPC(1)=$P($G(^AUTNINS(+BARIIEN,0)),U,6)
- . I BARPC(1)="" S BARPC(1)="" Q
- . S $P(BARPC(1),U,3)=$P($G(^AUTNINS(+BARIIEN,0)),U,9)
- ;
- S BAR("HD",0)="ELECTRONIC CLAIM REPORT - "_$P(BARTYP("NAME")," ")
- S BARTMP="FOR FILE NAME: "_IMP(.05)
- D PAD
- ;S BAR("HD",1)=BARTMP_"CHECK/EFT TRACE: "_$E(BARCHK,1,12) ;bar*1.8*22 SDR
- S BAR("HD",1)=BARTMP_"CHECK/EFT TRACE: "_$E(BARCHK,1,20) ;bar*1.8*22 SDR
- ;BAR*1.8*1 SRS ADDENDUM FOR BAR*1.8*1
- S BARTMP=" "
- D PAD
- I $P(BARCHK(0),U,8)="XX" D
- .S BAR("HD",1.5)=BARTMP_" NPI: "_$P(BARCHK(0),U,9)
- E S BAR("HD",1.5)=BARTMP_" TIN: "_$P(BARCHK(0),U,11)
- ;END
- S BAR("HD",2)="FOR RPMS FILE: "_IMP(.01)_" FOR "_$P(BARCHK(0),U,7)
- S BAR("HD",3)=BARDASH
- S BARTMP=$$GET1^DIQ(90056.22,BARCKIEN,.03)
- S BARTMP="BATCH: "_$S(BARTMP="":"** No RPMS match **",1:BARTMP)
- D PAD
- S BAR("HD",4)=BARTMP_"ITEM # "_$P(BARCHK(0),U,4)
- S BAR("HD",5)=BARDASH
- ;
- S BARTMP=$P(BARCHK(2),U)
- D PAD
- S BAR("HD",6)=BARTMP ; Payer name (RA)
- S BARTMP=$P(BARCHK(2),U,2)
- D PAD
- S BAR("HD",7)=BARTMP ; Payer Address (RA)
- S BARLCNT=7
- I $P(BARCHK(2),U,3)]"" D
- . S BARLCNT=BARLCNT+1
- . S BARTMP=$P(BARCHK(2),U,3)
- . D PAD
- . S BAR("HD",BARLCNT)=BARTMP ; Payer address 2 (RA)
- S BARLCNT=BARLCNT+1
- I $P(BARCHK(2),U,6)'["-",$L($P(BARCHK(2),U,6))>5 S $P(BARCHK(2),U,6)=$E($P(BARCHK(2),U,6),1,5)_"-"_$E($P(BARCHK(2),U,6),6,9)
- S BARTMP=$P(BARCHK(2),U,4)_", "_$P(BARCHK(2),U,5)_" "_$P(BARCHK(2),U,6)
- D PAD
- S BAR("HD",BARLCNT)=BARTMP
- S BAR("LVL")=BARLCNT
- S I=$O(BARPC(0))
- Q:BARPC(I)="" ; No payer contact info
- S BAR("HD",6)=BAR("HD",6)_$S($P(BARPC(I),U,3)]"":$P(BARPC(I),U,3),1:"CUSTOMER SERVICE")
- K I,J,K
- S I=0
- S BARLCNT=6
- F S I=$O(BARPC(I)) Q:'+I!(BARLCNT>9) D
- . S BARLCNT=BARLCNT+1
- . S BARCTYP=$S($P(BARPC(I),U,2)="":"PH: ",$P(BARPC(I),U,2)="TE":"PH: ",$P(BARPC(I),U,2)="FX":"FX: ",1:"")
- . S $P(BARPC(I),U)=$TR($P(BARPC(I),U),")-","")
- . S BARTMP=$P(BARPC(I),U)
- . I (BARCTYP="PH: "!(BARCTYP="FX: ")) D
- . . I $L(BARTMP)=10 S $P(BARPC(I),U)="("_$E(BARTMP,1,3)_") "_$E(BARTMP,4,6)_"-"_$E(BARTMP,7,10)
- . . I $L(BARTMP)=7 S $P(BARPC(I),U)=$E(BARTMP,1,3)_"-"_$E(BARTMP,4,7)
- . I '$D(BAR("HD",BARLCNT)) D
- . . S BARTMP=" "
- . . D PAD
- . . S BAR("HD",BARLCNT)=BARTMP
- . S BAR("HD",BARLCNT)=BAR("HD",BARLCNT)_BARCTYP_$P(BARPC(I),U)
- I BARLCNT>BAR("LVL") S BAR("LVL")=BARLCNT
- Q
- ; ********************************************************************
- ;
- PAD ;
- ; Fixed undefined error in detail report.
- ; (Reported previously in IM17021.)
- ;K L
- N L,I ;IM17021
- S L=$L(BARTMP)
- ;F I=L:1:50 S BARTMP=BARTMP_" " ;bar*1.8*22 SDR
- F I=L:1:43 S BARTMP=BARTMP_" " ;bar*1.8*22 SDR
- ;K L,I ;IM17021
- Q
- ; ********************************************************************
- ;
- BROWSE ;
- ; Browse report to screen
- ; GET DEVICE (QUEUEING ALLOWED)
- S XBFLD("BROWSE")=1
- S BARIOSL=IOSL
- S IOSL=600
- D VIEWR^XBLM("PRINT^BAR50P11")
- D FULL^VALM1
- W $$EN^BARVDF("IOF")
- D CLEAR^VALM1 ;clears out all list man stuff
- K XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF
- K VALMCON,VALMDN,VALMEVL,VALMIOXY,VALMLFT,VALMLST,VALMMENU,VALMSGR,VALMUP
- K VALMY,XQORS,XQORSPEW,VALMCOFF
- S IOSL=BARIOSL
- Q
- ; ********************************************************************
- ;
- PRINT ;
- ; Print report to device. Queuing allowed.
- S BARQ("RC")="COMPUTE^BAREDP11" ; Build tmp global with data
- S BARQ("RP")="PRINT^BAREDP11" ; Print reports from tmp global
- S BARQ("NS")="BAR" ; Namespace for variables
- S ZTSAVE("IMPDA")=""
- S BARQ("RX")="POUT^BARRUTL" ; Clean-up routine
- D ^BARDBQUE ; Double queuing
- Q
- ; *********************************************************************
- ;
- XIT ;
- D ^BARVKL0
- Q
- BAR50P10 ; IHS/SD/LSL - NEW REPORT ERA CLAIMS ;
- +1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,20,21,22**;OCT 26,2005;Build 38
- +2 ;
- +3 ; IHS/SD/LSL - 10/1/03 - V1.7 Patch 4 - HIPAA
- +4 ; Routine Created
- +5 ;
- +6 ; IHS/SD/LSL - 02/26/04 - V1.7 Patch 5
- +7 ; Change check to chk/eft
- +8 ;
- +9 ; IHS/SD/RTL - 04/8/05 - V1.8 Patch 1
- +10 ; Can't view check detail in ERA Claim Report
- +11 ; IHS/SD/SDR - 1/5/2011 - V1.8 P20 - Included new status Exception (E)
- +12 ;
- +13 ; ********************************************************************
- +14 ;;
- EN ; EP
- +1 ; Display File and Check choice
- DO DISP
- +2 ; Initialize Variables
- DO INIT
- +3 FOR
- Begin DoDot:1
- +4 ; Ask which Claim status to report
- DO STATUS
- +5 IF '$DATA(BARINDX)
- QUIT
- +6 FOR
- Begin DoDot:2
- +7 ; Ask report type
- DO RPTYP
- +8 IF '$DATA(BARTYP)
- QUIT
- +9 ; Ask Browse or print
- FOR
- Begin DoDot:3
- +10 DO ASK
- End DoDot:3
- IF $DATA(DIRUT)
- QUIT
- IF $DATA(BARMEDIA)
- QUIT
- End DoDot:2
- IF '$DATA(BARTYP)
- QUIT
- IF ($DATA(BARTYP)&$DATA(BARMEDIA))
- QUIT
- End DoDot:1
- IF +BARDONE
- QUIT
- IF ($DATA(BARINDX)&$DATA(BARTYP)&$DATA(BARMEDIA))
- QUIT
- +11 IF ('$DATA(BARINDX)!('$DATA(BARTYP))!('$DATA(BARMEDIA)))
- Begin DoDot:1
- +12 DO PAZ^BARRUTL
- +13 DO XIT
- End DoDot:1
- QUIT
- +14 ; Set up report header
- DO SETHDR
- +15 IF BARMEDIA="B"
- DO BROWSE
- +16 IF '$TEST
- DO PRINT
- +17 ;D PAZ^BARRUTL
- +18 DO XIT
- +19 QUIT
- +20 ; ********************************************************************
- +21 ;
- DISP ;
- +1 ; Display File and Check Choices for report
- +2 KILL IMP
- +3 DO ENP^XBDIQ1(90056.02,IMPDA,".01;.05","IMP(")
- +4 WRITE !,@IOF,!,"Reports for : ",?20,IMP(.01)
- +5 WRITE !,?20,IMP(.05),?50,"CHK/EFT #: ",$EXTRACT(BARCHK,1,23)
- +6 QUIT
- +7 ; ********************************************************************
- INIT ;
- +1 ;
- +2 SET BARDONE=0
- +3 ; Privacy act applies (used BARRHD)
- SET BAR("PRIVACY")=1
- +4 SET $PIECE(BARDASH,"-",81)=""
- +5 SET $PIECE(BARSTAR,"*",81)=""
- +6 FOR I=0,2
- SET BARCHK(I)=$GET(^BARECHK(BARCKIEN,I))
- +7 SET BARZ("C")="CLAIM UNMATCHED"
- +8 SET BARZ("C","HDR")="= = = = = = = = = = = = C L A I M U N M A T C H E D = = = = = = = = = = ="
- +9 SET BARZ("P")="POSTED"
- +10 SET BARZ("P","HDR")="= = = = = = = = = = = = = = = = P O S T E D = = = = = = = = = = = = = = = ="
- +11 SET BARZ("M")="MATCHED"
- +12 SET BARZ("M","HDR")="= = = = = = = = = = = = = = = = M A T C H E D = = = = = = = = = = = = = = ="
- +13 SET BARZ("N")="NOT TO POST"
- +14 SET BARZ("N","HDR")="= = = = = = = = = = = = = = N O T T O P O S T = = = = = = = = = = = = ="
- +15 SET BARZ("X")="CLAIM & REASON UNMATCHED"
- +16 SET BARZ("X","HDR")="= = = = = = = C L A I M & R E A S O N U N M A T C H E D = = = = = = ="
- +17 SET BARZ("R")="REASON UNMATCHED"
- +18 SET BARZ("R","HDR")="= = = = = = = = = = = R E A S O N U N M A T C H E D = = = = = = = = = = ="
- +19 ;start new code bar*1.8*20 REQ7
- +20 SET BARZ("E")="EXCEPTION"
- +21 SET BARZ("E","HDR")="= = = = = = = = = = = = = = = E X C E P T I O N= = = = = = = = = = = = = = ="
- +22 ;end new code REQ7
- +23 ;start new code bar*1.8*20
- +24 SET BARZ("W")="MATCHED W/REASON NOT TO POST"
- +25 SET BARZ("W","HDR")="= = = = = M A T C H E D W / R E A S O N N O T T O P O S T = = = = = ="
- +26 ;end new code
- +27 QUIT
- +28 ; ********************************************************************
- +29 ;
- STATUS ;
- +1 ; Select claim status for reports
- +2 WRITE !!,"Enter the list of Claim Status(s) you desire to print,"
- +3 WRITE !,"and in the sequence to be printed out.",!
- +4 WRITE !,"C - Claim Unmatched",?25,"R - Reason Unmatched",?50,"N - Not to Post"
- +5 WRITE !,"M - Matched",?25,"P - Posted",?50,"X - Claim & Reason Unmatched"
- +6 ;W !,"A - All Categories",!,?5,"Example: CRXN",! ;bar*1.8*20 REQ7
- +7 ;bar*1.8*20 REQ7
- WRITE !,"A - All Categories",?25,"E - Exception",!,?5,"Example: CRXN",!
- +8 SET BARBAD=0
- +9 KILL DIR,BARINDX
- +10 ;S DIR(0)="FO^0:6" ;bar*1.8*20 REQ7
- +11 ;bar*1.8*20 REQ7
- SET DIR(0)="FO^0:7"
- +12 DO ^DIR
- +13 KILL DIR
- +14 ;bar*1.8*20
- SET Y=$$UPC^BARUTL(Y)
- +15 IF $LENGTH(Y)'>0
- Begin DoDot:1
- +16 WRITE !!,"NONE SELECTED - EXITING",!
- +17 SET BARDONE=1
- End DoDot:1
- QUIT
- +18 IF Y="^"
- SET BARDONE=1
- QUIT
- +19 ;S Z="CRNMPX" ;bar*1.8*20 REQ7
- +20 ;bar*1.8*20 REQ7
- SET Z="CRNMPXE"
- +21 IF Y="A"
- SET Y=Z
- +22 ;S Z="CRNMPX" ;bar*1.8*20 REQ7
- +23 ;bar*1.8*20 REQ7
- SET Z="CRNMPXE"
- +24 FOR I=1:1:$LENGTH(Y)
- IF Z'[$EXTRACT(Y,I)
- Begin DoDot:1
- +25 WRITE !!,">>>BAD ENTRY<<<>>> ",Y
- +26 SET BARBAD=1
- End DoDot:1
- QUIT
- +27 IF +BARBAD
- QUIT
- +28 SET BARINDX=Y
- +29 QUIT
- +30 ; ********************************************************************
- +31 ;
- RPTYP ;
- +1 ; Select Report Type
- +2 WRITE !
- +3 KILL DIR,BARTYP
- +4 SET DIR(0)="SOB^D:Detailed;B:Brief - One Line;S:Summary - Totals Only"
- +5 SET DIR("A")="Select the type of report: "
- +6 DO ^DIR
- +7 KILL DIR
- +8 IF $DATA(DUOUT)!($DATA(DTOUT))
- QUIT
- +9 IF (",D,B,S,"'[(","_Y_","))
- QUIT
- +10 SET BARTYP=Y
- +11 SET BARTYP("NAME")=Y(0)
- +12 QUIT
- +13 ; ********************************************************************
- +14 ;
- ASK ;
- +1 ; Ask Browse or Print
- +2 KILL DIRUT,DIR,Y
- +3 SET Y=$$DIR^XBDIR("S^P:PRINT Output;B:BROWSE Output on Screen","Do you wish to ","P","","","",1)
- +4 KILL DA
- +5 IF $DATA(DIRUT)
- QUIT
- +6 SET BARMEDIA=Y
- +7 SET BARMEDIA("NAME")=Y(0)
- +8 QUIT
- +9 ; ********************************************************************
- +10 ;
- SETHDR ;
- +1 ; Set up Report Header lines
- +2 KILL BARPCIEN,BARPC,BARIIEN,BARAIEN
- +3 ; Find payer contact.
- +4 ; BARPC(Count)=#^type of number^name
- +5 SET BARPCIEN=0
- +6 FOR
- SET BARPCIEN=$ORDER(^BARECHK(BARCKIEN,3,BARPCIEN))
- IF '+BARPCIEN
- QUIT
- Begin DoDot:1
- +7 SET BARPC(BARPCIEN)=$GET(^BARECHK(BARCKIEN,3,BARPCIEN,0))
- End DoDot:1
- +8 IF '$DATA(BARPC)
- Begin DoDot:1
- +9 IF $PIECE(BARCHK(0),U,3)=""
- SET BARPC(1)=""
- QUIT
- +10 IF $PIECE(BARCHK(0),U,4)=""
- SET BARPC(1)=""
- QUIT
- +11 SET BARAIEN=$PIECE($GET(^BARCOL(DUZ(2),$PIECE(BARCHK(0),U,3),1,$PIECE(BARCHK(0),U,4),0)),U,7)
- +12 IF BARAIEN=""
- SET BARPC(1)=""
- QUIT
- +13 SET BARIIEN=$PIECE($GET(^BARAC(DUZ(2),BARAIEN,0)),U,1)
- +14 IF BARIIEN'["AUTNINS"
- SET BARPC(1)=""
- QUIT
- +15 SET BARPC(1)=$PIECE($GET(^AUTNINS(+BARIIEN,0)),U,6)
- +16 IF BARPC(1)=""
- SET BARPC(1)=""
- QUIT
- +17 SET $PIECE(BARPC(1),U,3)=$PIECE($GET(^AUTNINS(+BARIIEN,0)),U,9)
- End DoDot:1
- +18 ;
- +19 SET BAR("HD",0)="ELECTRONIC CLAIM REPORT - "_$PIECE(BARTYP("NAME")," ")
- +20 SET BARTMP="FOR FILE NAME: "_IMP(.05)
- +21 DO PAD
- +22 ;S BAR("HD",1)=BARTMP_"CHECK/EFT TRACE: "_$E(BARCHK,1,12) ;bar*1.8*22 SDR
- +23 ;bar*1.8*22 SDR
- SET BAR("HD",1)=BARTMP_"CHECK/EFT TRACE: "_$EXTRACT(BARCHK,1,20)
- +24 ;BAR*1.8*1 SRS ADDENDUM FOR BAR*1.8*1
- +25 SET BARTMP=" "
- +26 DO PAD
- +27 IF $PIECE(BARCHK(0),U,8)="XX"
- Begin DoDot:1
- +28 SET BAR("HD",1.5)=BARTMP_" NPI: "_$PIECE(BARCHK(0),U,9)
- End DoDot:1
- +29 IF '$TEST
- SET BAR("HD",1.5)=BARTMP_" TIN: "_$PIECE(BARCHK(0),U,11)
- +30 ;END
- +31 SET BAR("HD",2)="FOR RPMS FILE: "_IMP(.01)_" FOR "_$PIECE(BARCHK(0),U,7)
- +32 SET BAR("HD",3)=BARDASH
- +33 SET BARTMP=$$GET1^DIQ(90056.22,BARCKIEN,.03)
- +34 SET BARTMP="BATCH: "_$SELECT(BARTMP="":"** No RPMS match **",1:BARTMP)
- +35 DO PAD
- +36 SET BAR("HD",4)=BARTMP_"ITEM # "_$PIECE(BARCHK(0),U,4)
- +37 SET BAR("HD",5)=BARDASH
- +38 ;
- +39 SET BARTMP=$PIECE(BARCHK(2),U)
- +40 DO PAD
- +41 ; Payer name (RA)
- SET BAR("HD",6)=BARTMP
- +42 SET BARTMP=$PIECE(BARCHK(2),U,2)
- +43 DO PAD
- +44 ; Payer Address (RA)
- SET BAR("HD",7)=BARTMP
- +45 SET BARLCNT=7
- +46 IF $PIECE(BARCHK(2),U,3)]""
- Begin DoDot:1
- +47 SET BARLCNT=BARLCNT+1
- +48 SET BARTMP=$PIECE(BARCHK(2),U,3)
- +49 DO PAD
- +50 ; Payer address 2 (RA)
- SET BAR("HD",BARLCNT)=BARTMP
- End DoDot:1
- +51 SET BARLCNT=BARLCNT+1
- +52 IF $PIECE(BARCHK(2),U,6)'["-"
- IF $LENGTH($PIECE(BARCHK(2),U,6))>5
- SET $PIECE(BARCHK(2),U,6)=$EXTRACT($PIECE(BARCHK(2),U,6),1,5)_"-"_$EXTRACT($PIECE(BARCHK(2),U,6),6,9)
- +53 SET BARTMP=$PIECE(BARCHK(2),U,4)_", "_$PIECE(BARCHK(2),U,5)_" "_$PIECE(BARCHK(2),U,6)
- +54 DO PAD
- +55 SET BAR("HD",BARLCNT)=BARTMP
- +56 SET BAR("LVL")=BARLCNT
- +57 SET I=$ORDER(BARPC(0))
- +58 ; No payer contact info
- IF BARPC(I)=""
- QUIT
- +59 SET BAR("HD",6)=BAR("HD",6)_$SELECT($PIECE(BARPC(I),U,3)]"":$PIECE(BARPC(I),U,3),1:"CUSTOMER SERVICE")
- +60 KILL I,J,K
- +61 SET I=0
- +62 SET BARLCNT=6
- +63 FOR
- SET I=$ORDER(BARPC(I))
- IF '+I!(BARLCNT>9)
- QUIT
- Begin DoDot:1
- +64 SET BARLCNT=BARLCNT+1
- +65 SET BARCTYP=$SELECT($PIECE(BARPC(I),U,2)="":"PH: ",$PIECE(BARPC(I),U,2)="TE":"PH: ",$PIECE(BARPC(I),U,2)="FX":"FX: ",1:"")
- +66 SET $PIECE(BARPC(I),U)=$TRANSLATE($PIECE(BARPC(I),U),")-","")
- +67 SET BARTMP=$PIECE(BARPC(I),U)
- +68 IF (BARCTYP="PH: "!(BARCTYP="FX: "))
- Begin DoDot:2
- +69 IF $LENGTH(BARTMP)=10
- SET $PIECE(BARPC(I),U)="("_$EXTRACT(BARTMP,1,3)_") "_$EXTRACT(BARTMP,4,6)_"-"_$EXTRACT(BARTMP,7,10)
- +70 IF $LENGTH(BARTMP)=7
- SET $PIECE(BARPC(I),U)=$EXTRACT(BARTMP,1,3)_"-"_$EXTRACT(BARTMP,4,7)
- End DoDot:2
- +71 IF '$DATA(BAR("HD",BARLCNT))
- Begin DoDot:2
- +72 SET BARTMP=" "
- +73 DO PAD
- +74 SET BAR("HD",BARLCNT)=BARTMP
- End DoDot:2
- +75 SET BAR("HD",BARLCNT)=BAR("HD",BARLCNT)_BARCTYP_$PIECE(BARPC(I),U)
- End DoDot:1
- +76 IF BARLCNT>BAR("LVL")
- SET BAR("LVL")=BARLCNT
- +77 QUIT
- +78 ; ********************************************************************
- +79 ;
- PAD ;
- +1 ; Fixed undefined error in detail report.
- +2 ; (Reported previously in IM17021.)
- +3 ;K L
- +4 ;IM17021
- NEW L,I
- +5 SET L=$LENGTH(BARTMP)
- +6 ;F I=L:1:50 S BARTMP=BARTMP_" " ;bar*1.8*22 SDR
- +7 ;bar*1.8*22 SDR
- FOR I=L:1:43
- SET BARTMP=BARTMP_" "
- +8 ;K L,I ;IM17021
- +9 QUIT
- +10 ; ********************************************************************
- +11 ;
- BROWSE ;
- +1 ; Browse report to screen
- +2 ; GET DEVICE (QUEUEING ALLOWED)
- +3 SET XBFLD("BROWSE")=1
- +4 SET BARIOSL=IOSL
- +5 SET IOSL=600
- +6 DO VIEWR^XBLM("PRINT^BAR50P11")
- +7 DO FULL^VALM1
- +8 WRITE $$EN^BARVDF("IOF")
- +9 ;clears out all list man stuff
- DO CLEAR^VALM1
- +10 KILL XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF
- +11 KILL VALMCON,VALMDN,VALMEVL,VALMIOXY,VALMLFT,VALMLST,VALMMENU,VALMSGR,VALMUP
- +12 KILL VALMY,XQORS,XQORSPEW,VALMCOFF
- +13 SET IOSL=BARIOSL
- +14 QUIT
- +15 ; ********************************************************************
- +16 ;
- PRINT ;
- +1 ; Print report to device. Queuing allowed.
- +2 ; Build tmp global with data
- SET BARQ("RC")="COMPUTE^BAREDP11"
- +3 ; Print reports from tmp global
- SET BARQ("RP")="PRINT^BAREDP11"
- +4 ; Namespace for variables
- SET BARQ("NS")="BAR"
- +5 SET ZTSAVE("IMPDA")=""
- +6 ; Clean-up routine
- SET BARQ("RX")="POUT^BARRUTL"
- +7 ; Double queuing
- DO ^BARDBQUE
- +8 QUIT
- +9 ; *********************************************************************
- +10 ;
- XIT ;
- +1 DO ^BARVKL0
- +2 QUIT
