- 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