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

ABSPOSH6.m

Go to the documentation of this file. 
  1. ABSPOSH6  ;IHS/SD/lwj - NCPDP 5.1 Post 5.1 response [ 09/04/2002  12:57 PM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3,9,39,42,43**;JUN 21, 2001;Build 38
  1.  ;-------------------------------------------------------------
  1.  ; Originally, the entire response was processed in the 
  1.  ; ABSPOSH5 routine - but it exceed SAC limitations on 
  1.  ; routine size - so the processing of some of the transaction 
  1.  ; level information was moved to this routine. Other portions
  1.  ; were moved to the ABSPOSH7 routine.
  1.  ; 
  1.  ; This routine is called solely from ABSPOSH5.
  1.  ;
  1.  ;--------------------------------------------------------------
  1.  ;IHS/SD/lwj 01/22/04 Patch 9
  1.  ; In January 2004, BC/BS Oklahoma and WebMD allowed responses
  1.  ; to be returned that indicated multiple rejection codes, when
  1.  ; in fact only a single rejection code was being returned.  This
  1.  ; caused problems, as we had followed the HIPAA standards that
  1.  ; said that the count should match the number of rejection codes.
  1.  ; While the issue was raised to WebMD that they were out of
  1.  ; compliance, we still made changes to our code just in case
  1.  ; they allowed others through.
  1.  ; The change was originate by POC in Oklahoma.
  1.  ;--------------------------------------------------------------
  1.  ;
  1.  Q
  1.  ;
  1. RESPSTS ;EP  - NCPDP 5.1 response processing (moved from ABSPOSH5)  
  1.  ; called from WRTTRAN^ABSPOSH5
  1.  ; MEDN is set in ABSPOSH5 in the WRTTRAN subroutine
  1.  ; process the response status segment - here's the fields we MIGHT 
  1.  ; encounter:
  1.  ; 112 - transaction response status (mandatory)
  1.  ; 503 - authorization number
  1.  ; 510 - reject count 
  1.  ; 511 - reject code (repeating field)
  1.  ; 546 - reject field occurrence indicator (repeating field)
  1.  ; 547 - approved message code count 
  1.  ; 548 - approved message code (repeating field)
  1.  ; 526 - additional message information
  1.  ; 549 - help desk phone number qualifier
  1.  ; 550 - help desk phone number
  1.  ;
  1.  ; *special note - in 3.2 the transaction response is stored in field
  1.  ; 501 at the prescription level.  In 5.1 that was moved to field 112.
  1.  ; All the reports are based on the 501 field, so to keep things
  1.  ; simple, we will simply update both the 112 and 501 fields with 
  1.  ; the transaction level response status.
  1.  ;
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,110),U,2)=$G(FDATA("M",MEDN,112))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,500),U)=$G(FDATA("M",MEDN,112))  ;501
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,3)=$G(FDATA("M",MEDN,503))
  1.  ;
  1.  ; process reject information if there
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,10)=$G(FDATA("M",MEDN,510))
  1.  I $D(FDATA("M",MEDN,510)) D REPREJ      ;process the rejection codes
  1.  ;
  1.  ; process approved information if there
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,540),U,7)=$G(FDATA("M",MEDN,547))
  1.  I $D(FDATA("M",MEDN,547)) D REPAPP      ;process the repeating fld
  1.  ;
  1.  ; finish up with the additional message, and help desk information
  1.  ;IHS/OIT/CASSevern/Pieran/RAN 11-28-2011 42 making field 526 a repeating field
  1.  ;S $P(^ABSPR(RESPIEN,1000,INDEX,526),U)=$G(FDATA("M",MEDN,526))
  1.  I $D(FDATA("M",MEDN,526)) D REPADM      ;process additional messages
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,540),U,9)=$G(FDATA("M",MEDN,549))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,540),U,10)=$G(FDATA("M",MEDN,550))
  1.  ;
  1.  ;
  1.  Q
  1.  ;
  1. REPREJ ; This subroutine will process the reject repeating fields 
  1.  ; that are a part of the status segment.
  1.  ; Two fields here - 511 - Reject Code and
  1.  ;                   546 - Reject field occurrence indicator
  1.  ;
  1.  N CNTR,COUNT,RJCD,RJOC,RLCNT
  1.  ;
  1.  S RLCNT=0
  1.  S COUNT=$G(FDATA("M",MEDN,510))    ;reject count
  1.  Q:COUNT'>0
  1.  ;
  1.  F CNTR=1:1:COUNT  D
  1.  . S (RJCD,RJOC)=""
  1.  . S RJCD=$G(FDATA("M",MEDN,511,CNTR))   ;rejection code
  1.  . ;IHS/OIT/CNI/RAN 5/21/2010 Patch 39 Strip out unwanted spaces being sent by EMDEON
  1.  . S RJCD=$TR(RJCD," ","")
  1.  . S RJOC=$G(FDATA("M",MEDN,546,CNTR))   ;reject fld occurence ind
  1.  . ;IHS/SD/lwj 1/22/04 patch 9 nxt line remarked out, following
  1.  . ; added
  1.  . ;I $D(RJCD) D
  1.  . I $G(RJCD)]"" D
  1.  .. S $P(^ABSPR(RESPIEN,1000,INDEX,511,CNTR,0),U)=RJCD
  1.  .. S ^ABSPR(RESPIEN,1000,INDEX,511,"B",RJCD,CNTR)=""
  1.  . ;IHS/SD/lwj 1/22/04 patch 9 nxt two lns remkd out, nxt 2 added
  1.  . ;S:$D(RJOC) $P(^ABSPR(RESPIEN,1000,INDEX,511,CNTR,0),U,2)=RJOC
  1.  . ;S:(($D(RJOC))!($D(RJCD))) RLCNT=RLCNT+1
  1.  . S:$G(RJOC)]"" $P(^ABSPR(RESPIEN,1000,INDEX,511,CNTR,0),U,2)=RJOC
  1.  . S:(($G(RJOC)]"")!($G(RJCD)]"")) RLCNT=RLCNT+1
  1.  ;
  1.  I RLCNT>0 D
  1.  . S ^ABSPR(RESPIEN,1000,INDEX,511,0)="^9002313.03511A^"_RLCNT_"^"_RLCNT
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. REPAPP ; This subroutine will process the approved repeating field 
  1.  ; that is a part of the status segment.
  1.  ; Field 548 - Approved Message Code
  1.  ;
  1.  N CNTR,COUNT,RLCNT,APP
  1.  ;
  1.  S RLCNT=0
  1.  S COUNT=$G(FDATA("M",MEDN,547))    ;approved message code count
  1.  Q:COUNT'>0
  1.  ;
  1.  F CNTR=1:1:COUNT  D
  1.  . S APP=$G(FDATA("M",MEDN,548,CNTR))   ;approved message code
  1.  . I $L(APP) D
  1.  .. S $P(^ABSPR(RESPIEN,1000,INDEX,548,CNTR,0),U)=APP
  1.  .. S ^ABSPR(RESPIEN,1000,INDEX,548,"B",APP,CNTR)=""
  1.  .. S RLCNT=RLCNT+1
  1.  ;
  1.  I RLCNT>0 D
  1.  . S ^ABSPR(RESPIEN,1000,INDEX,548,0)="^9002313.301548A^"_RLCNT_"^"_RLCNT
  1.  ;
  1.  Q
  1.  ;
  1. RESPCLM ;EP  - NCPDP 5.1 response processing (moved from ABSPOSH5)  
  1.  ; called from WRTTRAN^ABSPOSH5
  1.  ; MEDN is set in ABSPOSH5 in the WRTTRAN subroutine
  1.  ; process the response claim segment - here's the fields we MIGHT
  1.  ; encounter:
  1.  ; 455 - prescription/service reference number qualifier
  1.  ; 402 - prescripton/service reference number
  1.  ; 551 - preferred product count
  1.  ; 552 - preferred product id qualifier (repeating)
  1.  ; 553 - preferred product id (repeating)
  1.  ; 554 - preferred product incentive (repeating)
  1.  ; 555 - preferred product copay incentive (repeating)
  1.  ; 556 - preferred product description (repeating)
  1.  ;
  1.  ; start with what are suppose to be mandatory fields
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,450),U,5)=$G(FDATA("M",MEDN,455))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,400),U,2)=$G(FDATA("M",MEDN,402))
  1.  ;
  1.  ; now lets try to process the preferred product repeating fields
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,550),U)=$G(FDATA("M",MEDN,551))
  1.  I $D(FDATA("M",MEDN,551)) D REPPPD      ;process the repeating fld
  1.  ;
  1.  Q
  1.  ;
  1. REPPPD ; This subroutine will process the preferred product repeating fields 
  1.  ; that are a part of the claim segment.
  1.  ; five fields here- 552 - Preferred product id qualifier 
  1.  ;                   553 - Preferred product id 
  1.  ;                   554 - Preferred product incentive
  1.  ;                   555 - preferred product copay incentive
  1.  ;                   556 - preferred product description
  1.  ;
  1.  N CNTR,COUNT,PPIDQ,PPID,PPINC,PPCOP,PPDESC,CKREC
  1.  ;
  1.  S RLCNT=0
  1.  S COUNT=$G(FDATA("M",MEDN,551))    ;preferred product count
  1.  Q:COUNT'>0
  1.  ;
  1.  F CNTR=1:1:COUNT  D
  1.  . S (PPIDQ,PPID,PPINC,PPCOP,PPDESC)=""
  1.  . S PPIDQ=$G(FDATA("M",MEDN,552,CNTR))  ;preferred product id qual
  1.  . S PPID=$G(FDATA("M",MEDN,553,CNTR))   ;preferred product id
  1.  . S PPINC=$G(FDATA("M",MEDN,554,CNTR))  ;preferred product incentive
  1.  . S PPCOP=$G(FDATA("M",MEDN,555,CNTR))  ;preferred product copay inc
  1.  . S PPDESC=$G(FDATA("M",MEDN,556,CNTR)) ;preferred product desc
  1.  . S CKREC=PPIDQ_PPID_PPINC_PPCOP_PPDESC ;quick chk for values
  1.  . I $D(CKREC) D
  1.  .. S $P(^ABSPR(RESPIEN,1000,INDEX,551.01,CNTR,0),U)=CNTR
  1.  .. S ^ABSPR(RESPIEN,1000,INDEX,551.01,"B",CNTR,CNTR)=""
  1.  .. S RLCNT=RLCNT+1
  1.  . S:$D(PPIDQ) $P(^ABSPR(RESPIEN,1000,INDEX,551.01,CNTR,1),U,1)=PPIDQ
  1.  . S:$D(PPID) $P(^ABSPR(RESPIEN,1000,INDEX,551.01,CNTR,1),U,2)=PPID
  1.  . S:$D(PPINC) $P(^ABSPR(RESPIEN,1000,INDEX,551.01,CNTR,1),U,3)=PPINC
  1.  . S:$D(PPCOP) $P(^ABSPR(RESPIEN,1000,INDEX,551.01,CNTR,1),U,4)=PPCOP
  1.  . S:$D(PPDESC) $P(^ABSPR(RESPIEN,1000,INDEX,551.01,CNTR,1),U,5)=PPDESC
  1.  ;
  1.  I RLCNT>0 D
  1.  . S ^ABSPR(RESPIEN,1000,INDEX,551.01,0)="^9002313.1301A^"_RLCNT_"^"_RLCNT
  1.  ;
  1.  Q
  1.  ;
  1. REPADM ; This subroutine will process the repeating additional message info 
  1.  ; that is a part of the status segment.
  1.  ; Field 526 - Additional Message Information
  1.  ;
  1.  N CNTR,COUNT,RLCNT,MSG
  1.  ;
  1.  S RLCNT=0
  1.  S COUNT=$O(FDATA("M",MEDN,526,""),-1)    ;Additional message count
  1.  Q:COUNT'>0
  1.  ;
  1.  F CNTR=1:1:COUNT  D
  1.  . S MSG=$G(FDATA("M",MEDN,526,CNTR))   ;Additional message
  1.  . I $L(MSG) D
  1.  .. S $P(^ABSPR(RESPIEN,1000,INDEX,526,CNTR,0),U)=MSG
  1.  .. S ^ABSPR(RESPIEN,1000,INDEX,526,"B",MSG,CNTR)=""
  1.  .. S RLCNT=RLCNT+1
  1.  ;
  1.  I RLCNT>0 D
  1.  . S ^ABSPR(RESPIEN,1000,INDEX,526,0)="^9002313.301526A^"_RLCNT_"^"_RLCNT
  1.  ;
  1.  Q