Routine: ABSPOSFD

ABSPOSFD ; IHS/FCS/DRS - ABSP("RX",*) ;      [ 09/12/2002  10:09 AM ]

 ;;1.0;PHARMACY POINT OF SALE;**3,10,40**;JUN 21, 2001;Build 38

 ;----------------------------------------------------------------------

 ; This is a copy of routine ABSPOSCD, made on 03/20/2001.

 ; It constructs the ABSP(*) array for printing NCPDP forms.

 ; Try to keep the two versions in synch.

 ;----------------------------------------------------------------------

 ;IHS/SD/lwj 03/10/04 patch 10

 ; Routine adjusted to call ABSPFUNC to retrieve

 ; the Prescription Refill NDC value.  At some

 ; point the call needs to be modified to call APSPFUNC.

 ; See ABSPFUNC for details on why call was done.

 ;----------------------------------------------------------------------

 ;----------------------------------------------------------------------

 ;Set ABSP() "RX" nodes for current medication:

 ;Parameters:   VMEDINFO  - Contains RXIEN,RXRFIEN,IEN57

 ;              MEDN      - Index number indicating what medication is

 ;                          being processed

 ;----------------------------------------------------------------------

 ; Called from ABSPOSCA from ABSPOSQG from ABSPOSQ2,

 ; once for each item in its VMEDS() array.

MEDINFO(VMEDINFO,MEDN,INSPINS) ;EP

 ;Manage local variables

 N RXIEN,RXRFIEN,DRUGIEN,PROVIEN,RXI,IEN57,PINSTYPE

 ;Parse variables from VMEDINFO variable

 S RXIEN=$P(VMEDINFO,U,2)

 S RXRFIEN=$P(VMEDINFO,U,3)

 S IEN57=$P(VMEDINFO,U,5)

 D OVERRIDE(IEN57,MEDN) ; overrides stored in 9002313.511

 S PINSTYPE=$P(INSPINS,",") ; "CAID" will make a difference

 S DRUGIEN=$P($G(^PSRX(RXIEN,0)),U,6)

 S PROVIEN=$P($G(^PSRX(RXIEN,0)),U,4)

 S ABSP("RX",MEDN,"IEN57")=IEN57

 S (RXI,ABSP("RX",MEDN,"RX IEN"))=RXIEN

 S ABSP("RX",MEDN,"Date Written")=$P($G(^PSRX(RXIEN,0)),U,13)

 S ABSP("RX",MEDN,"RX Number")=RXIEN ;$P($G(^PSRX(RXIEN,0)),U,1)

 S ABSP("RX",MEDN,"New/Refill")=$S(RXRFIEN="":"N",1:"R")

 S ABSP("RX",MEDN,"Preauth #")=$P(^ABSPTL(IEN57,1),U,9)

 I 'RXRFIEN D  ; first fill

 .S ABSP("RX",MEDN,"Quantity")=$P($G(^PSRX(RXIEN,0)),U,7)

 .S ABSP("RX",MEDN,"Days Supply")=$P($G(^PSRX(RXIEN,0)),U,8)

 .S ABSP("RX",MEDN,"Date Filled")=$P($G(^PSRX(RXIEN,2)),U,2)

 .S ABSP("RX",MEDN,"NDC")=$P($G(^PSRX(RXIEN,2)),U,7)

 E  D  ; refill

 .S ABSP("RX",MEDN,"Quantity")=$P($G(^PSRX(RXIEN,1,RXRFIEN,0)),U,4)

 .S ABSP("RX",MEDN,"Days Supply")=$P($G(^PSRX(RXIEN,1,RXRFIEN,0)),U,10)

 .S ABSP("RX",MEDN,"Date Filled")=$P($G(^PSRX(RXIEN,1,RXRFIEN,0)),U)

 .;IHS/SD/lwj 03/10/04 patch 10 nxt line rmkd out, new line added

 .;S ABSP("RX",MEDN,"NDC")=$P($G(^PSRX(RXIEN,1,RXRFIEN,0)),U,13)

 .S ABSP("RX",MEDN,"NDC")=$$NDCVAL^ABSPFUNC(RXIEN,RXRFIEN) ; patch 10

 .;IHS/SD/lwj 03/10/04 patch 10 end change

 ;IHS/OIT/CNI/RAN PATCH 40 This is the proper fill date

 S ABSP("RX","Date Filled")=ABSP("RX",MEDN,"Date Filled")

 S ABSP("RX",MEDN,"# Refills")=$P($G(^PSRX(RXIEN,0)),U,9)

 S ABSP("RX",MEDN,"Refill #")=$$RXRFN(RXIEN,RXRFIEN)

 S ABSP("RX",MEDN,"Prescriber IEN")=+PROVIEN

 S ABSP("RX",MEDN,"Prescriber DEA #")=$P($G(^VA(200,+PROVIEN,"PS")),U,2)

 S ABSP("RX",MEDN,"Prescriber CAID #")=$P($G(^VA(200,+PROVIEN,9999999)),U,7)

 S ABSP("RX",MEDN,"Prescriber UPIN #")=$P($G(^VA(200,+PROVIEN,9999999)),U,8) ;*1.26*2*

 S ABSP("RX",MEDN,"Prescriber Billing Location")=$S(PROVIEN]"":$P($G(^VA(200,PROVIEN,9999999)),"^",11),1:"") ; ANMC only?  not in Sitka's data dic.

 ;IHS/OIT/CASSEVERN/RAN 11/16/2010 PATCH 40 Adding Triplicate Serial # for New York Medicaid

 S ABSP("RX",MEDN,"Triplicate Serial #")=$P($G(^PSRX(RXIEN,9999999)),U,14)

 . N %

 . I PINSTYPE="CAID" D

 . . S %=ABSP("RX",MEDN,"Prescriber CAID #")

 . . I %="" D  ; special for ANMC

 . . . N %1 S %1=ABSP("RX",MEDN,"Prescriber Billing Location")

 . . . S %=$S(%1=1665:"MDG275",%1=1946:"MDG867",1:"")

 . . I %="" S %=ABSP("Site","Default CAID #")

 . E  D

 . . S %=ABSP("RX",MEDN,"Prescriber DEA #")

 . . I %="" S %=ABSP("Site","Default DEA #")

 . S ABSP("RX",MEDN,"Prescriber ID")=%

 D:DRUGIEN'=""

 .S ABSP("RX",MEDN,"Drug IEN")=DRUGIEN

 .S ABSP("RX",MEDN,"Drug Name")=$P($G(^PSDRUG(DRUGIEN,0)),U,1)

 .I ABSP("RX",MEDN,"NDC")="" D

 ..S ABSP("RX",MEDN,"NDC")=$P($G(^PSDRUG(DRUGIEN,2)),U,4)

 N PRICING S PRICING=^ABSPTL(IEN57,5)

 S ABSP("RX",MEDN,"Quantity")=$P(PRICING,U) ; 01/31/2001

 S ABSP("RX",MEDN,"Unit Price")=$P(PRICING,U,2)

 S ABSP("RX",MEDN,"Ingredient Cost")=$J($P(PRICING,U,3),0,2)

 S ABSP("RX",MEDN,"Dispensing Fee")=$J($P(PRICING,U,4),0,2)

 S ABSP("Site","Dispensing Fee")=ABSP("RX",MEDN,"Dispensing Fee")

 S ABSP("RX",MEDN,"Gross Amount Due")=$J($P(PRICING,U,5),0,2)

 S ABSP("RX",MEDN,"Usual & Customary")=$J($P(PRICING,U,5),0,2)

 ;IHS/OIT/SCR 11/20/08 - Add incentive amount info

 S ABSP("RX",MEDN,"Incentive Amount")=$J($P(PRICING,U,7),0,2)

 I ABSP("NCPDP","Add Disp. Fee to Ingr. Cost") D

 . N X S X=ABSP("RX",MEDN,"Ingredient Cost")

 . S X=X+ABSP("RX",MEDN,"Dispensing Fee")

 . S ABSP("RX",MEDN,"Ingredient Cost")=X

 ; Visit-related data

 I IEN57 D

 . N VSITIEN S VSITIEN=$P(^ABSPTL(IEN57,0),U,7)

 . Q:'VSITIEN

 . ;S ABSP("RX",MEDN,"Diagnosis Code")=$TR($$PRIMPOV^APCLV(VSITIEN,"C"),".","")

 . ; For paper forms, do not strip the "."

 . ; Strictly speaking, electronic claims should have stripped the "."

 . ; in the format code, not here in the fetch

 . S ABSP("RX",MEDN,"Diagnosis Code")=$$PRIMPOV^APCLV(VSITIEN,"C")

 ; $$RXRFN()

 ;Determine RX Refill Number based on prescription record

 ;  It's overly cautious about making sure that the refills are

 ;  counted in date filled order.

 ;Input Variables:    RXIEN    -  Prescription record IEN (52)

 ;                    RXRFIEN  -  Refill multiple IEN

 ;Function Returns:   Null  - Could not process request

 ;                    0     - Not a refill

 ;                    N     - Refill number

 ; Copied into here from ABSPECD4 so we can remove ABSPECD4 from kit.

 ; Also called from ABSPOSN3

 ;----------------------------------------------------------------------

RXRFN(RXIEN,RXRFIEN) ;EP

 ;Manage local variables

 N COUNT,DATE,XIEN,STOP

 ;Make sure input variables are defined

 Q:$G(RXIEN)="" ""

 Q:$G(RXRFIEN)="" ""

 ;Initialize local variables

 S (COUNT,STOP)=0

 ;Loop through refill multiple by date

 S DATE=""

 F  D  Q:'+DATE!(STOP)

 .S DATE=$O(^PSRX(RXIEN,1,"B",DATE))

 .Q:'+DATE

.;

 .;For each sub-record increment refill count

 .S XIEN=""

 .F  D  Q:'+XIEN!(STOP)

 ..S XIEN=$O(^PSRX(RXIEN,1,"B",DATE,XIEN))

 ..Q:'+XIEN

 ..S COUNT=COUNT+1

..;

 ..;STOP when you reach the refill record

 ..S:XIEN=RXRFIEN STOP=1

 Q $S(STOP=1:COUNT,1:0)

 ; Retrieve OVERRIDE nodes and put into ABSP array

 ; They will be fetched from ABSP("OVERRIDE"

 ; during low-level construction of the actual encoded claim packet.

OVERRIDE(IEN57,MEDN)    ; set any ABSP("OVERRIDE" nodes from 9002313.511 data

 ; ABSP("OVERRIDE",field)=value  for fields 101-401

 ; ABSP("OVERRIDE","RX",MEDN,field) for med #N, fields 402+

 ; Note that if you have multiple prescriptions bundled, the

 ; union of overrides from 101-401 apply to all; and if there's a

 ; conflict, the last one overwrites the previous ones.

 N IEN511 S IEN511=$P(^ABSPTL(IEN57,1),U,13) Q:'IEN511

 D GET511^ABSPOSO2(IEN511,"ABSP(""OVERRIDE"")","ABSP(""OVERRIDE"",""RX"","_MEDN_")")

CC Q

ABSPOSFD  ; IHS/FCS/DRS - ABSP("RX",*) ;      [ 09/12/2002  10:09 AM ]

 +1       ;;1.0;PHARMACY POINT OF SALE;**3,10,40**;JUN 21, 2001;Build 38

 +2       ;----------------------------------------------------------------------

 +3       ; This is a copy of routine ABSPOSCD, made on 03/20/2001.

 +4       ; It constructs the ABSP(*) array for printing NCPDP forms.

 +5       ; Try to keep the two versions in synch.

 +6       ;

 +7       ;----------------------------------------------------------------------

 +8       ;IHS/SD/lwj 03/10/04 patch 10

 +9       ; Routine adjusted to call ABSPFUNC to retrieve

 +10      ; the Prescription Refill NDC value.  At some

 +11      ; point the call needs to be modified to call APSPFUNC.

 +12      ; See ABSPFUNC for details on why call was done.

 +13      ;----------------------------------------------------------------------

 +14       QUIT

 +15      ;----------------------------------------------------------------------

 +16      ;Set ABSP() "RX" nodes for current medication:

 +17      ;

 +18      ;Parameters:   VMEDINFO  - Contains RXIEN,RXRFIEN,IEN57

 +19      ;              MEDN      - Index number indicating what medication is

 +20      ;                          being processed

 +21      ;----------------------------------------------------------------------

 +22      ; Called from ABSPOSCA from ABSPOSQG from ABSPOSQ2,

 +23      ; once for each item in its VMEDS() array.

MEDINFO(VMEDINFO,MEDN,INSPINS) ;EP

 +1       ;Manage local variables

 +2        NEW RXIEN,RXRFIEN,DRUGIEN,PROVIEN,RXI,IEN57,PINSTYPE

 +3       ;

 +4       ;Parse variables from VMEDINFO variable

 +5        SET RXIEN=$PIECE(VMEDINFO,U,2)

 +6        SET RXRFIEN=$PIECE(VMEDINFO,U,3)

 +7        SET IEN57=$PIECE(VMEDINFO,U,5)

 +8       ; overrides stored in 9002313.511

           DO OVERRIDE(IEN57,MEDN)

 +9       ;

 +10      ; "CAID" will make a difference

           SET PINSTYPE=$PIECE(INSPINS,",")

 +11      ;

 +12       SET DRUGIEN=$PIECE($GET(^PSRX(RXIEN,0)),U,6)

 +13       SET PROVIEN=$PIECE($GET(^PSRX(RXIEN,0)),U,4)

 +14      ;

 +15       SET ABSP("RX",MEDN,"IEN57")=IEN57

 +16       SET (RXI,ABSP("RX",MEDN,"RX IEN"))=RXIEN

 +17       SET ABSP("RX",MEDN,"Date Written")=$PIECE($GET(^PSRX(RXIEN,0)),U,13)

 +18      ;$P($G(^PSRX(RXIEN,0)),U,1)

           SET ABSP("RX",MEDN,"RX Number")=RXIEN

 +19       SET ABSP("RX",MEDN,"New/Refill")=$SELECT(RXRFIEN="":"N",1:"R")

 +20       SET ABSP("RX",MEDN,"Preauth #")=$PIECE(^ABSPTL(IEN57,1),U,9)

 +21      ; first fill

           IF 'RXRFIEN

               Begin DoDot:1

 +22               SET ABSP("RX",MEDN,"Quantity")=$PIECE($GET(^PSRX(RXIEN,0)),U,7)

 +23               SET ABSP("RX",MEDN,"Days Supply")=$PIECE($GET(^PSRX(RXIEN,0)),U,8)

 +24               SET ABSP("RX",MEDN,"Date Filled")=$PIECE($GET(^PSRX(RXIEN,2)),U,2)

 +25               SET ABSP("RX",MEDN,"NDC")=$PIECE($GET(^PSRX(RXIEN,2)),U,7)

               End DoDot:1

 +26      ; refill

          IF '$TEST

               Begin DoDot:1

 +27               SET ABSP("RX",MEDN,"Quantity")=$PIECE($GET(^PSRX(RXIEN,1,RXRFIEN,0)),U,4)

 +28               SET ABSP("RX",MEDN,"Days Supply")=$PIECE($GET(^PSRX(RXIEN,1,RXRFIEN,0)),U,10)

 +29               SET ABSP("RX",MEDN,"Date Filled")=$PIECE($GET(^PSRX(RXIEN,1,RXRFIEN,0)),U)

 +30      ;IHS/SD/lwj 03/10/04 patch 10 nxt line rmkd out, new line added

 +31      ;S ABSP("RX",MEDN,"NDC")=$P($G(^PSRX(RXIEN,1,RXRFIEN,0)),U,13)

 +32      ; patch 10

                   SET ABSP("RX",MEDN,"NDC")=$$NDCVAL^ABSPFUNC(RXIEN,RXRFIEN)

 +33      ;IHS/SD/lwj 03/10/04 patch 10 end change

               End DoDot:1

 +34      ;IHS/OIT/CNI/RAN PATCH 40 This is the proper fill date

 +35       SET ABSP("RX","Date Filled")=ABSP("RX",MEDN,"Date Filled")

 +36      ;

 +37       SET ABSP("RX",MEDN,"# Refills")=$PIECE($GET(^PSRX(RXIEN,0)),U,9)

 +38       SET ABSP("RX",MEDN,"Refill #")=$$RXRFN(RXIEN,RXRFIEN)

 +39       SET ABSP("RX",MEDN,"Prescriber IEN")=+PROVIEN

 +40       SET ABSP("RX",MEDN,"Prescriber DEA #")=$PIECE($GET(^VA(200,+PROVIEN,"PS")),U,2)

 +41       SET ABSP("RX",MEDN,"Prescriber CAID #")=$PIECE($GET(^VA(200,+PROVIEN,9999999)),U,7)

 +42      ;*1.26*2*

           SET ABSP("RX",MEDN,"Prescriber UPIN #")=$PIECE($GET(^VA(200,+PROVIEN,9999999)),U,8)

 +43      ; ANMC only?  not in Sitka's data dic.

           SET ABSP("RX",MEDN,"Prescriber Billing Location")=$SELECT(PROVIEN]"":$PIECE($GET(^VA(200,PROVIEN,9999999)),"^",11),1:"")

 +44      ;IHS/OIT/CASSEVERN/RAN 11/16/2010 PATCH 40 Adding Triplicate Serial # for New York Medicaid

 +45       SET ABSP("RX",MEDN,"Triplicate Serial #")=$PIECE($GET(^PSRX(RXIEN,9999999)),U,14)

 +46       Begin DoDot:1

 +47           NEW %

 +48           IF PINSTYPE="CAID"

                   Begin DoDot:2

 +49                   SET %=ABSP("RX",MEDN,"Prescriber CAID #")

 +50      ; special for ANMC

                       IF %=""

                           Begin DoDot:3

 +51                           NEW %1

                               SET %1=ABSP("RX",MEDN,"Prescriber Billing Location")

 +52                           SET %=$SELECT(%1=1665:"MDG275",%1=1946:"MDG867",1:"")

                           End DoDot:3

 +53                   IF %=""

                           SET %=ABSP("Site","Default CAID #")

                   End DoDot:2

 +54          IF '$TEST

                   Begin DoDot:2

 +55                   SET %=ABSP("RX",MEDN,"Prescriber DEA #")

 +56                   IF %=""

                           SET %=ABSP("Site","Default DEA #")

                   End DoDot:2

 +57           SET ABSP("RX",MEDN,"Prescriber ID")=%

           End DoDot:1

 +58      ;

 +59       IF DRUGIEN'=""

               Begin DoDot:1

 +60               SET ABSP("RX",MEDN,"Drug IEN")=DRUGIEN

 +61               SET ABSP("RX",MEDN,"Drug Name")=$PIECE($GET(^PSDRUG(DRUGIEN,0)),U,1)

 +62               IF ABSP("RX",MEDN,"NDC")=""

                       Begin DoDot:2

 +63                       SET ABSP("RX",MEDN,"NDC")=$PIECE($GET(^PSDRUG(DRUGIEN,2)),U,4)

                       End DoDot:2

               End DoDot:1

 +64       NEW PRICING

           SET PRICING=^ABSPTL(IEN57,5)

 +65      ; 01/31/2001

           SET ABSP("RX",MEDN,"Quantity")=$PIECE(PRICING,U)

 +66       SET ABSP("RX",MEDN,"Unit Price")=$PIECE(PRICING,U,2)

 +67       SET ABSP("RX",MEDN,"Ingredient Cost")=$JUSTIFY($PIECE(PRICING,U,3),0,2)

 +68       SET ABSP("RX",MEDN,"Dispensing Fee")=$JUSTIFY($PIECE(PRICING,U,4),0,2)

 +69       SET ABSP("Site","Dispensing Fee")=ABSP("RX",MEDN,"Dispensing Fee")

 +70       SET ABSP("RX",MEDN,"Gross Amount Due")=$JUSTIFY($PIECE(PRICING,U,5),0,2)

 +71       SET ABSP("RX",MEDN,"Usual & Customary")=$JUSTIFY($PIECE(PRICING,U,5),0,2)

 +72      ;IHS/OIT/SCR 11/20/08 - Add incentive amount info

 +73       SET ABSP("RX",MEDN,"Incentive Amount")=$JUSTIFY($PIECE(PRICING,U,7),0,2)

 +74       IF ABSP("NCPDP","Add Disp. Fee to Ingr. Cost")

               Begin DoDot:1

 +75               NEW X

                   SET X=ABSP("RX",MEDN,"Ingredient Cost")

 +76               SET X=X+ABSP("RX",MEDN,"Dispensing Fee")

 +77               SET ABSP("RX",MEDN,"Ingredient Cost")=X

               End DoDot:1

 +78      ;

 +79      ; Visit-related data

 +80      ;

 +81       IF IEN57

               Begin DoDot:1

 +82               NEW VSITIEN

                   SET VSITIEN=$PIECE(^ABSPTL(IEN57,0),U,7)

 +83               IF 'VSITIEN

                       QUIT

 +84      ;S ABSP("RX",MEDN,"Diagnosis Code")=$TR($$PRIMPOV^APCLV(VSITIEN,"C"),".","")

 +85      ; For paper forms, do not strip the "."

 +86      ; Strictly speaking, electronic claims should have stripped the "."

 +87      ; in the format code, not here in the fetch

 +88               SET ABSP("RX",MEDN,"Diagnosis Code")=$$PRIMPOV^APCLV(VSITIEN,"C")

               End DoDot:1

 +89       QUIT

 +90      ;

 +91      ; $$RXRFN()

 +92      ;Determine RX Refill Number based on prescription record

 +93      ;  It's overly cautious about making sure that the refills are

 +94      ;  counted in date filled order.

 +95      ;

 +96      ;Input Variables:    RXIEN    -  Prescription record IEN (52)

 +97      ;                    RXRFIEN  -  Refill multiple IEN

 +98      ;

 +99      ;Function Returns:   Null  - Could not process request

 +100     ;                    0     - Not a refill

 +101     ;                    N     - Refill number

 +102     ; Copied into here from ABSPECD4 so we can remove ABSPECD4 from kit.

 +103     ; Also called from ABSPOSN3

 +104     ;----------------------------------------------------------------------

RXRFN(RXIEN,RXRFIEN) ;EP

 +1       ;Manage local variables

 +2        NEW COUNT,DATE,XIEN,STOP

 +3       ;

 +4       ;Make sure input variables are defined

 +5        IF $GET(RXIEN)=""

               QUIT ""

 +6        IF $GET(RXRFIEN)=""

               QUIT ""

 +7       ;

 +8       ;Initialize local variables

 +9        SET (COUNT,STOP)=0

 +10      ;

 +11      ;Loop through refill multiple by date

 +12       SET DATE=""

 +13       FOR

               Begin DoDot:1

 +14               SET DATE=$ORDER(^PSRX(RXIEN,1,"B",DATE))

 +15               IF '+DATE

                       QUIT

 +16      ;

 +17      ;For each sub-record increment refill count

 +18               SET XIEN=""

 +19               FOR

                       Begin DoDot:2

 +20                       SET XIEN=$ORDER(^PSRX(RXIEN,1,"B",DATE,XIEN))

 +21                       IF '+XIEN

                               QUIT

 +22                       SET COUNT=COUNT+1

 +23      ;

 +24      ;STOP when you reach the refill record

 +25                       IF XIEN=RXRFIEN

                               SET STOP=1

                       End DoDot:2

                       IF '+XIEN!(STOP)

                           QUIT

               End DoDot:1

               IF '+DATE!(STOP)

                   QUIT

 +26       QUIT $SELECT(STOP=1:COUNT,1:0)

 +27      ;

 +28      ; Retrieve OVERRIDE nodes and put into ABSP array

 +29      ; They will be fetched from ABSP("OVERRIDE"

 +30      ; during low-level construction of the actual encoded claim packet.

 +31      ;

OVERRIDE(IEN57,MEDN) ; set any ABSP("OVERRIDE" nodes from 9002313.511 data

 +1       ; ABSP("OVERRIDE",field)=value  for fields 101-401

 +2       ; ABSP("OVERRIDE","RX",MEDN,field) for med #N, fields 402+

 +3       ; Note that if you have multiple prescriptions bundled, the

 +4       ; union of overrides from 101-401 apply to all; and if there's a

 +5       ; conflict, the last one overwrites the previous ones.

 +6        NEW IEN511

           SET IEN511=$PIECE(^ABSPTL(IEN57,1),U,13)

           IF 'IEN511

               QUIT

 +7        DO GET511^ABSPOSO2(IEN511,"ABSP(""OVERRIDE"")","ABSP(""OVERRIDE"",""RX"","_MEDN_")")

CC         QUIT

ABSPOSFD.m