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

ABSPOSH2.m

Go to the documentation of this file. 
  1. ABSPOSH2 ; IHS/SD/lwj - Assemble frmted claim for 5.1 ;[ 08/22/2002  2:05 PM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3,11,17,23**;JUN 21, 2001;Build 38
  1.  ;---
  1.  ; This routine is a clone of ABSPECA2.  While ABSPECA2 will put
  1.  ; together the ascii formatted record for 3.2 claims, this routine
  1.  ; will put together the ascii formatted record for 5.1 claims.
  1.  ; 
  1.  ; Within 5.1 there were some major changes in the creation of the
  1.  ; claim.  Of significant importance are these:
  1.  ;    3.2 had 4 claim segments (hdr req, hdr opt, det req, det opt) 
  1.  ;    5.1 has 14 claim segments (header, patient, insurance, claim
  1.  ;                                pharmacy provider, prescriber,
  1.  ;                                COB, workers comp, DUR, Pricing,
  1.  ;                                coupon, compound, prior auth,
  1.  ;                                clinical)    
  1.  ;
  1.  ;    3.2 required only field identifiers and separtors on optional
  1.  ;        fields        
  1.  ;    5.1 requires field identifiers and separators on all fields
  1.  ;        other than the header
  1.  ;
  1.  ;    3.2 there were no segment separators
  1.  ;    5.1 segment separators are required prior to each segment
  1.  ;        following the header
  1.  ;
  1.  ;    3.2/5.1  Group seperators appear at the end of each
  1.  ;        transaction (prescription)
  1.  ;                                           
  1.  ;    5.1 we only want to send segments that have data - a new 
  1.  ;        segment record will hold the data until we are sure 
  1.  ;        we have something to send
  1.  ;
  1.  ;---
  1.  ;Put together ascii formatted record via NCPDP Record definition
  1.  ;
  1.  ;Input Variables:  NODES     - (100^110^120 or 
  1.  ;                               130^140^150^160^170^180^190^
  1.  ;                               200^210^220^230)
  1.  ;                  .IEN      - Internal Entry Number array
  1.  ;                  .ABSP     - Formatted Data Array with claim and
  1.  ;                              prescription data
  1.  ;                  .REC      - Formatted Ascii record (result)
  1.  ;---
  1.  ;IHS/SD/lwj 4/28/04 patch 11  - Oregon Medicaid can no longer handle
  1.  ; blank values on the DUR record - logic altered to exclude blank flds
  1.  ;---
  1.  ;IHS/SD/RLT - 05/01/06 - Patch 17
  1.  ; Allow for double zeros in fields 440 and 441.
  1.  ;---
  1.  ;IHS/SD/RLT - 06/27/07 - 10/18/07 - Patch 23
  1.  ; DIAGNOSIS CODE in CLINICAL Segment.
  1.  ;---
  1. XLOOP(NODES,IEN,ABSP,REC) ;EP - from ABSPECA1
  1.  ;Manage local variables
  1.  N ORDER,RECMIEN,MDATA,FLDIEN,PMODE,FLAG,NODE,FDATA,FLDNUM,FLDDATA
  1.  N INDEX,FLDID
  1.  N SEGREC,DATAFND,FDATA5
  1.  ;
  1.  ;
  1.  ;Loop through the NODES defined in NODES variable parsed by U
  1.  F INDEX=1:1:$L(NODES,U) D
  1.  .S NODE=$P(NODES,U,INDEX)
  1.  .Q:NODE=""
  1.  .Q:'$D(^ABSPF(9002313.92,IEN(9002313.92),NODE,0))
  1.  .;
  1.  .S DATAFND=0  ;indicates if data is on the segment for us to send
  1.  .S SEGREC=""  ;holds the segment's information
  1.  .;
  1.  . D:NODE=180 PROCDUR
  1.  . D:NODE=230 PROCDIAG       ;Patch 23
  1.  .;
  1.  .S ORDER=""
  1.  .F  D  Q:'ORDER
  1.  ..;
  1.  ..Q:NODE=180    ;already had to process the DUR/PPS section (repeating)
  1.  ..Q:NODE=230    ;Patch 23
  1.  ..S ORDER=$O(^ABSPF(9002313.92,IEN(9002313.92),NODE,"B",ORDER))
  1.  ..Q:'ORDER
  1.  ..S RECMIEN=""
  1.  ..S RECMIEN=$O(^ABSPF(9002313.92,IEN(9002313.92),NODE,"B",ORDER,RECMIEN))
  1.  ..Q:RECMIEN=""
  1.  ..;
  1.  ..S MDATA=$G(^ABSPF(9002313.92,IEN(9002313.92),NODE,RECMIEN,0))
  1.  ..Q:MDATA=""
  1.  ..;
  1.  ..S FLDIEN=$P(MDATA,U,2)
  1.  ..Q:FLDIEN=""
  1.  ..;
  1.  ..S FDATA=$G(^ABSPF(9002313.91,FLDIEN,0))
  1.  ..Q:FDATA=""
  1.  ..S FLDNUM=$P(FDATA,U,1)
  1.  ..Q:FLDNUM=""
  1.  ..;
  1.  ..S FDATA5=$G(^ABSPF(9002313.91,FLDIEN,5))   ;5.1 id and length
  1.  ..S FLDID=$P(FDATA5,U,1)         ;5.1 ID
  1.  ..;
  1.  ..;header data
  1.  ..S:NODE<130 FLDDATA=$G(ABSP(9002313.02,IEN(9002313.02),FLDNUM,"I"))
  1.  ..; 
  1.  ..;transaction data
  1.  ..S:NODE>120 FLDDATA=$G(ABSP(9002313.0201,IEN(9002313.01),FLDNUM,"I"))
  1.  ..;
  1.  ..I FLDID'=$TR(FLDDATA,"0 {}") S DATAFND=1 ;fld chk-is the field empty?
  1.  ..;
  1.  ..;check if this is the seg id - call this after fld chk since 
  1.  ..;we don't want to send the segment if this is all there is
  1.  ..I (NODE>100)&(FLDNUM=111) S FLDDATA=$$SEGID(NODE)
  1.  ..;
  1.  ..S:NODE=100 SEGREC=SEGREC_FLDDATA  ;no FS on the header rec
  1.  ..S:NODE>100 SEGREC=SEGREC_$C(28)_FLDDATA  ;FS always proceeds fld
  1.  ..;
  1.  .;
  1.  . I (DATAFND)&(NODE=100) S REC=SEGREC   ;no SS when it's the header
  1.  . I (DATAFND)&(NODE>100) S REC=REC_$C(30)_SEGREC  ;SS before the seg
  1.  ;
  1.  Q
  1.  ;
  1. SEGID(ND) ; Field 111 is the Segment Identifier - for each segment, other than
  1.  ; the header, a pre-defined, unique value must be sent in this field
  1.  ; to identify which segment is being sent.  This value is not stored
  1.  ; in the claim - as it changes with each of the 13 segments. The
  1.  ; field does appear as part of the NCPCP Format, put is simply not
  1.  ; stored.
  1.  ;    01 = Patient   02 = Pharmacy Provider    03 = Prescriber
  1.  ;    04 = Insurance 05 = COB/Other Payment    06 = Workers Comp
  1.  ;    07 = Claim     08 = DUR/PPS              09 = Coupon
  1.  ;    10 = Compound  11 = Pricing              12 = Prior Auth
  1.  ;    13 = Clinical
  1.  ;
  1.  N FLD
  1.  ;
  1.  S FLD=$S(ND=110:"01",ND=120:"04",ND=130:"07",ND=140:"02",ND=150:"03",ND=160:"05",ND=170:"06",ND=180:"08",ND=190:11,ND=200:"09",ND=210:10,ND=220:12,ND=230:13,1:"00")
  1.  S FLD="AM"_$$NFF^ABSPECFM(FLD,2)
  1.  ;
  1.  Q FLD
  1.  ;
  1. PROCDUR ;NCPDP 5.1 - The DUR/PPS segment can repeat itself for any given
  1.  ; transaction within a claim.  This means we have to have special
  1.  ; programming to handle the repeating fields.  
  1.  ;
  1.  N FIELD,DUR,FLD
  1.  ;
  1.  ; if there isn't any data in this segment, then lets quit
  1.  Q:'$D(ABSP(9002313.1001))
  1.  ;
  1.  ; second thing - create the 111 field entry as it is not repeating
  1.  S FLDDATA=$$SEGID(NODE)
  1.  S SEGREC=SEGREC_$C(28)_FLDDATA  ;FS always proceeds fld
  1.  ;
  1.  ; next- let's look to the format to see which DUR/PPS fields are 
  1.  ; needed (remember - ALL fields on the DUR/PPS segment are optional)
  1.  D GETFLDS^ABSPOSHF(IEN(9002313.92),NODE,.FIELD)
  1.  ;
  1.  ;finally -loop through and process the fields for as many times
  1.  ; as they appear
  1.  S DUR=0
  1.  F  S DUR=$O(ABSP(9002313.1001,DUR)) Q:DUR=""  D
  1.  . S ORD=0
  1.  . F  S ORD=$O(FIELD(ORD)) Q:ORD=""  D
  1.  .. S FLDIEN=$P(FIELD(ORD),U)
  1.  .. S FLD=$P(FIELD(ORD),U,2)
  1.  .. S:FLD=473 FLD=.01   ;473 value stored in the .01 field
  1.  .. S FDATA5=$G(^ABSPF(9002313.91,FLDIEN,5))   ;5.1 id and length
  1.  .. S FLDID=$P(FDATA5,U,1)         ;5.1 ID
  1.  .. ;
  1.  .. ;transaction data
  1.  .. S FLDDATA=$G(ABSP(9002313.1001,DUR,FLD,"I"))
  1.  .. ;
  1.  .. ;IHS/SD/lwj 04/28/04 patch 11, chgd logic so blk flds aren't sent
  1.  .. ;I FLDID'=$TR(FLDDATA,"0 {}") S DATAFND=1 ;fld chk-is the fld empty?
  1.  .. ;IHS/SD/RLT - 05/01/06 - Patch 17
  1.  .. ;Allow double zeros in fields 440 and 441
  1.  .. ;I FLDID'=$TR(FLDDATA,"0 {}")  D
  1.  .. I FLDID'=$TR(FLDDATA," {}")  D
  1.  ... S DATAFND=1 ;fld chk-is the fld empty?
  1.  ... S SEGREC=SEGREC_$C(28)_FLDDATA  ;FS always proceeds fld
  1.  .. ;
  1.  .. ;S SEGREC=SEGREC_$C(28)_FLDDATA  ;FS always proceeds fld
  1.  .. ;IHS/SD/lwj 04/28/04 patch 11 end changes
  1.  ;
  1.  ;
  1.  Q
  1. PROCDIAG ;NCPDP 5.1 - DIAGNOSIS CODE in CLINICAL Segment
  1.  ;
  1.  Q:'$D(ABSP(9002313.0701))    ;quit if no data
  1.  S DATAFND=1
  1.  ;
  1.  N FIELD,DIAG,FLD
  1.  ;
  1.  ; 111 field
  1.  S FLDDATA=$$SEGID(NODE)
  1.  S SEGREC=SEGREC_$C(28)_FLDDATA  ;FS always proceeds fld
  1.  ;
  1.  ; 491 field  ;not included below because it's not a repeating field
  1.  S FLDDATA=$G(ABSP(9002313.0701,0,491,"I"))
  1.  S SEGREC=SEGREC_$C(28)_FLDDATA  ;FS always proceeds fld
  1.  ;
  1.  D GETFLDS^ABSPOSHF(IEN(9002313.92),NODE,.FIELD)
  1.  ;
  1.  S DIAG=0
  1.  F  S DIAG=$O(ABSP(9002313.0701,DIAG)) Q:DIAG=""  D
  1.  . S ORD=0
  1.  . F  S ORD=$O(FIELD(ORD)) Q:ORD=""  D
  1.  .. S FLDIEN=$P(FIELD(ORD),U)
  1.  .. S FLD=$P(FIELD(ORD),U,2)
  1.  .. S FDATA5=$G(^ABSPF(9002313.91,FLDIEN,5))   ;5.1 id and length
  1.  .. S FLDID=$P(FDATA5,U,1)         ;5.1 ID
  1.  .. ;
  1.  .. ;transaction data
  1.  .. S FLDDATA=$G(ABSP(9002313.0701,DIAG,FLD,"I"))
  1.  .. S SEGREC=SEGREC_$C(28)_FLDDATA  ;FS always proceeds fld
  1.  Q