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.
;----------------------------------------------------------------------
Q
;----------------------------------------------------------------------
;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)
D
. 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")
Q
;
; $$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
