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

ABSPECA1.m

Go to the documentation of this file. 
  1. ABSPECA1 ; IHS/FCS/DRS - Assemble formatted claim ;   [ 09/23/2002  2:36 PM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3,7,23,42**;JUN 21, 2001;Build 38
  1.  ;----------------------------------------------------------------------
  1.  ;Assemble ASCII formatted claim submission record
  1.  ;
  1.  ;Input Variables:   CLAIMIEN - pointer into 9002313.02
  1.  ;     The claim must be complete and well-constructed;
  1.  ;     we do some paranoical checks below.
  1.  ;
  1.  ;     $$ Returns:   - Formatted NCPDP ASCII record
  1.  ;----------------------------------------------------------------------
  1.  ;
  1.  ;IHS/SD/lwj 8/1/02  NCPDP 5.1 changes
  1.  ; These is major differences in 3.2 vs 5.1 in the actual creation
  1.  ; of the claim.  Of significance:
  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.  ;  The first thing added to this routine is the retrieval of the
  1.  ;  version from the claim file.  If the version is 3.2, we will 
  1.  ;  process just like we used to.  If it is 5.1, we will alter the
  1.  ;  creation of the claim to include the above differences.
  1.  ;
  1.  ;  Adjustments were also made to the reversal logic as well.
  1.  ;------------------------------------------------------------
  1.  ;IHS/SD/lwj 9/4/03 Patch 7 POS V1.0
  1.  ; The payors do not want the Prior Authorization segment
  1.  ; sent when there isn't a prior auth.  This is different than
  1.  ; our normal processing, which allows us to send the segment
  1.  ; blank.  To accomodate for this payor limitation, new logic
  1.  ; was added to only process the prior authorization when
  1.  ; information has been input into the PA fields.
  1.  ;-----------------------------------------------------------
  1.  ;IHS/SD/RLT - 06/26/07 - 10/18/07 - Patch 23
  1.  ; New tag DIAGVAL for Diagnosis Code.
  1.  ;
  1. ASCII(CLAIMIEN) ;EP - from ABSPOSQH from ABSPOSQG from ABSPOSQ2
  1.  N IEN,MABSP,RECORD,ABSP,REVERSAL,UERETVAL,CLMV,DET51,RTRNCD
  1.  N PAFLAG            ;IHS/SD/lwj 09/04/03 prior values?
  1.  I '$D(^ABSPC(CLAIMIEN,0)) D  G QERR  ; check for good parameter
  1.  . S UERETVAL=$$IMPOSS^ABSPOSUE("DB,P","T",CLAIMIEN,,1,$T(+0))
  1.  ;
  1.  ;Setup IEN variables (used when executing format code)
  1.  S IEN(9002313.02)=CLAIMIEN
  1.  ; Point to ABSP INSURER
  1.  S IEN(9002313.4)=$P($G(^ABSPC(IEN(9002313.02),0)),U,2)
  1.  I 'IEN(9002313.4) D  G QERR ; claim must have an insurer
  1.  . S UERETVAL=$$IMPOSS^ABSPOSUE("DB,P","T",CLAIMIEN,,2,$T(+0))
  1.  ; Point to format
  1.  S IEN(9002313.92)=$P($G(^ABSPEI(IEN(9002313.4),100)),U,1)
  1.  I ('IEN(9002313.92))&&($G(^ABSP(9002313.99,1,"ABSPICNV"))'=1) D  G QERR ; insurer must have an e-format UNLESS conversion has been run
  1.  . S UERETVAL=$$IMPOSS^ABSPOSUE("DB","T",CLAIMIEN,,3,$T(+0))
  1.  ;
  1.  ;
  1.  ; But if it's a reversal claim, get the format for the reversal
  1.  ; IHS/SD/lwj 08/15/02 NCPDP 5.1 needed to adjust reversal a little
  1.  ; RTRNCD added - original IF stmt remarked out - new one added
  1.  ; 5.1 transaction code for reversal is now B2 not 11
  1.  ;
  1.  S RTRNCD=$P(^ABSPC(IEN(9002313.02),100),U,3)
  1.  ;I $P(^ABSPC(IEN(9002313.02),100),U,3)="11" D
  1.  I (RTRNCD=11)!(RTRNCD="B2") D
  1.  . S REVERSAL=1
  1.  . S:$G(IEN(9002313.92)) IEN(9002313.92)=$P($G(^ABSPF(9002313.92,IEN(9002313.92),"REVERSAL")),U)
  1.  . I ('IEN(9002313.92))&&($G(^ABSP(9002313.99,1,"ABSPICNV"))'=1) D  G QERR ; format must point to a reversal format
  1.  . . S UERETVAL=$$IMPOSS^ABSPOSUE("DB","T",CLAIMIEN,,4,$T(+0))
  1.  E  S REVERSAL=0
  1.  ;
  1.  I ($G(^ABSP(9002313.99,1,"ABSPICNV"))'=1)&&('$D(^ABSPF(9002313.92,IEN(9002313.92),0))) D  G QERR
  1.  . S UERETVAL=$$IMPOSS^ABSPOSUE("P","T",CLAIMIEN,,5,$T(+0))
  1.  ;
  1.  ;IHS/SD/lwj 8/1/02
  1.  ; retrieve the version number from the claim file so we know which
  1.  ; way we have to process
  1.  S CLMV=$P($G(^ABSPC(IEN(9002313.02),100)),U,2)
  1.  ;
  1.  ;Retrieve claim submission record (used when executing format code)
  1.  D GETABSP2^ABSPECX0(IEN(9002313.02),.ABSP)
  1.  ;W $T(+0)," we have:",! ZW ABSP R ">>>",%,!
  1.  ;
  1.  ;If reversal find current version number from Insurance file, if different then modify
  1.  I REVERSAL S INSVER=$P($G(^ABSPEI(IEN(9002313.4),100)),U,15),INSVER=$S(INSVER=2:"D0",1:"51") I INSVER'=CLMV D
  1.  .S CLMV=INSVER I $G(ABSP(9002313.02,CLAIMIEN,102,"I"))'="" S ABSP(9002313.02,CLAIMIEN,102,"I")=CLMV
  1.  .S $P(^ABSPC(IEN(9002313.02),100),U,2)=CLMV
  1.  ;
  1.  ;Assember claim header required and optional format sections
  1.  S RECORD=""
  1.  ;IHS/OIT/CASSEVERN/RAN - 2/9/2011 - Patch 42 New code for D.0 START
  1.  ;BREAK
  1.  I $G(^ABSP(9002313.99,1,"ABSPICNV"))=1 D
  1.  . I CLMV["D"  D
  1.  . . I REVERSAL D
  1.  . . . D EN^ABSPDB2("OUTHD",CLAIMIEN,.IEN)
  1.  . . ELSE  D EN^ABSPDB1("OUTHD",CLAIMIEN,.IEN)
  1.  . I CLMV["5"  D
  1.  . . I REVERSAL D
  1.  . . . D EN^ABSP5B2("OUTHD",CLAIMIEN,.IEN)
  1.  . . ELSE  D EN^ABSP5B1("OUTHD",CLAIMIEN,.IEN)
  1.  ;IHS/OIT/CASSEVERN/RAN - 2/9/2011 - Patch 42 New code for D.0 STOP
  1.  ELSE  D
  1.  . ;IHS/SD/lwj 8/1/02 nxt line remvd, following 2 lines added for 5.1 chgs
  1.  . ;D XLOOP^ABSPECA2("10^20",.IEN,.ABSP,.RECORD)
  1.  . D:CLMV[3 XLOOP^ABSPECA2("10^20",.IEN,.ABSP,.RECORD)   ;3.2 clms
  1.  . D:CLMV[5 XLOOP^ABSPOSH2("100^110^120",.IEN,.ABSP,.RECORD)   ;5.1 clms
  1.  ;IHS/SD/lwj 8/1/02  NCPDP 5.1 create chain of segments
  1.  S DET51="130^140^150^160^170^180^190^200^210^220^230"
  1.  ;
  1.  ;Loop through prescription multiple
  1.  S IEN(9002313.01)=0
  1.  F  D  Q:'IEN(9002313.01)
  1.  .S IEN(9002313.01)=$O(^ABSPC(IEN(9002313.02),400,IEN(9002313.01)))
  1.  .Q:'IEN(9002313.01)
  1.  .;
  1.  .;Retrieve prescription information (used when executing format code)
  1.  .K ABSP(9002313.0201)
  1.  .D GETABSP3^ABSPECX0(IEN(9002313.02),IEN(9002313.01),.ABSP)
  1.  .;
  1.  .;IHS/SD/lwj 8/22/02 NCPDP 5.1 handle at least the DUR repeating flds
  1.  .D DURVALUE
  1.  .;
  1.  .D DIAGVAL       ;Patch 23
  1.  .; 
  1.  .;IHS/SD/lwj 9/4/03 Patch 7 V1.0 check for prior auth value if 5.1
  1.  .; if none, don't process prior auth segment (220)
  1.  .I CLMV[5 D
  1.  .. S PAFLAG=$$PAVALUE  ;if no PA, don't process segment
  1.  .. S:'PAFLAG DET51="130^140^150^160^170^180^190^200^210^230"
  1.  .;
  1.  .;W $T(+0)," we have:",! ZW ABSP R ">>>",%,!
  1.  .;
  1.  .;Append group seperator character (but not in a reversal format)
  1.  . I 'REVERSAL S RECORD=RECORD_$C(29)
  1.  .;IHS/SD/lwj 08/15/02 NCPDP 5.1 - requires GS on reversal
  1.  . I (REVERSAL)&(CLMV[5) S RECORD=RECORD_$C(29)
  1.  . ;IHS/OIT/CASSEVERN/RAN - 2/9/2011 - Patch 42 New code for D.0 START
  1.  . ;BREAK
  1.  . I $G(^ABSP(9002313.99,1,"ABSPICNV"))=1 D
  1.  . . I CLMV["D" D
  1.  . . . I REVERSAL D
  1.  . . . . D EN^ABSPDB2("OUTRST",CLAIMIEN,.IEN)
  1.  . . . ELSE  D EN^ABSPDB1("OUTRST",CLAIMIEN,.IEN)
  1.  . . I CLMV["5" D
  1.  . . . I REVERSAL D
  1.  . . . . D EN^ABSP5B2("OUTRST",CLAIMIEN,.IEN)
  1.  . . . ELSE  D EN^ABSP5B1("OUTRST",CLAIMIEN,.IEN)
  1.  .;IHS/OIT/CASSEVERN/RAN - 2/9/2011 - Patch 42 New code for D.0 STOP
  1.  .;Assemble claim information required and optional sections
  1.  .;IHS/SD/lwj 8/1/02 nxt ln rmkd out - following 2 lines added
  1.  .;D XLOOP^ABSPECA2("30^40",.IEN,.ABSP,.RECORD)
  1.  . ELSE  D
  1.  . . D:CLMV[3 XLOOP^ABSPECA2("30^40",.IEN,.ABSP,.RECORD)
  1.  . . D:CLMV[5 XLOOP^ABSPOSH2(DET51,.IEN,.ABSP,.RECORD)
  1.  Q RECORD
  1. QERR Q:$Q "" Q
  1.  Q
  1. DURVALUE ;NCPDP 5.1 - this subroutine will loop through the DUR/PPS repeating
  1.  ; fields and load their values into the ABSP array for the claim
  1.  ; generation process
  1.  ;
  1.  N DURCNT,DUR
  1.  ;
  1.  K ABSP(9002313.1001)
  1.  ;
  1.  ;we depend on the "count" since we set it when we created the clm entry
  1.  S DURCNT=$P($G(^ABSPC(IEN(9002313.02),400,IEN(9002313.01),473.01,0)),U,4)
  1.  F DUR=1:1:DURCNT  D
  1.  . D GETABSP4^ABSPECX0(IEN(9002313.02),IEN(9002313.01),DUR,.ABSP)
  1.  ;
  1.  Q
  1.  ;
  1. PAVALUE() ;NCPDP 5.1 - IHS/SD/lwj 9/4/03 Payors do not want the Prior Auth
  1.  ; segment if there is no data on it (contrary to other segments)
  1.  ; This routine will check to see if there is information for processing.
  1.  ;
  1.  N ENT,PAFLAG,CLMIEN,CRXIEN,PAFLD
  1.  S CLMIEN=IEN(9002313.02)
  1.  S CRXIEN=IEN(9002313.01)
  1.  S PAFLAG=0
  1.  ;
  1.  F ENT=498.01:.01:498.14  K ABSP("9002313.0201",CRXIEN,ENT)
  1.  ;
  1.  D GETABSP5^ABSPECX0(CLMIEN,CRXIEN,.ABSP)
  1.  ;
  1.  F ENT=498.01:.01:498.14  D
  1.  . S PAFLD=$G(ABSP("9002313.0201",CRXIEN,ENT,"I"))
  1.  . S:$L(PAFLD)>2 PAFLD=$TR($E(PAFLD,3,$L(PAFLD))," 0")
  1.  . S:PAFLD'="" PAFLAG=1
  1.  ;
  1.  Q PAFLAG
  1.  ;
  1. DIAGVAL ;NCPDP 5.1 - loops through the diagnosis code repeating
  1.  ; fields and loads their values into the ABSP array for the claim
  1.  ; generation process
  1.  ;
  1.  N DIAGCNT,DIAG
  1.  ;
  1.  K ABSP(9002313.0701)
  1.  ;
  1.  S DIAGCNT=$P($G(^ABSPC(IEN(9002313.02),400,IEN(9002313.01),490)),U)
  1.  Q:+$TR(DIAGCNT,"VE","")=0
  1.  S ABSP(9002313.0701,0,491,"I")=DIAGCNT             ; set non-repeating field 491
  1.  F DIAG=1:1:$TR(DIAGCNT,"VE")  D
  1.  . D GETABSP6^ABSPECX0(IEN(9002313.02),IEN(9002313.01),DIAG,.ABSP)
  1.  ;
  1.  Q