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

ABSPECA8.m

Go to the documentation of this file.
  1. 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
  1. Q
  1. ; The way we build the claim reversal is to take the source data
  1. ; from the original claim (IEN) and position therein (RX).
  1. ; $$ returns pointer to 9002313.02 of the new entry.
  1. ;
  1. ; Future: want to use new database server calls to create the
  1. ; 9002313.02 entry. It would be soooo much cleaner.
  1. ;
  1. ; Remember, you have two 401 fields - one in header, one in prescript.
  1. ;
  1. ;IHS/SD/lwj 08/15/02 NCPDP 5.1 changes
  1. ; There are new fields to consider in the 5.1 reversal process, in
  1. ; addition to a new value for the transaction code (noe B2 as opposed
  1. ; to 11 in 3.2).
  1. ; Changes made as needed.
  1. ;
  1. ;IHS/SD/lwj 10/23/02 NCPDP 5.1 changes
  1. ; New code added to account for a mixed reversal. A mixed reversal is
  1. ; a claim that was created in 3.x format & needs to be reversed in 5.1
  1. ; format. This requires field reformatting.
  1. ;
  1. ;--------------------------------------------------------
  1. ;IHS/SD/lwj 10/08/03 ACS requires new flds for the reversal.
  1. ; (ACS currently processes for Nebraska Medicaid, New Mexico
  1. ; Medicaid, Colorado Medicaid, Washington Medicaid and
  1. ; Mississippi Medicaid.)
  1. ; Needed to add fields 301, 302, 306, 309, 312, 313 405, 406,
  1. ; 414, and 442 to the reversal process.
  1. ;--------------------------------------------------------
  1. ;IHS/SD/lwj 1/16/03 NCPDP 5.1 changes Patch 9
  1. ; New code added to account for newer reversal requirements
  1. ; for Catalyst Rx and Medtrak.
  1. ; Fields 303, 304, 305, 310 and 311 added.
  1. ;--------------------------------------------------------
  1. ;IHS/SD/lwj 3/16/04 patch 10 NCPDP 5.1 changes
  1. ; Two new fields needed for the reversal process at the
  1. ; "detail" level - fields are 461 and 462.
  1. ; (Used on Procare format.)
  1. ;--------------------------------------------------------
  1. ;IHS/SD/lwj 6/23/05 patch 12 NCPDP 5.1 changes
  1. ; 331 patient id qualifier 332 patient id
  1. ; added for NMHCRX reversals
  1. ;--------------------------------------------------------
  1. REVERSE(IEN,RX) ;EP - from ABSPOS6D, ABSPOSC2
  1. ; IEN=original claim, RX = prescription # subscript therein
  1. ; returns IEN of the reversal claim created
  1. ;
  1. ; extract needed data
  1. N CLAIM,RXMULT S CLAIM=9002313.02,RXMULT=9002313.0201 ; file #s
  1. N DIC,DR,DA,DIQ,TMP,I,X
  1. ; This field list is repeated below.
  1. S DIC=CLAIM
  1. ;
  1. ;IHS/SD/lwj 1/16/03 new fields needed for Catalyst RX and Medtrak 5.1
  1. ; nxt line remarked out, following line added (patch 9)
  1. ;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"
  1. ; IHS/SD/lwj 6/23/05 patch 12 nxt ln rmkd out, following added
  1. ;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"
  1. 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"
  1. S DA=IEN
  1. S DIQ="TMP",DIQ(0)="I"
  1. ; This field list is repeated below.
  1. ; It needs to include all the fields that are used in any reversal
  1. ; format anywhere.
  1. ;
  1. ;IHS/SD/lwj 8/15/02 NCPDP 5.1 new fields need to be used
  1. ; nxt line remarked out, following 2 lines added
  1. ;S DR(RXMULT)=".01;401;402;418;438;439;440;441",DA(RXMULT)=RX
  1. ;
  1. ;IHS/SD/lwj 10/08/03 new flds needed for NB Medicaid reversal
  1. ;nxt line remarked out, following added - flds 405/406/414,442
  1. ;S DR(RXMULT)=".01;308;401;402;403;407;418;420;436;438;439;440;441;455"
  1. ;IHS/SD/lwj 03/16/04 patch 10 nxt line remkd out, next line added
  1. ;S DR(RXMULT)=".01;308;401;402;403;405;406;407;414;418;420;436;438;439;440;441;442;455"
  1. S DR(RXMULT)=".01;308;401;402;403;405;406;407;414;418;420;436;438;439;440;441;442;455;461;462"
  1. S DA(RXMULT)=RX
  1. ;ZW DIC,DR,DA,DIQ
  1. D EN^DIQ1
  1. ;
  1. ;IHS/SD/lwj 10/23/02 NCPDP 5.1 changes
  1. ; check for a mixed claim (3.x claim - 5.1 reversal)-reformat if needed
  1. ;
  1. D:TMP(CLAIM,IEN,102,"I")[3 CKVERS
  1. ;
  1. ;IHS/CAS/RCS 08292012 - Patch 44, Check if orignal claim 5.1 and current D.0
  1. D:TMP(CLAIM,IEN,102,"I")[5 CKVERSD
  1. ;
  1. ;IHS/SD/lwj 10/23/02 end mixed claim check
  1. ;
  1. ;ZW TMP
  1. ; create a new 9002313.02 record
  1. N DIC,X,DLAYGO,REVIEN,Y,UERETVAL
  1. R2 S DIC=9002313.02,DIC(0)="LX",X=TMP(9002313.02,IEN,.01,"I")_"R"_RX
  1. S DLAYGO=CLAIM
  1. D ^DIC S REVIEN=+Y I REVIEN<1 D G:UERETVAL R2
  1. . S UERETVAL=$$IMPOSS^ABSPOSUE("FM,P",,"call to ^DIC",,,$T(+0))
  1. ;ZW REVIEN
  1. R4 ; create a new prescription multiple therein
  1. S DIC="^ABSPC("_REVIEN_",400,",DIC(0)="LX"
  1. S DIC("P")=$P(^DD(CLAIM,400,0),U,2)
  1. S DA(1)=REVIEN,DLAYGO=RXMULT
  1. S X=1 D ^DIC I +Y'=1 D G:UERETVAL R4
  1. . S UERETVAL=$$IMPOSS^ABSPOSUE("FM,P",,"call to ^DIC","for multiple",,$T(+0))
  1. ;ZW Y
  1. ; set data values
  1. N DIE
  1. S DIE=CLAIM,DA=REVIEN
  1. S TMP(CLAIM,IEN,103,"I")=11 ; change transaction code to REVERSAL
  1. ;
  1. ;IHS/SD/lwj 8/15/02 NCPDP 5.1 changes
  1. ; if the version is 5.1, the transaction code needs to be B2 not 11
  1. ; following line added
  1. ;IHS/OIT/CASSEVERN/RCS patch43 4/18/2012 Include D.0 version
  1. ;S:TMP(CLAIM,IEN,102,"I")[5 TMP(CLAIM,IEN,103,"I")="B2"
  1. S:TMP(CLAIM,IEN,102,"I")'[3 TMP(CLAIM,IEN,103,"I")="B2"
  1. ;
  1. ;IHS/SD/lwj 11/18/02 NCPDP 5.1 changes
  1. ; when it's a 5.1 reversal, we ALWAYS want the transaction code
  1. ; (fld 109) to be a 1 - ALWAYS
  1. ; next line added
  1. ;IHS/OIT/CASSEVERN/RCS patch43 4/18/2012 Include D.0 version
  1. ;S:TMP(CLAIM,IEN,102,"I")[5 TMP(CLAIM,IEN,109,"I")=1
  1. S:TMP(CLAIM,IEN,102,"I")'[3 TMP(CLAIM,IEN,109,"I")=1
  1. ;
  1. ; Must agree with field list above.
  1. ;IHS/SD/lwj 8/15/02 NCPDP 5.1 new fields need to be used
  1. ; nxt line remarked out, following 2 lines added
  1. ;
  1. ;S DR="" N I F I=.02,.03,1.01,1.02,1.03,101,102,103,104,201,401 D
  1. S DR="" N I
  1. ;
  1. ;IHS/SD/lwj 10/08/03 new flds for NB Medicaid
  1. ; nxt line remarked out - following line added
  1. ;F I=.02,.03,1.01,1.02,1.03,101,102,103,104,109,110,201,202,401 D
  1. ;IHS/SD/lwj 1/16/03 new fields for Catalyst and Medtrak
  1. ; nxt line remarked out - following line added patch 9
  1. ;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
  1. ;IHS/SD/lwj 6/23/05 patch 12 nxt ln rmkd out, following added
  1. ;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
  1. 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
  1. .S DR=DR_I_"////"_TMP(CLAIM,IEN,I,"I")_";"
  1. S DR=DR_".04////2" ; transmit flag - it's 2 for POS
  1. D ^DIE
  1. S DIE="^ABSPC("_REVIEN_",400,"
  1. S DA(1)=REVIEN,DA=1,DR=""
  1. ; Must agree with field list above
  1. ;IHS/SD/lwj 8/15/02 NCPDP 5.1 new fields need to be used
  1. ; nxt line remarked out, following 2 lines added
  1. ;
  1. ;F I=401,402,418,438,439,440,441 D
  1. ;IHS/SD/lwj 10/08/03 new flds needed for NB Medicaid
  1. ;nxt line rmked out, following added (flds 405/406/414/442)
  1. ;F I=308,401,402,403,407,418,420,436,438,439,440,441,455 D
  1. ;IHS/SD/lwj 3/16/04 patch 10 nxt line remkd out, line added
  1. ;F I=308,401,402,403,405,406,407,414,418,420,436,438,439,440,441,442,455 D
  1. F I=308,401,402,403,405,406,407,414,418,420,436,438,439,440,441,442,455,461,462 D
  1. .S DR=DR_I_"////"_TMP(RXMULT,RX,I,"I")_";"
  1. S DR=$E(DR,1,$L(DR)-1) ; get rid of extra trailing ";"
  1. D ^DIE
  1. ;
  1. Q REVIEN
  1. ;
  1. 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)
  1. ;
  1. N ABSPINS,ABSPFORM,ABSPVER,ABSPCFRM
  1. S (ABSPINS,ABSPFORM,ABSPVER,ABSPCFRM)=""
  1. ;
  1. S ABSPINS=TMP(9002313.02,IEN,.02,"I")
  1. Q:ABSPINS=""
  1. ;
  1. S ABSPCFRM=$P($G(^ABSPEI(ABSPINS,100)),U) ;claim format
  1. Q:ABSPCFRM=""
  1. ;
  1. S ABSPFORM=$P($G(^ABSPF(9002313.92,ABSPCFRM,"REVERSAL")),U)
  1. Q:ABSPFORM=""
  1. ;
  1. S ABSPVER=$P($G(^ABSPF(9002313.92,ABSPFORM,1)),U,2)
  1. I ABSPVER[5 D
  1. . S TMP(9002313.02,IEN,102,"I")=51
  1. . D REFORM^ABSPOSHR(ABSPFORM)
  1. ;
  1. Q
  1. ;
  1. 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."
  1. ;(Originally created in 5.1 - reverse in D.0)
  1. ;Modify field 110 if needed (Certification #)
  1. ;
  1. N ABSPINS,ABSPVER,ABSPPNT,X,Y,ABSPX,RXPNT,PHARMACY,ABSP
  1. S ABSPINS=TMP(9002313.02,IEN,.02,"I")
  1. Q:ABSPINS=""
  1. ;
  1. S RXPNT=$P(D,U)
  1. Q:RXPNT=""
  1. ;
  1. S ABSPVER=$P($G(^ABSPEI(ABSPINS,100)),U,15) ;current Insurer version
  1. I ABSPVER=2 D ;The current insurer is D.0
  1. . S ABSPPNT=$O(^ABSPEI(ABSPINS,210,"B",75,"")) I ABSPPNT="" Q ;Find Special code for NCPDP field 110
  1. . S Y=$G(^ABSPEI(ABSPINS,210,ABSPPNT,210)) I Y="" Q
  1. . S PHARMACY=$P(^ABSPT(RXPNT,1),U,7)
  1. . I $D(^ABSP(9002313.56,PHARMACY,"INSURER-ASSIGNED #","B",ABSPINS)) D ;setup special code variable
  1. . . S X=$O(^ABSP(9002313.56,PHARMACY,"INSURER-ASSIGNED #","B",ABSPINS,0))
  1. . . S ABSP("Site","MED-CAL Subscriber #")=$P(^ABSP(9002313.56,PHARMACY,"INSURER-ASSIGNED #",X,0),U,3)
  1. . . S ABSP("Site","CA FAMILY PACT ID")=$P(^ABSP(9002313.56,PHARMACY,"INSURER-ASSIGNED #",X,0),U,4)
  1. . S ABSPX=$P(Y,U,2) I ABSPX="" S TMP(9002313.02,IEN,110,"I")=" " Q ;Cert # currently null
  1. . X ABSPX ;Execute special code for field 110
  1. . S ABSP("X")=$$ANFF^ABSPECFM($G(ABSP("X")),10)
  1. . S TMP(9002313.02,IEN,110,"I")=ABSP("X") ;Set field 110 - Certification #
  1. Q