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

ABSPOSH4.m

Go to the documentation of this file. 
  1. ABSPOSH4 ; IHS/FCS/DRS - Parse Claim 5.1,D.0 Response ;    [ 09/04/2002  12:56 PM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3,14,36,42,46**;JUN 21, 2001;Build 38
  1.  ;----------------------------------------------------------------------
  1.  ;----------------------------------------------------------------------
  1.  ;Parse ASCII Response Claim Record and Sup FDATA() Array
  1.  ;
  1.  ;Parameters:  RREC     - Ascii Response Record
  1.  ;             RESPIEN  - Claim Response IEN (90023130.3)
  1.  ;----------------------------------------------------------------------
  1.  ; Calls ABSPOSH5
  1.  ;
  1.  ;----------------------------------------------------------------------
  1.  ; IHS/SD/lwj  8/6/02  NCPDP 5.1 changes
  1.  ;  NCPDP 5.1 response segments are completely different than the
  1.  ;  3.2 response.  Of significant importance are:
  1.  ;   In 3.2, there were 4 basic repsonse segments (header required,
  1.  ;     header option, information required, information optional.) 
  1.  ;   In 5.1, there are 8 possible segments (header, message, insurance,
  1.  ;     status, claim, pricing, DUR/PPS, and prior authorization)
  1.  ;
  1.  ;   In 5.1, for all segments following the header, a segment separator
  1.  ;     is used.
  1.  ;
  1.  ;   In 5.1, field separators, and field identifiers are used for all
  1.  ;     fields not appearing on the header segment.
  1.  ;
  1.  ; This routine will be solely responsible for parsing the data
  1.  ; for 5.1 claims.  It is called by ABSPECA4.
  1.  ;----------------------------------------------------------------------
  1.  ;IHS/SD/lwj 10/27/05 patch 14 - new subroutine added to parse out the
  1.  ; E1 response
  1.  ;
  1.  ;----------------------------------------------------------------------
  1.  ;IHS/SD/lwj 10/27/05 patch 14 - new subroutine for E1 parsing
  1. PARSEE1(RREC,E1IEN) ;EP - from ABSPECA4
  1.  N GS,FS,SS
  1.  ;
  1.  ;Make sure input varaibles are defined
  1.  Q:$G(RREC)=""
  1.  Q:$G(E1IEN)=""
  1.  Q:'$D(^ABSPE(E1IEN,0))
  1.  ;
  1.  ;group and field separator characters
  1.  S GS=$C(29),FS=$C(28),SS=$C(30)
  1.  ;
  1.  D TRANSMSN            ;process the transmission level data
  1.  D TRANSACT            ;process the transaction level data
  1.  ;
  1.  Q
  1.  ;
  1. PARSE51(RREC,RESPIEN) ;EP - from ABSPECA4
  1.  N GS,FS,SS
  1.  ;
  1.  ;Make sure input varaibles are defined
  1.  Q:$G(RREC)=""
  1.  Q:$G(RESPIEN)=""
  1.  Q:'$D(^ABSPR(RESPIEN,0))
  1.  ;
  1.  ;group and field separator characters
  1.  S GS=$C(29),FS=$C(28),SS=$C(30)
  1.  ;
  1.  D TRANSMSN            ;process the transmission level data
  1.  D TRANSACT            ;process the transaction level data
  1.  D FILE^ABSPOSH5(RESPIEN)   ;add information to the response file
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. TRANSMSN ;This subroutine will work through the transmission level information
  1.  ;
  1.  N RTRANM,RHEADER,SEG,SEGMENT,SEGID
  1.  ;
  1.  ;Parse response transmission level from ascii record
  1.  S RTRANM=$P(RREC,GS,1)
  1.  ;
  1.  ; get just the header segment 
  1.  S RHEADER=$P(RTRANM,SS,1)    ;header- required/fixed length
  1.  D PARSEH
  1.  ;
  1.  ; There are 2 optional segments on the trasmission level - message
  1.  ; and insurance.  We'll check for both and parse what we find.
  1.  ;
  1.  ; OIT/CAS/RCS 092013 Patch 46 More that two segments are allowed
  1.  F SEG=2:1 S SEGMENT=$P(RTRANM,SS,SEG) Q:SEGMENT=""  D
  1.  . S SEGID=$P(SEGMENT,FS,2)
  1.  . I $E(SEGID,1,2)="AM" D                ;segment identification
  1.  . D:($E(SEGID,3,4)=20)!($E(SEGID,3,4)=25) PARSETM
  1.  . I ($E(SEGID,3,4)=27)!($E(SEGID,3,4)=29) S MEDN=1 D PARSETN ;D.0 Record
  1.  ;
  1.  Q
  1.  ;
  1. TRANSACT ;This subroutine will work through the transaction level information
  1.  ;
  1.  N RTRAN,SEG,SEGMENT,MEDN
  1.  S MEDN=0
  1.  ;
  1.  F GRP=2:1 D  Q:RTRAN=""
  1.  . S RTRAN=$P(RREC,GS,GRP)     ;get the next transaction (could be 4)
  1.  . Q:RTRAN=""                  ;we're done if it's empty
  1.  . S MEDN=MEDN+1               ;transaction counter
  1.  . ;
  1.  . F SEG=2:1 D  Q:SEGMENT=""   ;break the record down by segments
  1.  .. S SEGMENT=$P(RTRAN,SS,SEG) ;get the segment
  1.  .. Q:SEGMENT=""
  1.  .. D PARSETN                  ;get the fields
  1.  ;
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. PARSEH ; The header record is required on all responses, and is fixed 
  1.  ; length.  It is the only record that is fixed length.
  1.  ;
  1.  S FDATA(102)=$E(RHEADER,1,2)    ;version/release number
  1.  S FDATA(103)=$E(RHEADER,3,4)    ;transaction code
  1.  S FDATA(109)=$E(RHEADER,5,5)    ;transaction count
  1.  S FDATA(501)=$E(RHEADER,6,6)    ;header response status
  1.  S FDATA(202)=$E(RHEADER,7,8)    ;service provider id qualifier
  1.  S FDATA(201)=$E(RHEADER,9,23)   ;service provider id
  1.  S FDATA(401)=$E(RHEADER,24,31)  ;date of service
  1.  ;
  1.  Q
  1.  ;
  1. PARSETM ; This subroutine will parse the variable portions of the transmission 
  1.  ; level message.  Keep in mind that most fields are optional
  1.  ; so we have no idea what is coming back.  We will parse based 
  1.  ; on the field separators, and field identification.
  1.  ; (tranmission level variable records are the message (ID=20) 
  1.  ;  and insurance (ID=25) segments)
  1.  ;
  1.  N FIELD,PC,FLDNUM
  1.  ;
  1.  F PC=3:1 D  Q:FIELD=""        ;skip the seg id -already know its value 
  1.  . S FIELD=$P(SEGMENT,FS,PC)   ;piece through the record
  1.  . Q:FIELD=""                  ;stop - we hit the end
  1.  . S FLDNUM=$$GETNUM(FIELD)    ;get the field number used for storage
  1.  . Q:FLDNUM=""                 ;shouldn't happen - but lets skip
  1.  . S FDATA(FLDNUM)=$E(FIELD,3,$L(FIELD))  ;hold the value
  1.  ;
  1.  Q
  1.  ; 
  1. PARSETN ; This subroutine will parse the transaction level segments. For 
  1.  ; most transactions, the only segment required in this area of 
  1.  ; the response is the status segment.  However, since we aren't
  1.  ; sure what we will be getting back, we will process whatever
  1.  ; is sent our way.
  1.  ;
  1.  ; Please note that most fields are optional, so we will parse the
  1.  ; record based on field separators and the value of the field
  1.  ; identification.  
  1.  ; Also please note that several of the segments have repeating
  1.  ; fields - we will determine which fields are repeating, based
  1.  ; on the segment identification.
  1.  ;
  1.  ; Possible values of the SEGFID field:
  1.  ;  21 = Response Status Segment
  1.  ;  22 = Response Claim Segment
  1.  ;  23 = Response Pricing Segment
  1.  ;  24 = Response DUR/PPS Segment
  1.  ;  26 = Repsonse Prior Authorization Segment
  1.  ;  28 = Other Payer Segment
  1.  ;
  1.  N FIELD,PC,FLDNUM,RPTFLD,RCNT,REPEAT,OCNT
  1.  ;
  1.  S RPTFLD=""
  1.  S SEGID=$P(SEGMENT,FS,2)           ;this should be the segment id
  1.  Q:SEGID=""                         ;don't process without a Seg id
  1.  Q:$E(SEGID,1,2)'="AM"              ;don't know what we have - skip
  1.  ;
  1.  S SEGFID=$E(SEGID,3,4)             ;this should be the field ID
  1.  ;
  1.  ; setup the repeating flds based on the segment
  1.  I SEGFID=21 D               ;status segment
  1.  . S RPTFLD=",548,511,546,526,"
  1.  . S (RCNT(548),RCNT(511),RCNT(546),RCNT(526))=0
  1.  ;
  1.  I SEGFID=22 D                 ;claim segment
  1.  . S RPTFLD=",552,553,554,555,556,"
  1.  . S (RCNT(552),RCNT(553),RCNT(554),RCNT(555),RCNT(556))=0
  1.  ;
  1.  I SEGFID=23 D                ;pricing segment
  1.  . S RPTFLD=",564,565,"
  1.  . S (RCNT(564),RCNT(565))=0
  1.  ;
  1.  I SEGFID=24 D                ;DUR/PPS segment
  1.  . S RPTFLD=",439,528,529,530,531,532,533,544,567,"
  1.  . S (RCNT(439),RCNT(528),RCNT(529),RCNT(530),RCNT(531))=0
  1.  . S (RCNT(532),RCNT(533),RCNT(544),RCNT(567))=0
  1.  ;
  1.  I SEGFID=28 D  Q                ;Other Payer segment
  1.  . F PC=3:1 D  Q:FIELD=""        ;skip the seg id -jump to the other flds
  1.  . . S FIELD=$P(SEGMENT,FS,PC)   ;piece through the record
  1.  . . Q:FIELD=""                  ;stop - we hit the end
  1.  . . S FLDNUM=$$GETNUM(FIELD)    ;get the field number used for storage
  1.  . . Q:FLDNUM=""
  1.  . . I FLDNUM=355 Q
  1.  . . I FLDNUM=338 S OCNT=+$E(FIELD,3,$L(FIELD)) ;Other coverage type
  1.  . . S FDATA("M",MEDN,FLDNUM,OCNT)=$E(FIELD,3,$L(FIELD))
  1.  ;
  1.  ; now lets parse out the fields
  1.  ;
  1.  F PC=3:1 D  Q:FIELD=""        ;skip the seg id -jump to the other flds
  1.  . S FIELD=$P(SEGMENT,FS,PC)   ;piece through the record
  1.  . Q:FIELD=""                  ;stop - we hit the end
  1.  . S FLDNUM=$$GETNUM(FIELD)    ;get the field number used for storage
  1.  . ;IHS/OIT/SCR 11/26/08 - next line avoids subscript error on last line of routine
  1.  . ;EMERGENCY FIX distributed on 12/2/08 -added to patch 36 011910
  1.  . Q:FLDNUM=""
  1.  . I ",304,310,311,"[(","_FLDNUM_",") S FLDNUM=FLDNUM_".01" ;Save response data to different field
  1.  . S REPEAT=0                  ;for this segment, lets figure
  1.  . S CKRPT=","_FLDNUM_","      ;out if the field is a repeating
  1.  . S:RPTFLD[CKRPT REPEAT=1     ;field
  1.  . ;
  1.  . I REPEAT D                  ;if rptg, store with a counter
  1.  .. S RCNT(FLDNUM)=$G(RCNT(FLDNUM))+1
  1.  .. S FDATA("M",MEDN,FLDNUM,RCNT(FLDNUM))=$E(FIELD,3,$L(FIELD))
  1.  . ;
  1.  . I 'REPEAT D                 ;not rptg, store without counter
  1.  .. S FDATA("M",MEDN,FLDNUM)=$E(FIELD,3,$L(FIELD))
  1.  ;
  1.  ;
  1.  Q
  1.  ;
  1. GETNUM(FIELD) ; This routine will translate the field ID into a field number.  
  1.  ; We will use the ABSP NCPDP field Defs files, corss ref "D" to
  1.  ; perform this translation.  (The field number is needed to store
  1.  ; the data in the correct field within the response file.)
  1.  ;
  1.  N FLDID,FLDIEN,FLDNUM
  1.  S (FLDID,FLDNUM)=""
  1.  S FLDIEN=0
  1.  ;
  1.  S FLDID=$E(FIELD,1,2)       ;field identifier
  1.  Q:FLDID=""
  1.  ;
  1.  I FLDID'="" D
  1.  . S FLDIEN=$O(^ABSPF(9002313.91,"D",FLDID,FLDIEN))  ;internal fld #
  1.  . S:FLDIEN FLDNUM=$P($G(^ABSPF(9002313.91,FLDIEN,0)),U) ;fld number
  1.  ;
  1.  ;
  1.  Q FLDNUM
  1.  ;