ABSPECA1 ; IHS/FCS/DRS - Assemble formatted claim ; [ 09/23/2002 2:36 PM ]
;;1.0;PHARMACY POINT OF SALE;**3,7,23,42**;JUN 21, 2001;Build 38
;----------------------------------------------------------------------
;Assemble ASCII formatted claim submission record
;
;Input Variables: CLAIMIEN - pointer into 9002313.02
; The claim must be complete and well-constructed;
; we do some paranoical checks below.
;
; $$ Returns: - Formatted NCPDP ASCII record
;----------------------------------------------------------------------
;
;IHS/SD/lwj 8/1/02 NCPDP 5.1 changes
; These is major differences in 3.2 vs 5.1 in the actual creation
; of the claim. Of significance:
; 3.2 had 4 claim segments (hdr req, hdr opt, det req, det opt)
; 5.1 has 14 claim segments (header, patient, insurance, claim
; pharmacy provider, prescriber,
; COB, workers comp, DUR, Pricing,
; coupon, compound, prior auth,
; clinical)
;
; 3.2 required only field identifiers and separtors on optional
; fields
; 5.1 requires field identifiers and separators on all fields
; other than the header
;
; 3.2 there were no segment separators
; 5.1 segment separators are required prior to each segment
; following the header
;
; 3.2/5.1 Group seperators appear at the end of each
; transaction (prescription)
;
; The first thing added to this routine is the retrieval of the
; version from the claim file. If the version is 3.2, we will
; process just like we used to. If it is 5.1, we will alter the
; creation of the claim to include the above differences.
;
; Adjustments were also made to the reversal logic as well.
;------------------------------------------------------------
;IHS/SD/lwj 9/4/03 Patch 7 POS V1.0
; The payors do not want the Prior Authorization segment
; sent when there isn't a prior auth. This is different than
; our normal processing, which allows us to send the segment
; blank. To accomodate for this payor limitation, new logic
; was added to only process the prior authorization when
; information has been input into the PA fields.
;-----------------------------------------------------------
;IHS/SD/RLT - 06/26/07 - 10/18/07 - Patch 23
; New tag DIAGVAL for Diagnosis Code.
;
ASCII(CLAIMIEN) ;EP - from ABSPOSQH from ABSPOSQG from ABSPOSQ2
N IEN,MABSP,RECORD,ABSP,REVERSAL,UERETVAL,CLMV,DET51,RTRNCD
N PAFLAG ;IHS/SD/lwj 09/04/03 prior values?
I '$D(^ABSPC(CLAIMIEN,0)) D G QERR ; check for good parameter
. S UERETVAL=$$IMPOSS^ABSPOSUE("DB,P","T",CLAIMIEN,,1,$T(+0))
;
;Setup IEN variables (used when executing format code)
S IEN(9002313.02)=CLAIMIEN
; Point to ABSP INSURER
S IEN(9002313.4)=$P($G(^ABSPC(IEN(9002313.02),0)),U,2)
I 'IEN(9002313.4) D G QERR ; claim must have an insurer
. S UERETVAL=$$IMPOSS^ABSPOSUE("DB,P","T",CLAIMIEN,,2,$T(+0))
; Point to format
S IEN(9002313.92)=$P($G(^ABSPEI(IEN(9002313.4),100)),U,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
. S UERETVAL=$$IMPOSS^ABSPOSUE("DB","T",CLAIMIEN,,3,$T(+0))
;
;
; But if it's a reversal claim, get the format for the reversal
; IHS/SD/lwj 08/15/02 NCPDP 5.1 needed to adjust reversal a little
; RTRNCD added - original IF stmt remarked out - new one added
; 5.1 transaction code for reversal is now B2 not 11
;
S RTRNCD=$P(^ABSPC(IEN(9002313.02),100),U,3)
;I $P(^ABSPC(IEN(9002313.02),100),U,3)="11" D
I (RTRNCD=11)!(RTRNCD="B2") D
. S REVERSAL=1
. S:$G(IEN(9002313.92)) IEN(9002313.92)=$P($G(^ABSPF(9002313.92,IEN(9002313.92),"REVERSAL")),U)
. I ('IEN(9002313.92))&&($G(^ABSP(9002313.99,1,"ABSPICNV"))'=1) D G QERR ; format must point to a reversal format
. . S UERETVAL=$$IMPOSS^ABSPOSUE("DB","T",CLAIMIEN,,4,$T(+0))
E S REVERSAL=0
;
I ($G(^ABSP(9002313.99,1,"ABSPICNV"))'=1)&&('$D(^ABSPF(9002313.92,IEN(9002313.92),0))) D G QERR
. S UERETVAL=$$IMPOSS^ABSPOSUE("P","T",CLAIMIEN,,5,$T(+0))
;
;IHS/SD/lwj 8/1/02
; retrieve the version number from the claim file so we know which
; way we have to process
S CLMV=$P($G(^ABSPC(IEN(9002313.02),100)),U,2)
;
;Retrieve claim submission record (used when executing format code)
D GETABSP2^ABSPECX0(IEN(9002313.02),.ABSP)
;W $T(+0)," we have:",! ZW ABSP R ">>>",%,!
;
;If reversal find current version number from Insurance file, if different then modify
I REVERSAL S INSVER=$P($G(^ABSPEI(IEN(9002313.4),100)),U,15),INSVER=$S(INSVER=2:"D0",1:"51") I INSVER'=CLMV D
.S CLMV=INSVER I $G(ABSP(9002313.02,CLAIMIEN,102,"I"))'="" S ABSP(9002313.02,CLAIMIEN,102,"I")=CLMV
.S $P(^ABSPC(IEN(9002313.02),100),U,2)=CLMV
;
;Assember claim header required and optional format sections
S RECORD=""
;IHS/OIT/CASSEVERN/RAN - 2/9/2011 - Patch 42 New code for D.0 START
;BREAK
I $G(^ABSP(9002313.99,1,"ABSPICNV"))=1 D
. I CLMV["D" D
. . I REVERSAL D
. . . D EN^ABSPDB2("OUTHD",CLAIMIEN,.IEN)
. . ELSE D EN^ABSPDB1("OUTHD",CLAIMIEN,.IEN)
. I CLMV["5" D
. . I REVERSAL D
. . . D EN^ABSP5B2("OUTHD",CLAIMIEN,.IEN)
. . ELSE D EN^ABSP5B1("OUTHD",CLAIMIEN,.IEN)
;IHS/OIT/CASSEVERN/RAN - 2/9/2011 - Patch 42 New code for D.0 STOP
ELSE D
. ;IHS/SD/lwj 8/1/02 nxt line remvd, following 2 lines added for 5.1 chgs
. ;D XLOOP^ABSPECA2("10^20",.IEN,.ABSP,.RECORD)
. D:CLMV[3 XLOOP^ABSPECA2("10^20",.IEN,.ABSP,.RECORD) ;3.2 clms
. D:CLMV[5 XLOOP^ABSPOSH2("100^110^120",.IEN,.ABSP,.RECORD) ;5.1 clms
;IHS/SD/lwj 8/1/02 NCPDP 5.1 create chain of segments
S DET51="130^140^150^160^170^180^190^200^210^220^230"
;
;Loop through prescription multiple
S IEN(9002313.01)=0
F D Q:'IEN(9002313.01)
.S IEN(9002313.01)=$O(^ABSPC(IEN(9002313.02),400,IEN(9002313.01)))
.Q:'IEN(9002313.01)
.;
.;Retrieve prescription information (used when executing format code)
.K ABSP(9002313.0201)
.D GETABSP3^ABSPECX0(IEN(9002313.02),IEN(9002313.01),.ABSP)
.;
.;IHS/SD/lwj 8/22/02 NCPDP 5.1 handle at least the DUR repeating flds
.D DURVALUE
.;
.D DIAGVAL ;Patch 23
.;
.;IHS/SD/lwj 9/4/03 Patch 7 V1.0 check for prior auth value if 5.1
.; if none, don't process prior auth segment (220)
.I CLMV[5 D
.. S PAFLAG=$$PAVALUE ;if no PA, don't process segment
.. S:'PAFLAG DET51="130^140^150^160^170^180^190^200^210^230"
.;
.;W $T(+0)," we have:",! ZW ABSP R ">>>",%,!
.;
.;Append group seperator character (but not in a reversal format)
. I 'REVERSAL S RECORD=RECORD_$C(29)
.;IHS/SD/lwj 08/15/02 NCPDP 5.1 - requires GS on reversal
. I (REVERSAL)&(CLMV[5) S RECORD=RECORD_$C(29)
. ;IHS/OIT/CASSEVERN/RAN - 2/9/2011 - Patch 42 New code for D.0 START
. ;BREAK
. I $G(^ABSP(9002313.99,1,"ABSPICNV"))=1 D
. . I CLMV["D" D
. . . I REVERSAL D
. . . . D EN^ABSPDB2("OUTRST",CLAIMIEN,.IEN)
. . . ELSE D EN^ABSPDB1("OUTRST",CLAIMIEN,.IEN)
. . I CLMV["5" D
. . . I REVERSAL D
. . . . D EN^ABSP5B2("OUTRST",CLAIMIEN,.IEN)
. . . ELSE D EN^ABSP5B1("OUTRST",CLAIMIEN,.IEN)
.;IHS/OIT/CASSEVERN/RAN - 2/9/2011 - Patch 42 New code for D.0 STOP
.;Assemble claim information required and optional sections
.;IHS/SD/lwj 8/1/02 nxt ln rmkd out - following 2 lines added
.;D XLOOP^ABSPECA2("30^40",.IEN,.ABSP,.RECORD)
. ELSE D
. . D:CLMV[3 XLOOP^ABSPECA2("30^40",.IEN,.ABSP,.RECORD)
. . D:CLMV[5 XLOOP^ABSPOSH2(DET51,.IEN,.ABSP,.RECORD)
Q RECORD
QERR Q:$Q "" Q
Q
DURVALUE ;NCPDP 5.1 - this subroutine will loop through the DUR/PPS repeating
; fields and load their values into the ABSP array for the claim
; generation process
;
N DURCNT,DUR
;
K ABSP(9002313.1001)
;
;we depend on the "count" since we set it when we created the clm entry
S DURCNT=$P($G(^ABSPC(IEN(9002313.02),400,IEN(9002313.01),473.01,0)),U,4)
F DUR=1:1:DURCNT D
. D GETABSP4^ABSPECX0(IEN(9002313.02),IEN(9002313.01),DUR,.ABSP)
;
Q
;
PAVALUE() ;NCPDP 5.1 - IHS/SD/lwj 9/4/03 Payors do not want the Prior Auth
; segment if there is no data on it (contrary to other segments)
; This routine will check to see if there is information for processing.
;
N ENT,PAFLAG,CLMIEN,CRXIEN,PAFLD
S CLMIEN=IEN(9002313.02)
S CRXIEN=IEN(9002313.01)
S PAFLAG=0
;
F ENT=498.01:.01:498.14 K ABSP("9002313.0201",CRXIEN,ENT)
;
D GETABSP5^ABSPECX0(CLMIEN,CRXIEN,.ABSP)
;
F ENT=498.01:.01:498.14 D
. S PAFLD=$G(ABSP("9002313.0201",CRXIEN,ENT,"I"))
. S:$L(PAFLD)>2 PAFLD=$TR($E(PAFLD,3,$L(PAFLD))," 0")
. S:PAFLD'="" PAFLAG=1
;
Q PAFLAG
;
DIAGVAL ;NCPDP 5.1 - loops through the diagnosis code repeating
; fields and loads their values into the ABSP array for the claim
; generation process
;
N DIAGCNT,DIAG
;
K ABSP(9002313.0701)
;
S DIAGCNT=$P($G(^ABSPC(IEN(9002313.02),400,IEN(9002313.01),490)),U)
Q:+$TR(DIAGCNT,"VE","")=0
S ABSP(9002313.0701,0,491,"I")=DIAGCNT ; set non-repeating field 491
F DIAG=1:1:$TR(DIAGCNT,"VE") D
. D GETABSP6^ABSPECX0(IEN(9002313.02),IEN(9002313.01),DIAG,.ABSP)
;
Q
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
+2 ;----------------------------------------------------------------------
+3 ;Assemble ASCII formatted claim submission record
+4 ;
+5 ;Input Variables: CLAIMIEN - pointer into 9002313.02
+6 ; The claim must be complete and well-constructed;
+7 ; we do some paranoical checks below.
+8 ;
+9 ; $$ Returns: - Formatted NCPDP ASCII record
+10 ;----------------------------------------------------------------------
+11 ;
+12 ;IHS/SD/lwj 8/1/02 NCPDP 5.1 changes
+13 ; These is major differences in 3.2 vs 5.1 in the actual creation
+14 ; of the claim. Of significance:
+15 ; 3.2 had 4 claim segments (hdr req, hdr opt, det req, det opt)
+16 ; 5.1 has 14 claim segments (header, patient, insurance, claim
+17 ; pharmacy provider, prescriber,
+18 ; COB, workers comp, DUR, Pricing,
+19 ; coupon, compound, prior auth,
+20 ; clinical)
+21 ;
+22 ; 3.2 required only field identifiers and separtors on optional
+23 ; fields
+24 ; 5.1 requires field identifiers and separators on all fields
+25 ; other than the header
+26 ;
+27 ; 3.2 there were no segment separators
+28 ; 5.1 segment separators are required prior to each segment
+29 ; following the header
+30 ;
+31 ; 3.2/5.1 Group seperators appear at the end of each
+32 ; transaction (prescription)
+33 ;
+34 ; The first thing added to this routine is the retrieval of the
+35 ; version from the claim file. If the version is 3.2, we will
+36 ; process just like we used to. If it is 5.1, we will alter the
+37 ; creation of the claim to include the above differences.
+38 ;
+39 ; Adjustments were also made to the reversal logic as well.
+40 ;------------------------------------------------------------
+41 ;IHS/SD/lwj 9/4/03 Patch 7 POS V1.0
+42 ; The payors do not want the Prior Authorization segment
+43 ; sent when there isn't a prior auth. This is different than
+44 ; our normal processing, which allows us to send the segment
+45 ; blank. To accomodate for this payor limitation, new logic
+46 ; was added to only process the prior authorization when
+47 ; information has been input into the PA fields.
+48 ;-----------------------------------------------------------
+49 ;IHS/SD/RLT - 06/26/07 - 10/18/07 - Patch 23
+50 ; New tag DIAGVAL for Diagnosis Code.
+51 ;
ASCII(CLAIMIEN) ;EP - from ABSPOSQH from ABSPOSQG from ABSPOSQ2
+1 NEW IEN,MABSP,RECORD,ABSP,REVERSAL,UERETVAL,CLMV,DET51,RTRNCD
+2 ;IHS/SD/lwj 09/04/03 prior values?
NEW PAFLAG
+3 ; check for good parameter
IF '$DATA(^ABSPC(CLAIMIEN,0))
Begin DoDot:1
+4 SET UERETVAL=$$IMPOSS^ABSPOSUE("DB,P","T",CLAIMIEN,,1,$TEXT(+0))
End DoDot:1
GOTO QERR
+5 ;
+6 ;Setup IEN variables (used when executing format code)
+7 SET IEN(9002313.02)=CLAIMIEN
+8 ; Point to ABSP INSURER
+9 SET IEN(9002313.4)=$PIECE($GET(^ABSPC(IEN(9002313.02),0)),U,2)
+10 ; claim must have an insurer
IF 'IEN(9002313.4)
Begin DoDot:1
+11 SET UERETVAL=$$IMPOSS^ABSPOSUE("DB,P","T",CLAIMIEN,,2,$TEXT(+0))
End DoDot:1
GOTO QERR
+12 ; Point to format
+13 SET IEN(9002313.92)=$PIECE($GET(^ABSPEI(IEN(9002313.4),100)),U,1)
+14 ; insurer must have an e-format UNLESS conversion has been run
IF ('IEN(9002313.92))&&($GET(^ABSP(9002313.99,1,"ABSPICNV"))'=1)
Begin DoDot:1
+15 SET UERETVAL=$$IMPOSS^ABSPOSUE("DB","T",CLAIMIEN,,3,$TEXT(+0))
End DoDot:1
GOTO QERR
+16 ;
+17 ;
+18 ; But if it's a reversal claim, get the format for the reversal
+19 ; IHS/SD/lwj 08/15/02 NCPDP 5.1 needed to adjust reversal a little
+20 ; RTRNCD added - original IF stmt remarked out - new one added
+21 ; 5.1 transaction code for reversal is now B2 not 11
+22 ;
+23 SET RTRNCD=$PIECE(^ABSPC(IEN(9002313.02),100),U,3)
+24 ;I $P(^ABSPC(IEN(9002313.02),100),U,3)="11" D
+25 IF (RTRNCD=11)!(RTRNCD="B2")
Begin DoDot:1
+26 SET REVERSAL=1
+27 IF $GET(IEN(9002313.92))
SET IEN(9002313.92)=$PIECE($GET(^ABSPF(9002313.92,IEN(9002313.92),"REVERSAL")),U)
+28 ; format must point to a reversal format
IF ('IEN(9002313.92))&&($GET(^ABSP(9002313.99,1,"ABSPICNV"))'=1)
Begin DoDot:2
+29 SET UERETVAL=$$IMPOSS^ABSPOSUE("DB","T",CLAIMIEN,,4,$TEXT(+0))
End DoDot:2
GOTO QERR
End DoDot:1
+30 IF '$TEST
SET REVERSAL=0
+31 ;
+32 IF ($GET(^ABSP(9002313.99,1,"ABSPICNV"))'=1)&&('$DATA(^ABSPF(9002313.92,IEN(9002313.92),0)))
Begin DoDot:1
+33 SET UERETVAL=$$IMPOSS^ABSPOSUE("P","T",CLAIMIEN,,5,$TEXT(+0))
End DoDot:1
GOTO QERR
+34 ;
+35 ;IHS/SD/lwj 8/1/02
+36 ; retrieve the version number from the claim file so we know which
+37 ; way we have to process
+38 SET CLMV=$PIECE($GET(^ABSPC(IEN(9002313.02),100)),U,2)
+39 ;
+40 ;Retrieve claim submission record (used when executing format code)
+41 DO GETABSP2^ABSPECX0(IEN(9002313.02),.ABSP)
+42 ;W $T(+0)," we have:",! ZW ABSP R ">>>",%,!
+43 ;
+44 ;If reversal find current version number from Insurance file, if different then modify
+45 IF REVERSAL
SET INSVER=$PIECE($GET(^ABSPEI(IEN(9002313.4),100)),U,15)
SET INSVER=$SELECT(INSVER=2:"D0",1:"51")
IF INSVER'=CLMV
Begin DoDot:1
+46 SET CLMV=INSVER
IF $GET(ABSP(9002313.02,CLAIMIEN,102,"I"))'=""
SET ABSP(9002313.02,CLAIMIEN,102,"I")=CLMV
+47 SET $PIECE(^ABSPC(IEN(9002313.02),100),U,2)=CLMV
End DoDot:1
+48 ;
+49 ;Assember claim header required and optional format sections
+50 SET RECORD=""
+51 ;IHS/OIT/CASSEVERN/RAN - 2/9/2011 - Patch 42 New code for D.0 START
+52 ;BREAK
+53 IF $GET(^ABSP(9002313.99,1,"ABSPICNV"))=1
Begin DoDot:1
+54 IF CLMV["D"
Begin DoDot:2
+55 IF REVERSAL
Begin DoDot:3
+56 DO EN^ABSPDB2("OUTHD",CLAIMIEN,.IEN)
End DoDot:3
+57 IF '$TEST
DO EN^ABSPDB1("OUTHD",CLAIMIEN,.IEN)
End DoDot:2
+58 IF CLMV["5"
Begin DoDot:2
+59 IF REVERSAL
Begin DoDot:3
+60 DO EN^ABSP5B2("OUTHD",CLAIMIEN,.IEN)
End DoDot:3
+61 IF '$TEST
DO EN^ABSP5B1("OUTHD",CLAIMIEN,.IEN)
End DoDot:2
End DoDot:1
+62 ;IHS/OIT/CASSEVERN/RAN - 2/9/2011 - Patch 42 New code for D.0 STOP
+63 IF '$TEST
Begin DoDot:1
+64 ;IHS/SD/lwj 8/1/02 nxt line remvd, following 2 lines added for 5.1 chgs
+65 ;D XLOOP^ABSPECA2("10^20",.IEN,.ABSP,.RECORD)
+66 ;3.2 clms
IF CLMV[3
DO XLOOP^ABSPECA2("10^20",.IEN,.ABSP,.RECORD)
+67 ;5.1 clms
IF CLMV[5
DO XLOOP^ABSPOSH2("100^110^120",.IEN,.ABSP,.RECORD)
End DoDot:1
+68 ;IHS/SD/lwj 8/1/02 NCPDP 5.1 create chain of segments
+69 SET DET51="130^140^150^160^170^180^190^200^210^220^230"
+70 ;
+71 ;Loop through prescription multiple
+72 SET IEN(9002313.01)=0
+73 FOR
Begin DoDot:1
+74 SET IEN(9002313.01)=$ORDER(^ABSPC(IEN(9002313.02),400,IEN(9002313.01)))
+75 IF 'IEN(9002313.01)
QUIT
+76 ;
+77 ;Retrieve prescription information (used when executing format code)
+78 KILL ABSP(9002313.0201)
+79 DO GETABSP3^ABSPECX0(IEN(9002313.02),IEN(9002313.01),.ABSP)
+80 ;
+81 ;IHS/SD/lwj 8/22/02 NCPDP 5.1 handle at least the DUR repeating flds
+82 DO DURVALUE
+83 ;
+84 ;Patch 23
DO DIAGVAL
+85 ;
+86 ;IHS/SD/lwj 9/4/03 Patch 7 V1.0 check for prior auth value if 5.1
+87 ; if none, don't process prior auth segment (220)
+88 IF CLMV[5
Begin DoDot:2
+89 ;if no PA, don't process segment
SET PAFLAG=$$PAVALUE
+90 IF 'PAFLAG
SET DET51="130^140^150^160^170^180^190^200^210^230"
End DoDot:2
+91 ;
+92 ;W $T(+0)," we have:",! ZW ABSP R ">>>",%,!
+93 ;
+94 ;Append group seperator character (but not in a reversal format)
+95 IF 'REVERSAL
SET RECORD=RECORD_$CHAR(29)
+96 ;IHS/SD/lwj 08/15/02 NCPDP 5.1 - requires GS on reversal
+97 IF (REVERSAL)&(CLMV[5)
SET RECORD=RECORD_$CHAR(29)
+98 ;IHS/OIT/CASSEVERN/RAN - 2/9/2011 - Patch 42 New code for D.0 START
+99 ;BREAK
+100 IF $GET(^ABSP(9002313.99,1,"ABSPICNV"))=1
Begin DoDot:2
+101 IF CLMV["D"
Begin DoDot:3
+102 IF REVERSAL
Begin DoDot:4
+103 DO EN^ABSPDB2("OUTRST",CLAIMIEN,.IEN)
End DoDot:4
+104 IF '$TEST
DO EN^ABSPDB1("OUTRST",CLAIMIEN,.IEN)
End DoDot:3
+105 IF CLMV["5"
Begin DoDot:3
+106 IF REVERSAL
Begin DoDot:4
+107 DO EN^ABSP5B2("OUTRST",CLAIMIEN,.IEN)
End DoDot:4
+108 IF '$TEST
DO EN^ABSP5B1("OUTRST",CLAIMIEN,.IEN)
End DoDot:3
End DoDot:2
+109 ;IHS/OIT/CASSEVERN/RAN - 2/9/2011 - Patch 42 New code for D.0 STOP
+110 ;Assemble claim information required and optional sections
+111 ;IHS/SD/lwj 8/1/02 nxt ln rmkd out - following 2 lines added
+112 ;D XLOOP^ABSPECA2("30^40",.IEN,.ABSP,.RECORD)
+113 IF '$TEST
Begin DoDot:2
+114 IF CLMV[3
DO XLOOP^ABSPECA2("30^40",.IEN,.ABSP,.RECORD)
+115 IF CLMV[5
DO XLOOP^ABSPOSH2(DET51,.IEN,.ABSP,.RECORD)
End DoDot:2
End DoDot:1
IF 'IEN(9002313.01)
QUIT
+116 QUIT RECORD
QERR IF $QUIT
QUIT ""
QUIT
+1 QUIT
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
+2 ; generation process
+3 ;
+4 NEW DURCNT,DUR
+5 ;
+6 KILL ABSP(9002313.1001)
+7 ;
+8 ;we depend on the "count" since we set it when we created the clm entry
+9 SET DURCNT=$PIECE($GET(^ABSPC(IEN(9002313.02),400,IEN(9002313.01),473.01,0)),U,4)
+10 FOR DUR=1:1:DURCNT
Begin DoDot:1
+11 DO GETABSP4^ABSPECX0(IEN(9002313.02),IEN(9002313.01),DUR,.ABSP)
End DoDot:1
+12 ;
+13 QUIT
+14 ;
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)
+2 ; This routine will check to see if there is information for processing.
+3 ;
+4 NEW ENT,PAFLAG,CLMIEN,CRXIEN,PAFLD
+5 SET CLMIEN=IEN(9002313.02)
+6 SET CRXIEN=IEN(9002313.01)
+7 SET PAFLAG=0
+8 ;
+9 FOR ENT=498.01:.01:498.14
KILL ABSP("9002313.0201",CRXIEN,ENT)
+10 ;
+11 DO GETABSP5^ABSPECX0(CLMIEN,CRXIEN,.ABSP)
+12 ;
+13 FOR ENT=498.01:.01:498.14
Begin DoDot:1
+14 SET PAFLD=$GET(ABSP("9002313.0201",CRXIEN,ENT,"I"))
+15 IF $LENGTH(PAFLD)>2
SET PAFLD=$TRANSLATE($EXTRACT(PAFLD,3,$LENGTH(PAFLD))," 0")
+16 IF PAFLD'=""
SET PAFLAG=1
End DoDot:1
+17 ;
+18 QUIT PAFLAG
+19 ;
DIAGVAL ;NCPDP 5.1 - loops through the diagnosis code repeating
+1 ; fields and loads their values into the ABSP array for the claim
+2 ; generation process
+3 ;
+4 NEW DIAGCNT,DIAG
+5 ;
+6 KILL ABSP(9002313.0701)
+7 ;
+8 SET DIAGCNT=$PIECE($GET(^ABSPC(IEN(9002313.02),400,IEN(9002313.01),490)),U)
+9 IF +$TRANSLATE(DIAGCNT,"VE","")=0
QUIT
+10 ; set non-repeating field 491
SET ABSP(9002313.0701,0,491,"I")=DIAGCNT
+11 FOR DIAG=1:1:$TRANSLATE(DIAGCNT,"VE")
Begin DoDot:1
+12 DO GETABSP6^ABSPECX0(IEN(9002313.02),IEN(9002313.01),DIAG,.ABSP)
End DoDot:1
+13 ;
+14 QUIT
