ABSPECX1 ; IHS/FCS/DRS - JWS 03:35 PM 6 Jun 1995 ; [ 09/12/2002 10:00 AM ]
;;1.0;PHARMACY POINT OF SALE;**3,42**;JUN 21, 2001;Build 38
;----------------------------------------------------------------------
;Create new Claim ID for Claim Submission file (9002313.02)
;
;Input Variables: NRDEFIEN - NCPDP Record Definitions IEN
; (9002313.92)
;
;Function Returns: String: C<YY>-<BBBBBB>-<NNNNN>
; C can also be P or other ORIGIN code.
; See remarks a few lines below about ORIGIN
; Where: <YY> is the year
; <BBBBBB> is the BIN number of the payor
; <NNNNN> is a 5-digit sequence number
;----------------------------------------------------------------------
; Also called from old Alaska Medicaid batch method,
; regrettably still in use at one site, but we're going to
; phase it out someday.
;
; ORIGIN argument added 08/23/2000
; Can specify the leading character of the claim ID.
; Defaults to "C".
; Point of sale sends in "P"
; 09/20/2000 - can override by setting ABSPECX1("PREFIX")=letter
; (Do this if you change the batch file to submit via POS)
;
; Also changed 08/23/2000: Sequence number is now 6 digits
; and the first number assigned is 100000. As of yesterday, ANMC
; is already up to almost 40000.
; Can't change length in the middle of the year or the $O(,-1) is
; messed up. So the code will adapt - if it finds 5-digit format
; already there, it will assign new numbers with 5 digits.
;
CLAIMID(NRDEFIEN,ORIGIN) ;EP - Called from ABSPOSCE from ABSPOSCA from ABSPOSQG from ABSPOSQ2
N BIN,SEQNUM,ROOT,LAST
I '$D(ORIGIN) S ORIGIN="C"
I $G(ABSPECX1("PREFIX"))?1U S ORIGIN=ABSPECX1("PREFIX")
;IHS/OIT/CASSEVER/RAN patch 42 03/30/2011 For new claims process
;Get and format BIN number for the electronic payor
I NRDEFIEN=1 S BIN=$P(^ABSPEI(ABSP("Insurer","IEN"),100),U,16)
ELSE S BIN=$P($G(^ABSPF(9002313.92,NRDEFIEN,1)),U,1)
S BIN=$$NFF^ABSPECFM(BIN,6)
;
;Establish the root for the claim id number
S ROOT=ORIGIN_$E(DT,2,3)_"-"_BIN_"-" ; 11 characters long
;
;Get last claim id number with the same root
S LAST=$O(^ABSPC("B",ROOT_"Z"),-1)
; Reversal claim ID? Get rid of the suffix R#
; ABSP*1.0T7*6 could be #>9, in which case the old logic fails!
; ABSP*1.0T7*6 replaced the line that strips off the R#
;I $L(LAST)>6,LAST?.E1"R"1N S LAST=$E(LAST,1,$L(LAST)-2) ;ABSP*1.0T7*6
I $L(LAST)>6,LAST?.E1"R"1.N S $P(LAST,"-",3)=+$P(LAST,"-",3) ;ABSP*1.0T7*6
;
;Set and format sequence number
S SEQNUM=$S($E(LAST,1,11)=ROOT:(+$P(LAST,"-",3))+1,1:0)
N SEQLEN
; 5 or 6 digit numbers? Depends on what's there already?
; Six digits is what we really want, but upgrades will be trickier.
; New installs and ANMC 2001 will have 6 digits.
;
I SEQNUM=0 S SEQLEN=6,SEQNUM=100000
E S SEQLEN=$L($P(LAST,"-",3))
I SEQLEN<5 D IMPOSS^ABSPOSUE("DB,P","TI",LAST,,"SEQLEN<5",$T(+0)) ; internal error
I SEQLEN>6 D IMPOSS^ABSPOSUE("DB,P","TI",LAST,,"SEQLEN>6",$T(+0)) ; internal error
I $L(SEQNUM)=SEQLEN,SEQNUM?."9" D
. D IMPOSS^ABSPOSUE("DB,P","T",LAST,,"OVERFLOWED!",$T(+0))
I SEQLEN=5 S SEQNUM=$TR($J(SEQNUM,SEQLEN)," ","0") ; pad w/leading 0s
I $L(SEQNUM)'=SEQLEN D ; internal error
. D IMPOSS^ABSPOSUE("DB,P","TI",LAST,SEQLEN,"length",$T(+0))
;
Q ROOT_SEQNUM
ABSPECX1 ; IHS/FCS/DRS - JWS 03:35 PM 6 Jun 1995 ; [ 09/12/2002 10:00 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3,42**;JUN 21, 2001;Build 38
+2 ;----------------------------------------------------------------------
+3 ;Create new Claim ID for Claim Submission file (9002313.02)
+4 ;
+5 ;Input Variables: NRDEFIEN - NCPDP Record Definitions IEN
+6 ; (9002313.92)
+7 ;
+8 ;Function Returns: String: C<YY>-<BBBBBB>-<NNNNN>
+9 ; C can also be P or other ORIGIN code.
+10 ; See remarks a few lines below about ORIGIN
+11 ; Where: <YY> is the year
+12 ; <BBBBBB> is the BIN number of the payor
+13 ; <NNNNN> is a 5-digit sequence number
+14 ;----------------------------------------------------------------------
+15 ; Also called from old Alaska Medicaid batch method,
+16 ; regrettably still in use at one site, but we're going to
+17 ; phase it out someday.
+18 ;
+19 ; ORIGIN argument added 08/23/2000
+20 ; Can specify the leading character of the claim ID.
+21 ; Defaults to "C".
+22 ; Point of sale sends in "P"
+23 ; 09/20/2000 - can override by setting ABSPECX1("PREFIX")=letter
+24 ; (Do this if you change the batch file to submit via POS)
+25 ;
+26 ; Also changed 08/23/2000: Sequence number is now 6 digits
+27 ; and the first number assigned is 100000. As of yesterday, ANMC
+28 ; is already up to almost 40000.
+29 ; Can't change length in the middle of the year or the $O(,-1) is
+30 ; messed up. So the code will adapt - if it finds 5-digit format
+31 ; already there, it will assign new numbers with 5 digits.
+32 ;
CLAIMID(NRDEFIEN,ORIGIN) ;EP - Called from ABSPOSCE from ABSPOSCA from ABSPOSQG from ABSPOSQ2
+1 NEW BIN,SEQNUM,ROOT,LAST
+2 IF '$DATA(ORIGIN)
SET ORIGIN="C"
+3 IF $GET(ABSPECX1("PREFIX"))?1U
SET ORIGIN=ABSPECX1("PREFIX")
+4 ;IHS/OIT/CASSEVER/RAN patch 42 03/30/2011 For new claims process
+5 ;Get and format BIN number for the electronic payor
+6 IF NRDEFIEN=1
SET BIN=$PIECE(^ABSPEI(ABSP("Insurer","IEN"),100),U,16)
+7 IF '$TEST
SET BIN=$PIECE($GET(^ABSPF(9002313.92,NRDEFIEN,1)),U,1)
+8 SET BIN=$$NFF^ABSPECFM(BIN,6)
+9 ;
+10 ;Establish the root for the claim id number
+11 ; 11 characters long
SET ROOT=ORIGIN_$EXTRACT(DT,2,3)_"-"_BIN_"-"
+12 ;
+13 ;Get last claim id number with the same root
+14 SET LAST=$ORDER(^ABSPC("B",ROOT_"Z"),-1)
+15 ; Reversal claim ID? Get rid of the suffix R#
+16 ; ABSP*1.0T7*6 could be #>9, in which case the old logic fails!
+17 ; ABSP*1.0T7*6 replaced the line that strips off the R#
+18 ;I $L(LAST)>6,LAST?.E1"R"1N S LAST=$E(LAST,1,$L(LAST)-2) ;ABSP*1.0T7*6
+19 ;ABSP*1.0T7*6
IF $LENGTH(LAST)>6
IF LAST?.E1"R"1.N
SET $PIECE(LAST,"-",3)=+$PIECE(LAST,"-",3)
+20 ;
+21 ;Set and format sequence number
+22 SET SEQNUM=$SELECT($EXTRACT(LAST,1,11)=ROOT:(+$PIECE(LAST,"-",3))+1,1:0)
+23 NEW SEQLEN
+24 ; 5 or 6 digit numbers? Depends on what's there already?
+25 ; Six digits is what we really want, but upgrades will be trickier.
+26 ; New installs and ANMC 2001 will have 6 digits.
+27 ;
+28 IF SEQNUM=0
SET SEQLEN=6
SET SEQNUM=100000
+29 IF '$TEST
SET SEQLEN=$LENGTH($PIECE(LAST,"-",3))
+30 ; internal error
IF SEQLEN<5
DO IMPOSS^ABSPOSUE("DB,P","TI",LAST,,"SEQLEN<5",$TEXT(+0))
+31 ; internal error
IF SEQLEN>6
DO IMPOSS^ABSPOSUE("DB,P","TI",LAST,,"SEQLEN>6",$TEXT(+0))
+32 IF $LENGTH(SEQNUM)=SEQLEN
IF SEQNUM?."9"
Begin DoDot:1
+33 DO IMPOSS^ABSPOSUE("DB,P","T",LAST,,"OVERFLOWED!",$TEXT(+0))
End DoDot:1
+34 ; pad w/leading 0s
IF SEQLEN=5
SET SEQNUM=$TRANSLATE($JUSTIFY(SEQNUM,SEQLEN)," ","0")
+35 ; internal error
IF $LENGTH(SEQNUM)'=SEQLEN
Begin DoDot:1
+36 DO IMPOSS^ABSPOSUE("DB,P","TI",LAST,SEQLEN,"length",$TEXT(+0))
End DoDot:1
+37 ;
+38 QUIT ROOT_SEQNUM
