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

BPSOSHF.m

Go to the documentation of this file.
  1. BPSOSHF ;BHAM ISC/SD/lwj/DLF - Get/Format/Set value for repeating segments ;06/01/2004
  1. ;;1.0;E CLAIMS MGMT ENGINE;**1,5,8,10,11,23,24**;JUN 2004;Build 43
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; This routine is an addendum to BPSOSCF. Its purpose is to handle
  1. ; some of the repeating fields that now exist in NCPDP 5.1.
  1. ; The logic was put in here rather than BPSOSCF to keep the original
  1. ; routine (BPSOSCF) from growing too large and too cumbersome to
  1. ; maintain.
  1. ;
  1. DURPPS(FORMAT,NODE,MEDN) ;EP called from BPSOSCF
  1. ;
  1. ; First order of business - check the BPS("RX",MEDN,"DUR") array
  1. ; for values - if there aren't any, we don't need to write this
  1. ; segment
  1. ;
  1. N FIELD,DUR,FLD,OVERRIDE,FLAG,ORD,FLDIEN,FLDNUM,FLDNUMB,FOUND
  1. S FLAG="FS"
  1. ;
  1. Q:'$D(BPS("RX",MEDN,"DUR"))
  1. ;
  1. ; Next we need to figure out which fields on this format are really
  1. ; needed, then we will loop through and populate them
  1. ;
  1. D GETFLDS(FORMAT,NODE,.FIELD)
  1. ;
  1. ; Now lets get, format and set the field
  1. S (ORD,DUR)=0
  1. F S DUR=$O(BPS("RX",MEDN,"DUR",DUR)) Q:DUR="" D
  1. . S FLDNUM="" F S FLDNUM=$O(BPS("RX",MEDN,"DUR",DUR,FLDNUM)) Q:FLDNUM="" D
  1. .. S ORD="",FOUND=0
  1. .. F S ORD=$O(FIELD(ORD)) Q:ORD="" D Q:FOUND
  1. ... S FLDNUMB="",FLDNUMB=$P(FIELD(ORD),U,2) Q:FLDNUMB'=FLDNUM
  1. ... S FLDIEN="",FLDIEN=$P(FIELD(ORD),U)
  1. ... S BPS("X")=BPS("RX",MEDN,"DUR",DUR,FLDNUM)
  1. ... S FOUND=1
  1. ... D XFLDCODE^BPSOSCF(NODE,FLDIEN,FLAG) ;format/set
  1. Q
  1. ;
  1. COB(FORMAT,NODE,MEDN) ; COB fields processing, NODE=160
  1. ;---------------------------------------------------------------
  1. ; The COB data is stored in the following local array:
  1. ;
  1. ; BPS("RX",MEDN,"OTHER PAYER",.....
  1. ;
  1. ; Array built in routine BPSOSCD.
  1. ; Special note - Overrides are not allowed on this multiple.
  1. ; "Special" code is not accounted for either.
  1. ;---------------------------------------------------------------
  1. ;
  1. N FIELD,FLD,OVERRIDE,FLAG,ORD,NCPFLD,BPD,BPD1,BPD2,PCE,BPSOPIEN,BPSOAIEN,BPSORIEN,BPSCOUNT
  1. S FLAG="FS"
  1. ;
  1. ; Quit if there is no data in the array
  1. Q:'$D(BPS("RX",MEDN,"OTHER PAYER"))
  1. ;
  1. ; next we need to figure out which fields on this format are really
  1. ; needed, then we will loop through and populate them
  1. ;
  1. D GETFLDS(FORMAT,NODE,.FIELD)
  1. ;
  1. ; re-sort this list by the NCPDP field#
  1. ; NCPFLD(NCPDP FIELD#) = internal field#
  1. K NCPFLD S ORD=0 F S ORD=$O(FIELD(ORD)) Q:'ORD S FLD=$P(FIELD(ORD),U,2) I FLD'="" S NCPFLD(FLD)=+FIELD(ORD)
  1. ;
  1. ; see if 337-4C is needed
  1. S FLD=337
  1. I $D(NCPFLD(FLD)) D
  1. . S BPS("X")=$P($G(BPS("RX",MEDN,"OTHER PAYER",0)),U,1) ; get
  1. . I BPS("X")="" Q
  1. . D XFLDCODE^BPSOSCF(NODE,NCPFLD(FLD),FLAG) ; format/set
  1. . Q
  1. ;
  1. ; now lets get, format and set the rest of the COB fields
  1. S BPSOPIEN=0 F S BPSOPIEN=$O(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN)) Q:'BPSOPIEN D
  1. . S BPD=$G(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,0))
  1. . ; Note that piece 9 (Benefit Stage Count) is only set by Certification Code
  1. . F PCE=1:1:7,9,11 D
  1. .. S FLD=$S(PCE=1:337,PCE=2:338,PCE=3:339,PCE=4:340,PCE=5:443,PCE=6:341,PCE=7:471,PCE=9:392,PCE=11:2149,1:0) Q:'FLD
  1. .. I '$D(NCPFLD(FLD)) Q ; field not needed
  1. .. I $P(BPD,U,PCE)="" Q ; data is nil
  1. .. S BPS("X")=$P(BPD,U,PCE) ; get
  1. .. D XFLDCODE^BPSOSCF(NODE,NCPFLD(FLD),FLAG) ; format/set
  1. .. Q
  1. . ;
  1. . ; Now look at the other payer amount paid fields
  1. . S BPSOAIEN=0 F S BPSOAIEN=$O(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,"P",BPSOAIEN)) Q:'BPSOAIEN D
  1. .. S BPD1=$G(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,"P",BPSOAIEN,0))
  1. .. F PCE=1,2 D
  1. ... S FLD=$S(PCE=1:431,PCE=2:342,1:0) Q:'FLD
  1. ... I '$D(NCPFLD(FLD)) Q ; field not needed
  1. ... I $P(BPD1,U,PCE)="" Q ; data is nil
  1. ... S BPS("X")=$P(BPD1,U,PCE) ; get
  1. ... D XFLDCODE^BPSOSCF(NODE,NCPFLD(FLD),FLAG) ; format/set
  1. .. Q
  1. . ;
  1. . ; Now look at the other payer reject code fields
  1. . S BPSORIEN=0 F S BPSORIEN=$O(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,"R",BPSORIEN)) Q:'BPSORIEN D
  1. .. S BPD2=$G(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,"R",BPSORIEN,0))
  1. .. S FLD=472
  1. .. I '$D(NCPFLD(FLD)) Q ; field not needed
  1. .. I BPD2="" Q ; data is nil
  1. .. S BPS("X")=BPD2 ; get
  1. .. D XFLDCODE^BPSOSCF(NODE,NCPFLD(FLD),FLAG) ; format/set
  1. .. Q
  1. . ;
  1. . ; Now look at the other payer-patient amount paid fields
  1. . S BPSCOUNT=0 ; initialize counter
  1. . S BPSOAIEN=0 F S BPSOAIEN=$O(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,"PP",BPSOAIEN)) Q:'BPSOAIEN D
  1. .. S BPD1=$G(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,"PP",BPSOAIEN,0))
  1. .. ;
  1. .. ; Field 352-NQ = OTHER PAYER-PAT RESP AMOUNT
  1. .. I '$D(NCPFLD(352)) Q ; fields not needed
  1. .. I '+$P(BPD1,U,1) Q ; data is nil or zero
  1. .. S BPSCOUNT=BPSCOUNT+1 ; increment counter
  1. .. S BPS("X")=$P(BPD1,U,1) ; get
  1. .. D XFLDCODE^BPSOSCF(NODE,NCPFLD(352),FLAG) ; format/set
  1. .. ;
  1. .. ; If Field 352 is populated, then populate 351 and 353.
  1. .. ;
  1. .. ; Field 351-NP = OTHER PAYER-PAT RESP AMT QLFR
  1. .. S BPS("X")=$P(BPD1,U,2) ; get
  1. .. D XFLDCODE^BPSOSCF(NODE,NCPFLD(351),FLAG) ; format/set
  1. .. ;
  1. .. ; Field 353-NR = OTHER PAYER-PAT RESP AMT CNT
  1. .. S BPS("X")=BPSCOUNT ; get
  1. .. D XFLDCODE^BPSOSCF(NODE,NCPFLD(353),FLAG) ; format/set
  1. .. Q
  1. . ;
  1. . ; Now look at the Benefit Stages fields
  1. . ; Currently, this multiple is only set by certification code
  1. . S BPSOAIEN=0 F S BPSOAIEN=$O(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,"BS",BPSOAIEN)) Q:'BPSOAIEN D
  1. .. S BPD1=$G(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,"BS",BPSOAIEN,0))
  1. .. F PCE=1,2 D
  1. ... S FLD=$S(PCE=1:394,PCE=2:393,1:0) Q:'FLD
  1. ... I '$D(NCPFLD(FLD)) Q ; field not needed
  1. ... I $P(BPD1,U,PCE)="" Q ; data is nil
  1. ... S BPS("X")=$P(BPD1,U,PCE) ; get
  1. ... D XFLDCODE^BPSOSCF(NODE,NCPFLD(FLD),FLAG) ; format/set
  1. .. Q
  1. . Q
  1. ;
  1. COBX ;
  1. Q
  1. ;
  1. GETFLDS(FORMAT,NODE,FIELD) ;EP NCPDP 5.1
  1. ;---------------------------------------------------------------
  1. ;This routine will get the list of repeating fields that must be
  1. ; be worked with separately
  1. ; (This was originally coded for the DUR/PPS segment - I'm not
  1. ; 100% sure how and if it will work for the other repeating
  1. ; fields that exist within a segment.)
  1. ;---------------------------------------------------------------
  1. ; Coming in:
  1. ; FORMAT = BPSF(9002313.92 's format IEN
  1. ; NODE = which segment we are processing (i.e. 180 - DUR/PPS)
  1. ; .FIELD = array to store the values in
  1. ;
  1. ; Exitting:
  1. ; .FIELD array will look like:
  1. ; FIELD(ord)=int^ext
  1. ; Where: ext = external field number from BPSF(9002313.91
  1. ; int = internal field number from BPSF(9002313.91
  1. ; ord = the order of the field - used in creating clm
  1. ;---------------------------------------------------------------
  1. ;
  1. N ORDER,RECMIEN,MDATA,FLDIEN,FLDNUM,DUR
  1. ;
  1. S ORDER=0
  1. ;
  1. F D Q:'ORDER
  1. . ;
  1. . ; let's order through the format file for this node
  1. . S ORDER=$O(^BPSF(9002313.92,FORMAT,NODE,"B",ORDER)) Q:'ORDER
  1. . S RECMIEN=$O(^BPSF(9002313.92,FORMAT,NODE,"B",ORDER,0))
  1. . I 'RECMIEN D IMPOSS^BPSOSUE("DB","TI","NODE="_NODE,"ORDER="_ORDER,2,$T(+0))
  1. . S MDATA=^BPSF(9002313.92,FORMAT,NODE,RECMIEN,0)
  1. . S FLDIEN=$P(MDATA,U,2)
  1. . I 'FLDIEN D IMPOSS^BPSOSUE("DB","TI","NODE="_NODE,"RECMIEN="_RECMIEN,3,$T(+0)) ; corrupt or erroneous format file
  1. . I '$D(^BPSF(9002313.91,FLDIEN,0)) D IMPOSS^BPSOSUE("DB,P","TI","FLDIEN="_FLDIEN,,"DURPPS",$T(+0)) ;incomplete field definition
  1. . ;
  1. . ;lets create a list of fields we need
  1. . S FLDNUM=$P($G(^BPSF(9002313.91,FLDIEN,0)),U)
  1. . S:FLDNUM'=111 FIELD(ORDER)=FLDIEN_"^"_FLDNUM
  1. Q