ABSPECX0.m

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