ABSPECX0 ; IHS/FCS/DRS - JWS 04:26 PM 18 Jun 1996 ; [ 09/09/2002 5:18 PM ]
;;1.0;PHARMACY POINT OF SALE;**3,7,23**;JUN 21, 2001;Build 38
Q
;----------------------------------------------------------------------
;----------------------------------------------------------------------
;Retrieve Claim submission record
;
;Input Variables: CLAIMIEN - Claim Submission IEN (9002313.02)
; .ABSP - Pass by reference, output only
;
;Output Variables: ABSP(9002313.02,CLAIMIEN,<field #>,"I") = Value
;----------------------------------------------------------------------
; IHS/SD/lwj 08/13/02 NCPDP 5.1 changes
; Many fields that were once a part of the "header" of the claim
; were shifted to appear on the "rx" or "detail" segments of the
; claim in 5.1. Additionally, MANY new fields were added beyond 499.
; For these reasons, we had to change the GETABSP3
; subroutine to pull fields 308 through 600 rather than just
; 402 - 499. The really cool thing is that because we are at the
; subfile level, the duplicated fields (between header and rx)
; will only pull at the appropriate level. 3.2 claims should
; be unaffected by this change, as the adjusted and new fields
; were not populated for 3.2
;
; New subroutine added GETABSP4 to pull out the repeating fields for
; the DUR/PPS records
;----------------------------------------------------------------------
;IHS/SD/lwj 9/3/03 new subroutine added to extract the prior
; authorization segment values. Subroutine called by ABSPECA1.
;----------------------------------------------------------------------
;IHS/SD/RLT - 06/27/07 - 10/18/07 - Patch 23
; New tag GETABSP6 for Diagnosis Code.
;
GETABSP2(CLAIMIEN,ABSP) ;EP - from ABSPECA1
;Manage local variables
N DIC,DR,DA,DIQ,D0,DIQ2
;
;Make sure input variables are defined
Q:$G(CLAIMIEN)=""
;
;Set input variables for FileMan data retrieval routine
;IHS/SD/lwj 9/9/02 need to expand the field range to include
; the "500" range fields now used in the header segments
; for NCPDP 5.1
;
S DIC=9002313.02
; IHS/SD/lwj 9/9/02 NCPDP 5.1 changes nxt line remarked
; out, following line added to replace it
; S DR="101:401"
S DR="101:600"
S DA=CLAIMIEN
S DIQ="ABSP",DIQ(0)="I"
;
;Execute data retrieval routine
D EN^DIQ1
Q
;----------------------------------------------------------------------
;Retrieve Claim Submission, Prescription(s) multiple record
;
;Input Variables: CLAIMIEN - Claim Submission IEN (9002313.02)
; CRXIEN - Prescription Multiple IEN (9002313.0201)
;
;Output Variables: ABSP(9002313.0201,CRXIEN,<field #>,"I") = Value
;----------------------------------------------------------------------
GETABSP3(CLAIMIEN,CRXIEN,ABSP) ;EP - from ABSPECA1
;Manage local variables
N DIC,DR,DA,DIQ,D0,DIQ2
;
;Make sure input variables are defined
Q:$G(CLAIMIEN)=""
Q:$G(CRXIEN)=""
;
;S input variables for FileMan data retrieval routine
S DIC=9002313.02
;
;IHS/SD/lwj 8/13/02 NCPDP 5.1 nxt line rmkd out - following line added
;S DR="400",DR(9002313.0201)="402:499"
S DR="400",DR(9002313.0201)="308:600" ;need new RX fields
;IHS/SD/lwj 8/13/02 end changes
S DA=CLAIMIEN,DA(9002313.0201)=CRXIEN
S DIQ="ABSP",DIQ(0)="I"
;
;Execute data retrieval routine
D EN^DIQ1
Q
;----------------------------------------------------------------------
;Retrieve Claim Submission, Prescription(s) multiple, DUR/PPS multiple
; record
;
;Input Variables: CLAIMIEN - Claim Submission IEN (9002313.02)
; CRXIEN - Prescription Multiple IEN (9002313.0201)
; CDURIEN - DUR/PPS Multiple IEN (9002313.1001)
;
;Output Variables: ABSP(9002313.1001,CDURIEN,<field #>,"I") = Value
;----------------------------------------------------------------------
GETABSP4(CLAIMIEN,CRXIEN,CDURIEN,ABSP) ;EP - from ABSPECA1
;
;Manage local variables
N DIC,DR,DA,DIQ,D0,DIQ2
;
;Make sure input variables are defined
Q:$G(CLAIMIEN)=""
Q:$G(CRXIEN)=""
Q:$G(CDURIEN)=""
;
;S input variables for FileMan data retrieval routine
S DIC=9002313.02
;
S DR="400",DR(9002313.0201)=473.01 ;fields
S DR(9002313.1001)=".01;439;440;441;474;475;476" ;fields
S DA=CLAIMIEN,DA(9002313.0201)=CRXIEN,DA(9002313.1001)=CDURIEN
S DIQ="ABSP",DIQ(0)="I"
;
;Execute data retrieval routine
D EN^DIQ1
;
Q
;----------------------------------------------------------------------
;Retrieve Claim Submission, Prescription(s) multiple record
; Prior authorization fields only
;
;Input Variables: CLAIMIEN - Claim Submission IEN (9002313.02)
; CRXIEN - Prescription Multiple IEN (9002313.0201)
;
;Output Variables: ABSP(9002313.0201,CRXIEN,<field #>,"I") = Value
;----------------------------------------------------------------------
GETABSP5(CLAIMIEN,CRXIEN,ABSP) ;EP - from ABSPECA1
;Manage local variables
N DIC,DR,DA,DIQ,D0,DIQ2
;
;Make sure input variables are defined
Q:$G(CLAIMIEN)=""
Q:$G(CRXIEN)=""
;
;S input variables for FileMan data retrieval routine
S DIC=9002313.02
;
S DR="400",DR(9002313.0201)="498.01:498.14" ;need new RX fields
S DA=CLAIMIEN,DA(9002313.0201)=CRXIEN
S DIQ="ABSP",DIQ(0)="I"
;
;Execute data retrieval routine
D EN^DIQ1
Q
;----------------------------------------------------------------------
;Retrieve Claim Submission, Prescription(s) multiple, Diagnosis Code
; multiple record
;
;Input Variables: CLAIMIEN - Claim Submission IEN (9002313.02)
; CRXIEN - Prescription Multiple IEN (9002313.0201)
; CDIAGIEN - Diagnosis Code Multiple IEN (9002313.0701)
;
;Output Variables: ABSP(9002313.1001,CDIAGIEN,<field #>,"I") = Value
;----------------------------------------------------------------------
GETABSP6(CLAIMIEN,CRXIEN,CDIAGIEN,ABSP) ;EP - from ABSPECA1
;
;Manage local variables
N DIC,DR,DA,DIQ,D0,DIQ2
;
;Make sure input variables are defined
Q:$G(CLAIMIEN)=""
Q:$G(CRXIEN)=""
Q:$G(CDIAGIEN)=""
;
;S input variables for FileMan data retrieval routine
S DIC=9002313.02
;
S DR="400",DR(9002313.0201)=491.01 ;fields
S DR(9002313.0701)="492;424" ;fields
S DA=CLAIMIEN,DA(9002313.0201)=CRXIEN,DA(9002313.0701)=CDIAGIEN
S DIQ="ABSP",DIQ(0)="I"
;
;Execute data retrieval routine
D EN^DIQ1
;
Q
ABSPECX0 ; IHS/FCS/DRS - JWS 04:26 PM 18 Jun 1996 ; [ 09/09/2002 5:18 PM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3,7,23**;JUN 21, 2001;Build 38
+2 QUIT
+3 ;----------------------------------------------------------------------
+4 ;----------------------------------------------------------------------
+5 ;Retrieve Claim submission record
+6 ;
+7 ;Input Variables: CLAIMIEN - Claim Submission IEN (9002313.02)
+8 ; .ABSP - Pass by reference, output only
+9 ;
+10 ;Output Variables: ABSP(9002313.02,CLAIMIEN,<field #>,"I") = Value
+11 ;----------------------------------------------------------------------
+12 ; IHS/SD/lwj 08/13/02 NCPDP 5.1 changes
+13 ; Many fields that were once a part of the "header" of the claim
+14 ; were shifted to appear on the "rx" or "detail" segments of the
+15 ; claim in 5.1. Additionally, MANY new fields were added beyond 499.
+16 ; For these reasons, we had to change the GETABSP3
+17 ; subroutine to pull fields 308 through 600 rather than just
+18 ; 402 - 499. The really cool thing is that because we are at the
+19 ; subfile level, the duplicated fields (between header and rx)
+20 ; will only pull at the appropriate level. 3.2 claims should
+21 ; be unaffected by this change, as the adjusted and new fields
+22 ; were not populated for 3.2
+23 ;
+24 ; New subroutine added GETABSP4 to pull out the repeating fields for
+25 ; the DUR/PPS records
+26 ;----------------------------------------------------------------------
+27 ;IHS/SD/lwj 9/3/03 new subroutine added to extract the prior
+28 ; authorization segment values. Subroutine called by ABSPECA1.
+29 ;----------------------------------------------------------------------
+30 ;IHS/SD/RLT - 06/27/07 - 10/18/07 - Patch 23
+31 ; New tag GETABSP6 for Diagnosis Code.
+32 ;
GETABSP2(CLAIMIEN,ABSP) ;EP - from ABSPECA1
+1 ;Manage local variables
+2 NEW DIC,DR,DA,DIQ,D0,DIQ2
+3 ;
+4 ;Make sure input variables are defined
+5 IF $GET(CLAIMIEN)=""
QUIT
+6 ;
+7 ;Set input variables for FileMan data retrieval routine
+8 ;IHS/SD/lwj 9/9/02 need to expand the field range to include
+9 ; the "500" range fields now used in the header segments
+10 ; for NCPDP 5.1
+11 ;
+12 SET DIC=9002313.02
+13 ; IHS/SD/lwj 9/9/02 NCPDP 5.1 changes nxt line remarked
+14 ; out, following line added to replace it
+15 ; S DR="101:401"
+16 SET DR="101:600"
+17 SET DA=CLAIMIEN
+18 SET DIQ="ABSP"
SET DIQ(0)="I"
+19 ;
+20 ;Execute data retrieval routine
+21 DO EN^DIQ1
+22 QUIT
+23 ;----------------------------------------------------------------------
+24 ;Retrieve Claim Submission, Prescription(s) multiple record
+25 ;
+26 ;Input Variables: CLAIMIEN - Claim Submission IEN (9002313.02)
+27 ; CRXIEN - Prescription Multiple IEN (9002313.0201)
+28 ;
+29 ;Output Variables: ABSP(9002313.0201,CRXIEN,<field #>,"I") = Value
+30 ;----------------------------------------------------------------------
GETABSP3(CLAIMIEN,CRXIEN,ABSP) ;EP - from ABSPECA1
+1 ;Manage local variables
+2 NEW DIC,DR,DA,DIQ,D0,DIQ2
+3 ;
+4 ;Make sure input variables are defined
+5 IF $GET(CLAIMIEN)=""
QUIT
+6 IF $GET(CRXIEN)=""
QUIT
+7 ;
+8 ;S input variables for FileMan data retrieval routine
+9 SET DIC=9002313.02
+10 ;
+11 ;IHS/SD/lwj 8/13/02 NCPDP 5.1 nxt line rmkd out - following line added
+12 ;S DR="400",DR(9002313.0201)="402:499"
+13 ;need new RX fields
SET DR="400"
SET DR(9002313.0201)="308:600"
+14 ;IHS/SD/lwj 8/13/02 end changes
+15 SET DA=CLAIMIEN
SET DA(9002313.0201)=CRXIEN
+16 SET DIQ="ABSP"
SET DIQ(0)="I"
+17 ;
+18 ;Execute data retrieval routine
+19 DO EN^DIQ1
+20 QUIT
+21 ;----------------------------------------------------------------------
+22 ;Retrieve Claim Submission, Prescription(s) multiple, DUR/PPS multiple
+23 ; record
+24 ;
+25 ;Input Variables: CLAIMIEN - Claim Submission IEN (9002313.02)
+26 ; CRXIEN - Prescription Multiple IEN (9002313.0201)
+27 ; CDURIEN - DUR/PPS Multiple IEN (9002313.1001)
+28 ;
+29 ;Output Variables: ABSP(9002313.1001,CDURIEN,<field #>,"I") = Value
+30 ;----------------------------------------------------------------------
GETABSP4(CLAIMIEN,CRXIEN,CDURIEN,ABSP) ;EP - from ABSPECA1
+1 ;
+2 ;Manage local variables
+3 NEW DIC,DR,DA,DIQ,D0,DIQ2
+4 ;
+5 ;Make sure input variables are defined
+6 IF $GET(CLAIMIEN)=""
QUIT
+7 IF $GET(CRXIEN)=""
QUIT
+8 IF $GET(CDURIEN)=""
QUIT
+9 ;
+10 ;S input variables for FileMan data retrieval routine
+11 SET DIC=9002313.02
+12 ;
+13 ;fields
SET DR="400"
SET DR(9002313.0201)=473.01
+14 ;fields
SET DR(9002313.1001)=".01;439;440;441;474;475;476"
+15 SET DA=CLAIMIEN
SET DA(9002313.0201)=CRXIEN
SET DA(9002313.1001)=CDURIEN
+16 SET DIQ="ABSP"
SET DIQ(0)="I"
+17 ;
+18 ;Execute data retrieval routine
+19 DO EN^DIQ1
+20 ;
+21 QUIT
+22 ;----------------------------------------------------------------------
+23 ;Retrieve Claim Submission, Prescription(s) multiple record
+24 ; Prior authorization fields only
+25 ;
+26 ;Input Variables: CLAIMIEN - Claim Submission IEN (9002313.02)
+27 ; CRXIEN - Prescription Multiple IEN (9002313.0201)
+28 ;
+29 ;Output Variables: ABSP(9002313.0201,CRXIEN,<field #>,"I") = Value
+30 ;----------------------------------------------------------------------
GETABSP5(CLAIMIEN,CRXIEN,ABSP) ;EP - from ABSPECA1
+1 ;Manage local variables
+2 NEW DIC,DR,DA,DIQ,D0,DIQ2
+3 ;
+4 ;Make sure input variables are defined
+5 IF $GET(CLAIMIEN)=""
QUIT
+6 IF $GET(CRXIEN)=""
QUIT
+7 ;
+8 ;S input variables for FileMan data retrieval routine
+9 SET DIC=9002313.02
+10 ;
+11 ;need new RX fields
SET DR="400"
SET DR(9002313.0201)="498.01:498.14"
+12 SET DA=CLAIMIEN
SET DA(9002313.0201)=CRXIEN
+13 SET DIQ="ABSP"
SET DIQ(0)="I"
+14 ;
+15 ;Execute data retrieval routine
+16 DO EN^DIQ1
+17 QUIT
+18 ;----------------------------------------------------------------------
+19 ;Retrieve Claim Submission, Prescription(s) multiple, Diagnosis Code
+20 ; multiple record
+21 ;
+22 ;Input Variables: CLAIMIEN - Claim Submission IEN (9002313.02)
+23 ; CRXIEN - Prescription Multiple IEN (9002313.0201)
+24 ; CDIAGIEN - Diagnosis Code Multiple IEN (9002313.0701)
+25 ;
+26 ;Output Variables: ABSP(9002313.1001,CDIAGIEN,<field #>,"I") = Value
+27 ;----------------------------------------------------------------------
GETABSP6(CLAIMIEN,CRXIEN,CDIAGIEN,ABSP) ;EP - from ABSPECA1
+1 ;
+2 ;Manage local variables
+3 NEW DIC,DR,DA,DIQ,D0,DIQ2
+4 ;
+5 ;Make sure input variables are defined
+6 IF $GET(CLAIMIEN)=""
QUIT
+7 IF $GET(CRXIEN)=""
QUIT
+8 IF $GET(CDIAGIEN)=""
QUIT
+9 ;
+10 ;S input variables for FileMan data retrieval routine
+11 SET DIC=9002313.02
+12 ;
+13 ;fields
SET DR="400"
SET DR(9002313.0201)=491.01
+14 ;fields
SET DR(9002313.0701)="492;424"
+15 SET DA=CLAIMIEN
SET DA(9002313.0201)=CRXIEN
SET DA(9002313.0701)=CDIAGIEN
+16 SET DIQ="ABSP"
SET DIQ(0)="I"
+17 ;
+18 ;Execute data retrieval routine
+19 DO EN^DIQ1
+20 ;
+21 QUIT