ABSPECA8 ; IHS/FCS/DRS - construct a claim reversal ; [ 11/18/2002 10:07 AM ]
;;1.0;PHARMACY POINT OF SALE;**3,4,7,9,10,12,43**;JUN 21, 2001;Build 38
Q
; The way we build the claim reversal is to take the source data
; from the original claim (IEN) and position therein (RX).
; $$ returns pointer to 9002313.02 of the new entry.
;
; Future: want to use new database server calls to create the
; 9002313.02 entry. It would be soooo much cleaner.
;
; Remember, you have two 401 fields - one in header, one in prescript.
;
;IHS/SD/lwj 08/15/02 NCPDP 5.1 changes
; There are new fields to consider in the 5.1 reversal process, in
; addition to a new value for the transaction code (noe B2 as opposed
; to 11 in 3.2).
; Changes made as needed.
;
;IHS/SD/lwj 10/23/02 NCPDP 5.1 changes
; New code added to account for a mixed reversal. A mixed reversal is
; a claim that was created in 3.x format & needs to be reversed in 5.1
; format. This requires field reformatting.
;
;--------------------------------------------------------
;IHS/SD/lwj 10/08/03 ACS requires new flds for the reversal.
; (ACS currently processes for Nebraska Medicaid, New Mexico
; Medicaid, Colorado Medicaid, Washington Medicaid and
; Mississippi Medicaid.)
; Needed to add fields 301, 302, 306, 309, 312, 313 405, 406,
; 414, and 442 to the reversal process.
;--------------------------------------------------------
;IHS/SD/lwj 1/16/03 NCPDP 5.1 changes Patch 9
; New code added to account for newer reversal requirements
; for Catalyst Rx and Medtrak.
; Fields 303, 304, 305, 310 and 311 added.
;--------------------------------------------------------
;IHS/SD/lwj 3/16/04 patch 10 NCPDP 5.1 changes
; Two new fields needed for the reversal process at the
; "detail" level - fields are 461 and 462.
; (Used on Procare format.)
;--------------------------------------------------------
;IHS/SD/lwj 6/23/05 patch 12 NCPDP 5.1 changes
; 331 patient id qualifier 332 patient id
; added for NMHCRX reversals
;--------------------------------------------------------
REVERSE(IEN,RX) ;EP - from ABSPOS6D, ABSPOSC2
; IEN=original claim, RX = prescription # subscript therein
; returns IEN of the reversal claim created
;
; extract needed data
N CLAIM,RXMULT S CLAIM=9002313.02,RXMULT=9002313.0201 ; file #s
N DIC,DR,DA,DIQ,TMP,I,X
; This field list is repeated below.
S DIC=CLAIM
;
;IHS/SD/lwj 1/16/03 new fields needed for Catalyst RX and Medtrak 5.1
; nxt line remarked out, following line added (patch 9)
;S DR=".01;.02;.03;1.01;1.02;1.03;101;102;103;104;109;110;201;202;301;302;306;309;312;313;400;401"
; IHS/SD/lwj 6/23/05 patch 12 nxt ln rmkd out, following added
;S DR=".01;.02;.03;1.01;1.02;1.03;101;102;103;104;109;110;201;202;301;302;303;304;305;306;309;310;311;312;313;400;401"
S DR=".01;.02;.03;1.01;1.02;1.03;101;102;103;104;109;110;201;202;301;302;303;304;305;306;309;310;311;312;313;331;332;400;401"
S DA=IEN
S DIQ="TMP",DIQ(0)="I"
; This field list is repeated below.
; It needs to include all the fields that are used in any reversal
; format anywhere.
;
;IHS/SD/lwj 8/15/02 NCPDP 5.1 new fields need to be used
; nxt line remarked out, following 2 lines added
;S DR(RXMULT)=".01;401;402;418;438;439;440;441",DA(RXMULT)=RX
;
;IHS/SD/lwj 10/08/03 new flds needed for NB Medicaid reversal
;nxt line remarked out, following added - flds 405/406/414,442
;S DR(RXMULT)=".01;308;401;402;403;407;418;420;436;438;439;440;441;455"
;IHS/SD/lwj 03/16/04 patch 10 nxt line remkd out, next line added
;S DR(RXMULT)=".01;308;401;402;403;405;406;407;414;418;420;436;438;439;440;441;442;455"
S DR(RXMULT)=".01;308;401;402;403;405;406;407;414;418;420;436;438;439;440;441;442;455;461;462"
S DA(RXMULT)=RX
;ZW DIC,DR,DA,DIQ
D EN^DIQ1
;
;IHS/SD/lwj 10/23/02 NCPDP 5.1 changes
; check for a mixed claim (3.x claim - 5.1 reversal)-reformat if needed
;
D:TMP(CLAIM,IEN,102,"I")[3 CKVERS
;
;IHS/CAS/RCS 08292012 - Patch 44, Check if orignal claim 5.1 and current D.0
D:TMP(CLAIM,IEN,102,"I")[5 CKVERSD
;
;IHS/SD/lwj 10/23/02 end mixed claim check
;
;ZW TMP
; create a new 9002313.02 record
N DIC,X,DLAYGO,REVIEN,Y,UERETVAL
R2 S DIC=9002313.02,DIC(0)="LX",X=TMP(9002313.02,IEN,.01,"I")_"R"_RX
S DLAYGO=CLAIM
D ^DIC S REVIEN=+Y I REVIEN<1 D G:UERETVAL R2
. S UERETVAL=$$IMPOSS^ABSPOSUE("FM,P",,"call to ^DIC",,,$T(+0))
;ZW REVIEN
R4 ; create a new prescription multiple therein
S DIC="^ABSPC("_REVIEN_",400,",DIC(0)="LX"
S DIC("P")=$P(^DD(CLAIM,400,0),U,2)
S DA(1)=REVIEN,DLAYGO=RXMULT
S X=1 D ^DIC I +Y'=1 D G:UERETVAL R4
. S UERETVAL=$$IMPOSS^ABSPOSUE("FM,P",,"call to ^DIC","for multiple",,$T(+0))
;ZW Y
; set data values
N DIE
S DIE=CLAIM,DA=REVIEN
S TMP(CLAIM,IEN,103,"I")=11 ; change transaction code to REVERSAL
;
;IHS/SD/lwj 8/15/02 NCPDP 5.1 changes
; if the version is 5.1, the transaction code needs to be B2 not 11
; following line added
;IHS/OIT/CASSEVERN/RCS patch43 4/18/2012 Include D.0 version
;S:TMP(CLAIM,IEN,102,"I")[5 TMP(CLAIM,IEN,103,"I")="B2"
S:TMP(CLAIM,IEN,102,"I")'[3 TMP(CLAIM,IEN,103,"I")="B2"
;
;IHS/SD/lwj 11/18/02 NCPDP 5.1 changes
; when it's a 5.1 reversal, we ALWAYS want the transaction code
; (fld 109) to be a 1 - ALWAYS
; next line added
;IHS/OIT/CASSEVERN/RCS patch43 4/18/2012 Include D.0 version
;S:TMP(CLAIM,IEN,102,"I")[5 TMP(CLAIM,IEN,109,"I")=1
S:TMP(CLAIM,IEN,102,"I")'[3 TMP(CLAIM,IEN,109,"I")=1
;
; Must agree with field list above.
;IHS/SD/lwj 8/15/02 NCPDP 5.1 new fields need to be used
; nxt line remarked out, following 2 lines added
;
;S DR="" N I F I=.02,.03,1.01,1.02,1.03,101,102,103,104,201,401 D
S DR="" N I
;
;IHS/SD/lwj 10/08/03 new flds for NB Medicaid
; nxt line remarked out - following line added
;F I=.02,.03,1.01,1.02,1.03,101,102,103,104,109,110,201,202,401 D
;IHS/SD/lwj 1/16/03 new fields for Catalyst and Medtrak
; nxt line remarked out - following line added patch 9
;F I=.02,.03,1.01,1.02,1.03,101,102,103,104,109,110,201,202,301,302,306,309,312,313,401 D
;IHS/SD/lwj 6/23/05 patch 12 nxt ln rmkd out, following added
;F I=.02,.03,1.01,1.02,1.03,101,102,103,104,109,110,201,202,301,302,303,304,305,306,309,310,311,312,313,401 D
F I=.02,.03,1.01,1.02,1.03,101,102,103,104,109,110,201,202,301,302,303,304,305,306,309,310,311,312,313,331,332,401 D
.S DR=DR_I_"////"_TMP(CLAIM,IEN,I,"I")_";"
S DR=DR_".04////2" ; transmit flag - it's 2 for POS
D ^DIE
S DIE="^ABSPC("_REVIEN_",400,"
S DA(1)=REVIEN,DA=1,DR=""
; Must agree with field list above
;IHS/SD/lwj 8/15/02 NCPDP 5.1 new fields need to be used
; nxt line remarked out, following 2 lines added
;
;F I=401,402,418,438,439,440,441 D
;IHS/SD/lwj 10/08/03 new flds needed for NB Medicaid
;nxt line rmked out, following added (flds 405/406/414/442)
;F I=308,401,402,403,407,418,420,436,438,439,440,441,455 D
;IHS/SD/lwj 3/16/04 patch 10 nxt line remkd out, line added
;F I=308,401,402,403,405,406,407,414,418,420,436,438,439,440,441,442,455 D
F I=308,401,402,403,405,406,407,414,418,420,436,438,439,440,441,442,455,461,462 D
.S DR=DR_I_"////"_TMP(RXMULT,RX,I,"I")_";"
S DR=$E(DR,1,$L(DR)-1) ; get rid of extra trailing ";"
D ^DIE
;
Q REVIEN
;
CKVERS ;check the version of the current format - if it's 5.1 then we've hit a
; "mixed claim." (Originally created in 3.2 - reverse in 5.1)
;
N ABSPINS,ABSPFORM,ABSPVER,ABSPCFRM
S (ABSPINS,ABSPFORM,ABSPVER,ABSPCFRM)=""
;
S ABSPINS=TMP(9002313.02,IEN,.02,"I")
Q:ABSPINS=""
;
S ABSPCFRM=$P($G(^ABSPEI(ABSPINS,100)),U) ;claim format
Q:ABSPCFRM=""
;
S ABSPFORM=$P($G(^ABSPF(9002313.92,ABSPCFRM,"REVERSAL")),U)
Q:ABSPFORM=""
;
S ABSPVER=$P($G(^ABSPF(9002313.92,ABSPFORM,1)),U,2)
I ABSPVER[5 D
. S TMP(9002313.02,IEN,102,"I")=51
. D REFORM^ABSPOSHR(ABSPFORM)
;
Q
;
CKVERSD ;IHS/CAS/RCS 08292012 - Patch 44, new code section - HEAT # 74630
;check the version of current Insurer - if it's D.0 then it's a "mixed claim."
;(Originally created in 5.1 - reverse in D.0)
;Modify field 110 if needed (Certification #)
;
N ABSPINS,ABSPVER,ABSPPNT,X,Y,ABSPX,RXPNT,PHARMACY,ABSP
S ABSPINS=TMP(9002313.02,IEN,.02,"I")
Q:ABSPINS=""
;
S RXPNT=$P(D,U)
Q:RXPNT=""
;
S ABSPVER=$P($G(^ABSPEI(ABSPINS,100)),U,15) ;current Insurer version
I ABSPVER=2 D ;The current insurer is D.0
. S ABSPPNT=$O(^ABSPEI(ABSPINS,210,"B",75,"")) I ABSPPNT="" Q ;Find Special code for NCPDP field 110
. S Y=$G(^ABSPEI(ABSPINS,210,ABSPPNT,210)) I Y="" Q
. S PHARMACY=$P(^ABSPT(RXPNT,1),U,7)
. I $D(^ABSP(9002313.56,PHARMACY,"INSURER-ASSIGNED #","B",ABSPINS)) D ;setup special code variable
. . S X=$O(^ABSP(9002313.56,PHARMACY,"INSURER-ASSIGNED #","B",ABSPINS,0))
. . S ABSP("Site","MED-CAL Subscriber #")=$P(^ABSP(9002313.56,PHARMACY,"INSURER-ASSIGNED #",X,0),U,3)
. . S ABSP("Site","CA FAMILY PACT ID")=$P(^ABSP(9002313.56,PHARMACY,"INSURER-ASSIGNED #",X,0),U,4)
. S ABSPX=$P(Y,U,2) I ABSPX="" S TMP(9002313.02,IEN,110,"I")=" " Q ;Cert # currently null
. X ABSPX ;Execute special code for field 110
. S ABSP("X")=$$ANFF^ABSPECFM($G(ABSP("X")),10)
. S TMP(9002313.02,IEN,110,"I")=ABSP("X") ;Set field 110 - Certification #
Q
ABSPECA8 ; IHS/FCS/DRS - construct a claim reversal ; [ 11/18/2002 10:07 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3,4,7,9,10,12,43**;JUN 21, 2001;Build 38
+2 QUIT
+3 ; The way we build the claim reversal is to take the source data
+4 ; from the original claim (IEN) and position therein (RX).
+5 ; $$ returns pointer to 9002313.02 of the new entry.
+6 ;
+7 ; Future: want to use new database server calls to create the
+8 ; 9002313.02 entry. It would be soooo much cleaner.
+9 ;
+10 ; Remember, you have two 401 fields - one in header, one in prescript.
+11 ;
+12 ;IHS/SD/lwj 08/15/02 NCPDP 5.1 changes
+13 ; There are new fields to consider in the 5.1 reversal process, in
+14 ; addition to a new value for the transaction code (noe B2 as opposed
+15 ; to 11 in 3.2).
+16 ; Changes made as needed.
+17 ;
+18 ;IHS/SD/lwj 10/23/02 NCPDP 5.1 changes
+19 ; New code added to account for a mixed reversal. A mixed reversal is
+20 ; a claim that was created in 3.x format & needs to be reversed in 5.1
+21 ; format. This requires field reformatting.
+22 ;
+23 ;--------------------------------------------------------
+24 ;IHS/SD/lwj 10/08/03 ACS requires new flds for the reversal.
+25 ; (ACS currently processes for Nebraska Medicaid, New Mexico
+26 ; Medicaid, Colorado Medicaid, Washington Medicaid and
+27 ; Mississippi Medicaid.)
+28 ; Needed to add fields 301, 302, 306, 309, 312, 313 405, 406,
+29 ; 414, and 442 to the reversal process.
+30 ;--------------------------------------------------------
+31 ;IHS/SD/lwj 1/16/03 NCPDP 5.1 changes Patch 9
+32 ; New code added to account for newer reversal requirements
+33 ; for Catalyst Rx and Medtrak.
+34 ; Fields 303, 304, 305, 310 and 311 added.
+35 ;--------------------------------------------------------
+36 ;IHS/SD/lwj 3/16/04 patch 10 NCPDP 5.1 changes
+37 ; Two new fields needed for the reversal process at the
+38 ; "detail" level - fields are 461 and 462.
+39 ; (Used on Procare format.)
+40 ;--------------------------------------------------------
+41 ;IHS/SD/lwj 6/23/05 patch 12 NCPDP 5.1 changes
+42 ; 331 patient id qualifier 332 patient id
+43 ; added for NMHCRX reversals
+44 ;--------------------------------------------------------
REVERSE(IEN,RX) ;EP - from ABSPOS6D, ABSPOSC2
+1 ; IEN=original claim, RX = prescription # subscript therein
+2 ; returns IEN of the reversal claim created
+3 ;
+4 ; extract needed data
+5 ; file #s
NEW CLAIM,RXMULT
SET CLAIM=9002313.02
SET RXMULT=9002313.0201
+6 NEW DIC,DR,DA,DIQ,TMP,I,X
+7 ; This field list is repeated below.
+8 SET DIC=CLAIM
+9 ;
+10 ;IHS/SD/lwj 1/16/03 new fields needed for Catalyst RX and Medtrak 5.1
+11 ; nxt line remarked out, following line added (patch 9)
+12 ;S DR=".01;.02;.03;1.01;1.02;1.03;101;102;103;104;109;110;201;202;301;302;306;309;312;313;400;401"
+13 ; IHS/SD/lwj 6/23/05 patch 12 nxt ln rmkd out, following added
+14 ;S DR=".01;.02;.03;1.01;1.02;1.03;101;102;103;104;109;110;201;202;301;302;303;304;305;306;309;310;311;312;313;400;401"
+15 SET DR=".01;.02;.03;1.01;1.02;1.03;101;102;103;104;109;110;201;202;301;302;303;304;305;306;309;310;311;312;313;331;332;400;401"
+16 SET DA=IEN
+17 SET DIQ="TMP"
SET DIQ(0)="I"
+18 ; This field list is repeated below.
+19 ; It needs to include all the fields that are used in any reversal
+20 ; format anywhere.
+21 ;
+22 ;IHS/SD/lwj 8/15/02 NCPDP 5.1 new fields need to be used
+23 ; nxt line remarked out, following 2 lines added
+24 ;S DR(RXMULT)=".01;401;402;418;438;439;440;441",DA(RXMULT)=RX
+25 ;
+26 ;IHS/SD/lwj 10/08/03 new flds needed for NB Medicaid reversal
+27 ;nxt line remarked out, following added - flds 405/406/414,442
+28 ;S DR(RXMULT)=".01;308;401;402;403;407;418;420;436;438;439;440;441;455"
+29 ;IHS/SD/lwj 03/16/04 patch 10 nxt line remkd out, next line added
+30 ;S DR(RXMULT)=".01;308;401;402;403;405;406;407;414;418;420;436;438;439;440;441;442;455"
+31 SET DR(RXMULT)=".01;308;401;402;403;405;406;407;414;418;420;436;438;439;440;441;442;455;461;462"
+32 SET DA(RXMULT)=RX
+33 ;ZW DIC,DR,DA,DIQ
+34 DO EN^DIQ1
+35 ;
+36 ;IHS/SD/lwj 10/23/02 NCPDP 5.1 changes
+37 ; check for a mixed claim (3.x claim - 5.1 reversal)-reformat if needed
+38 ;
+39 IF TMP(CLAIM,IEN,102,"I")[3
DO CKVERS
+40 ;
+41 ;IHS/CAS/RCS 08292012 - Patch 44, Check if orignal claim 5.1 and current D.0
+42 IF TMP(CLAIM,IEN,102,"I")[5
DO CKVERSD
+43 ;
+44 ;IHS/SD/lwj 10/23/02 end mixed claim check
+45 ;
+46 ;ZW TMP
+47 ; create a new 9002313.02 record
+48 NEW DIC,X,DLAYGO,REVIEN,Y,UERETVAL
R2 SET DIC=9002313.02
SET DIC(0)="LX"
SET X=TMP(9002313.02,IEN,.01,"I")_"R"_RX
+1 SET DLAYGO=CLAIM
+2 DO ^DIC
SET REVIEN=+Y
IF REVIEN<1
Begin DoDot:1
+3 SET UERETVAL=$$IMPOSS^ABSPOSUE("FM,P",,"call to ^DIC",,,$TEXT(+0))
End DoDot:1
IF UERETVAL
GOTO R2
+4 ;ZW REVIEN
R4 ; create a new prescription multiple therein
+1 SET DIC="^ABSPC("_REVIEN_",400,"
SET DIC(0)="LX"
+2 SET DIC("P")=$PIECE(^DD(CLAIM,400,0),U,2)
+3 SET DA(1)=REVIEN
SET DLAYGO=RXMULT
+4 SET X=1
DO ^DIC
IF +Y'=1
Begin DoDot:1
+5 SET UERETVAL=$$IMPOSS^ABSPOSUE("FM,P",,"call to ^DIC","for multiple",,$TEXT(+0))
End DoDot:1
IF UERETVAL
GOTO R4
+6 ;ZW Y
+7 ; set data values
+8 NEW DIE
+9 SET DIE=CLAIM
SET DA=REVIEN
+10 ; change transaction code to REVERSAL
SET TMP(CLAIM,IEN,103,"I")=11
+11 ;
+12 ;IHS/SD/lwj 8/15/02 NCPDP 5.1 changes
+13 ; if the version is 5.1, the transaction code needs to be B2 not 11
+14 ; following line added
+15 ;IHS/OIT/CASSEVERN/RCS patch43 4/18/2012 Include D.0 version
+16 ;S:TMP(CLAIM,IEN,102,"I")[5 TMP(CLAIM,IEN,103,"I")="B2"
+17 IF TMP(CLAIM,IEN,102,"I")'[3
SET TMP(CLAIM,IEN,103,"I")="B2"
+18 ;
+19 ;IHS/SD/lwj 11/18/02 NCPDP 5.1 changes
+20 ; when it's a 5.1 reversal, we ALWAYS want the transaction code
+21 ; (fld 109) to be a 1 - ALWAYS
+22 ; next line added
+23 ;IHS/OIT/CASSEVERN/RCS patch43 4/18/2012 Include D.0 version
+24 ;S:TMP(CLAIM,IEN,102,"I")[5 TMP(CLAIM,IEN,109,"I")=1
+25 IF TMP(CLAIM,IEN,102,"I")'[3
SET TMP(CLAIM,IEN,109,"I")=1
+26 ;
+27 ; Must agree with field list above.
+28 ;IHS/SD/lwj 8/15/02 NCPDP 5.1 new fields need to be used
+29 ; nxt line remarked out, following 2 lines added
+30 ;
+31 ;S DR="" N I F I=.02,.03,1.01,1.02,1.03,101,102,103,104,201,401 D
+32 SET DR=""
NEW I
+33 ;
+34 ;IHS/SD/lwj 10/08/03 new flds for NB Medicaid
+35 ; nxt line remarked out - following line added
+36 ;F I=.02,.03,1.01,1.02,1.03,101,102,103,104,109,110,201,202,401 D
+37 ;IHS/SD/lwj 1/16/03 new fields for Catalyst and Medtrak
+38 ; nxt line remarked out - following line added patch 9
+39 ;F I=.02,.03,1.01,1.02,1.03,101,102,103,104,109,110,201,202,301,302,306,309,312,313,401 D
+40 ;IHS/SD/lwj 6/23/05 patch 12 nxt ln rmkd out, following added
+41 ;F I=.02,.03,1.01,1.02,1.03,101,102,103,104,109,110,201,202,301,302,303,304,305,306,309,310,311,312,313,401 D
+42 FOR I=.02,.03,1.01,1.02,1.03,101,102,103,104,109,110,201,202,301,302,303,304,305,306,309,310,311,312,313,331,332,401
Begin DoDot:1
+43 SET DR=DR_I_"////"_TMP(CLAIM,IEN,I,"I")_";"
End DoDot:1
+44 ; transmit flag - it's 2 for POS
SET DR=DR_".04////2"
+45 DO ^DIE
+46 SET DIE="^ABSPC("_REVIEN_",400,"
+47 SET DA(1)=REVIEN
SET DA=1
SET DR=""
+48 ; Must agree with field list above
+49 ;IHS/SD/lwj 8/15/02 NCPDP 5.1 new fields need to be used
+50 ; nxt line remarked out, following 2 lines added
+51 ;
+52 ;F I=401,402,418,438,439,440,441 D
+53 ;IHS/SD/lwj 10/08/03 new flds needed for NB Medicaid
+54 ;nxt line rmked out, following added (flds 405/406/414/442)
+55 ;F I=308,401,402,403,407,418,420,436,438,439,440,441,455 D
+56 ;IHS/SD/lwj 3/16/04 patch 10 nxt line remkd out, line added
+57 ;F I=308,401,402,403,405,406,407,414,418,420,436,438,439,440,441,442,455 D
+58 FOR I=308,401,402,403,405,406,407,414,418,420,436,438,439,440,441,442,455,461,462
Begin DoDot:1
+59 SET DR=DR_I_"////"_TMP(RXMULT,RX,I,"I")_";"
End DoDot:1
+60 ; get rid of extra trailing ";"
SET DR=$EXTRACT(DR,1,$LENGTH(DR)-1)
+61 DO ^DIE
+62 ;
+63 QUIT REVIEN
+64 ;
CKVERS ;check the version of the current format - if it's 5.1 then we've hit a
+1 ; "mixed claim." (Originally created in 3.2 - reverse in 5.1)
+2 ;
+3 NEW ABSPINS,ABSPFORM,ABSPVER,ABSPCFRM
+4 SET (ABSPINS,ABSPFORM,ABSPVER,ABSPCFRM)=""
+5 ;
+6 SET ABSPINS=TMP(9002313.02,IEN,.02,"I")
+7 IF ABSPINS=""
QUIT
+8 ;
+9 ;claim format
SET ABSPCFRM=$PIECE($GET(^ABSPEI(ABSPINS,100)),U)
+10 IF ABSPCFRM=""
QUIT
+11 ;
+12 SET ABSPFORM=$PIECE($GET(^ABSPF(9002313.92,ABSPCFRM,"REVERSAL")),U)
+13 IF ABSPFORM=""
QUIT
+14 ;
+15 SET ABSPVER=$PIECE($GET(^ABSPF(9002313.92,ABSPFORM,1)),U,2)
+16 IF ABSPVER[5
Begin DoDot:1
+17 SET TMP(9002313.02,IEN,102,"I")=51
+18 DO REFORM^ABSPOSHR(ABSPFORM)
End DoDot:1
+19 ;
+20 QUIT
+21 ;
CKVERSD ;IHS/CAS/RCS 08292012 - Patch 44, new code section - HEAT # 74630
+1 ;check the version of current Insurer - if it's D.0 then it's a "mixed claim."
+2 ;(Originally created in 5.1 - reverse in D.0)
+3 ;Modify field 110 if needed (Certification #)
+4 ;
+5 NEW ABSPINS,ABSPVER,ABSPPNT,X,Y,ABSPX,RXPNT,PHARMACY,ABSP
+6 SET ABSPINS=TMP(9002313.02,IEN,.02,"I")
+7 IF ABSPINS=""
QUIT
+8 ;
+9 SET RXPNT=$PIECE(D,U)
+10 IF RXPNT=""
QUIT
+11 ;
+12 ;current Insurer version
SET ABSPVER=$PIECE($GET(^ABSPEI(ABSPINS,100)),U,15)
+13 ;The current insurer is D.0
IF ABSPVER=2
Begin DoDot:1
+14 ;Find Special code for NCPDP field 110
SET ABSPPNT=$ORDER(^ABSPEI(ABSPINS,210,"B",75,""))
IF ABSPPNT=""
QUIT
+15 SET Y=$GET(^ABSPEI(ABSPINS,210,ABSPPNT,210))
IF Y=""
QUIT
+16 SET PHARMACY=$PIECE(^ABSPT(RXPNT,1),U,7)
+17 ;setup special code variable
IF $DATA(^ABSP(9002313.56,PHARMACY,"INSURER-ASSIGNED #","B",ABSPINS))
Begin DoDot:2
+18 SET X=$ORDER(^ABSP(9002313.56,PHARMACY,"INSURER-ASSIGNED #","B",ABSPINS,0))
+19 SET ABSP("Site","MED-CAL Subscriber #")=$PIECE(^ABSP(9002313.56,PHARMACY,"INSURER-ASSIGNED #",X,0),U,3)
+20 SET ABSP("Site","CA FAMILY PACT ID")=$PIECE(^ABSP(9002313.56,PHARMACY,"INSURER-ASSIGNED #",X,0),U,4)
End DoDot:2
+21 ;Cert # currently null
SET ABSPX=$PIECE(Y,U,2)
IF ABSPX=""
SET TMP(9002313.02,IEN,110,"I")=" "
QUIT
+22 ;Execute special code for field 110
XECUTE ABSPX
+23 SET ABSP("X")=$$ANFF^ABSPECFM($GET(ABSP("X")),10)
+24 ;Set field 110 - Certification #
SET TMP(9002313.02,IEN,110,"I")=ABSP("X")
End DoDot:1
+25 QUIT
