ABSPOSN3 ; IHS/FCS/DRS - NCPDP Fms F ILC A/R ; [ 09/12/2002 10:16 AM ]
;;1.0;PHARMACY POINT OF SALE;**3,10**;JUN 21, 2001;Build 27
;----------------------------------------------------------------------
;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.
;----------------------------------------------------------------------
;
; YOU REALLY REALLY REALLY SHOULD GET THIS DATA BY
; CALLING ABSPOSQ*
; an ABSP(...) array, just like what is done F the point of sale
; claims.
PATINFO(PATIEN,PATINFO) ;EP
;Manage local variables
N XDATA
;
Q:$G(PATIEN)=""
Q:'$D(^DPT(PATIEN,0))
;
S XDATA=$G(^DPT(PATIEN,0))
S PATINFO("Name")=$P(XDATA,U,1)
S PATINFO("Sex")=$P(XDATA,U,2)
S PATINFO("DOB")=$P(XDATA,U,3)
S PATINFO("SSN")=$P(XDATA,U,9)
Q
;---------------------------------------------------------------------
INSADDR ; Given INSDFN
N X,Y S X=$G(^AUTNINS(INSDFN,0))
S INSINFO("INS. Co. Name")=$P(X,U)
S INSINFO("INS. Co. Addr 1")=$P(X,U,2)
S INSINFO("INS. Co. Addr 2")=""
S Y=$P(X,U,4) I Y S Y=$P(^DIC(5,Y,0),U,2)
S INSINFO("INS. Co. City/State/Zip")=$P(X,U,3)_" "_Y_" "_$P(X,U,5)
Q
INSINFO(INSDATA,INSINFO,TYPE) ;EP
I TYPE="INSCOV1" D Q
. S (INSINFO("IEN"),INSDFN)=$P(INSDATA(1),U,2)
. D INSADDR
. S INSINFO("Cardholder Name")=$P(INSDATA(0),U,3)
. D INSREL1($P(INSDATA(0),U,13))
. S INSINFO("Other 3rd Party Coverage")=$$OTHER3RD
. S INSINFO("Cardholder Number")=$P(INSDATA(0),U,2)
. ; INSCOV1 has a group number but no group name?
. ; F now, U the same value F both name and number
. S INSINFO("Group Name")=$P(INSDATA(0),U,9)
. S INSINFO("Group Number")=$P(INSDATA(0),U,9)
N X,Y
N INSDFN S INSDFN=$P(INSDATA,U,$S(TYPE="CARE":4,1:5))
S INSINFO("IEN")=$S(INSDFN:INSDFN,1:-1) ; cannot let INSINFO("IEN")=""
D INSADDR
S INSINFO("Cardholder Name")=$P(INSDATA,U,$S(TYPE="PRVT":7,TYPE="CAID":6,1:0))
D INSREL($S(TYPE="PRVT":$P(INSDATA,U,6),1:""))
S INSINFO("Other 3rd Party Coverage")=$$OTHER3RD
S INSINFO("Cardholder Number")=$P(INSDATA,U,$S(TYPE="PRVT":2,1:1))
S INSINFO("Group Name")=$S(TYPE="PRVT":$P(INSDATA,U,10),1:"")
S INSINFO("Group Number")=$S(TYPE="PRVT":$P(INSDATA,U,11),1:"")
Q
INSREL(X) ;
I 'X S X=$O(^AUTTRLSH("B","SELF",0))
S INSINFO("Relationship")=X
Q
INSREL1(X) ; the INSCOV1 version
S INSINFO("Relationship")=X ; it's already 1-2-3-4'd
Q
;--------------------------------------------------------------------
OTHER3RD() ; return true or false ; a best-efFt quickie,
; not entirely sure I this works 100% of the time
; Also, D they mean "other 3rd party coverage available now"?
; And really, what D we D F rollovers? This is a mess.
;
N RETVAL S RETVAL=0 ; assume not
; I there's no second INSCOV, say NO
N NEXT S NEXT=IADTINS+1
I $D(^ABSBITMS(9002302,PCNDFN,"INSCOV1")) D ; N INSCOV1 version
. I '$D(^ABSBITMS(9002302,PCNDFN,"INSCOV1",NEXT)) Q
. I ^ABSBITMS(9002302,PCNDFN,"INSCOV1",NEXT,1)["SELF" Q
. S RETVAL=1
E D
. I '$D(^ABSBITMS(9002302,PCNDFN,"INSCOV",NEXT)) Q
. ; I the second INSCOV is SELF PAY or SELF, say NO
. I $O(^ABSBITMS(9002302,PCNDFN,"INSCOV",NEXT,""))["SELF" Q
. ; Otherwise, there's a second INSCOV and it must be CARE,CAID,PRVT,RR
. S RETVAL=1
Q RETVAL ; so "yes", there is other 3rd party coverage
; following is another quick and dirty version of it:
OLD3RD() ; this was never actually Ud. Interesting to see I it agrees
; with OTHER3RD, above
N IADTINS S IADTINS=$P(^ABSBITMS(9002302,PCNDFN,0),U,4)
I 'IADTINS S IADTINS=1
I IADTINS=IADTINS+1
N X S X=$O(^ABSBITMS(9002302,PCNDFN,"INSCOV",IADTINS,""))
Q $S(X="PRVT":1,X="CAID":1,X="CARE":1,X="RR":1,X["SELF":0,1:0)
PHARINFO(PHARINFO,F57IEN) ;EP
; want to create field in PEC/MIS - PHARmacies file
; and take it from here
N PHARM1 S PHARM1=$O(^ABSP(9002313.56,0))
N PHARM I $G(F57IEN) S PHARM=$P($G(^ABSPTL(F57IEN,1)),U,7)
I '$G(PHARM) S PHARM=PHARM1
;
S X=$P(^ABSP(9002313.56,PHARM,0),U)
I X="" S X=$P(^ABSP(9002313.56,PHARM1,0),U)
I X="" S X=$P($G(^ABSSETUP(9002314,1,50)),U,5)
S PHARINFO("Name")=X
;
N X S X=$G(^ABSP(9002313.56,PHARM,"ADDR"))
I X="" S X=$G(^ABSP(9002313.56,PHARM1,"ADDR1"))
I X="" S X=$G(^ABSSETUP(9002314,1,50)),X=$P(X,U,4)_U_U_$P(X,U,1,3)
S PHARINFO("Street")=$P(X,U)
S PHARINFO("City/State/ZIP")=$TR($P(X,U,3,5),U," ")
;
S X=$G(^ABSP(9002313.56,PHARM,"REP"))
I X="" S X=$G(^ABSP(9002313.56,PHARM1,"REP"))
I X="" S X="PHARmacy Billing Staff"_U_$P($G(^ABSSETUP(9002314,1,50)),U,6)
N Y S Y=$P(X,U,2),X=$P(X,U) ; X=rep, Y=phone
N Z S Z=$R($L(X,"/"))+1 ; randomly choose from among several reps
S PHARINFO("Phone")=$P(Y,"/",Z)
S PHARINFO("Representative")=$P(X,"/",Z)
I PHARINFO("Phone")="",DUZ(2)=1859 D
. S PHARINFO("Phone")="(999) 999-9999"
;
S X=$P(^ABSP(9002313.56,PHARM,0),U,2)
I X="" S X=$P(^ABSP(9002313.56,PHARM1,0),U,2)
I X="" S X=$P($G(^ABSSETUP(9002314,1,"RX")),U,2)
S PHARINFO("PHARmacy #")=X
;
S X=$P($G(^ABSP(9002313.56,PHARM,"CAID")),U)
I X="" S X=$P($G(^ABSP(9002313.56,PHARM1,"CAID")),U)
S PHARINFO("Medicaid PHARmacy #")=X
;
D ; Tax ID # - some INSurance companies want this printed, INStead
. S X=$P($G(^ABSP(9002313.56,PHARM,0)),U,5) ; maybe PHARm-specific
. I X="" S X=$P($G(^ABSSETUP(9002314,1,60)),U) ; else billing setup
. S PHARINFO("Tax ID #")=X
Q
;--------------------------------------------------------------------
DRUGINFO(VMEDINFO,DRUGN,DRUGINFO) ;EP
;Manage local variables
N VMEDIEN,RXIEN,RXRFIEN,DRUGIEN,PROVIEN,PERIEN,VCPTIEN,F57IEN
;
Q:$G(VMEDINFO)=""
Q:$G(DRUGN)=""
;
S VMEDIEN=$P(VMEDINFO,U,1)
S RXIEN=$P(VMEDINFO,U,2)
S RXRFIEN=$P(VMEDINFO,U,3)
S F57IEN=$P(VMEDINFO,U,6)
S DRUGIEN=$P($G(^PSRX(RXIEN,0)),U,6)
S PROVIEN=$P($G(^PSRX(RXIEN,0)),U,4) ; points to file 200
S PERIEN=$S(PROVIEN="":"",1:$P($G(^VA(200,PROVIEN,0)),U,1))
S VCPTIEN=$P(VMEDINFO,U,5)
;
S DRUGINFO("Date Written")=$P(VMEDINFO,U,4)
;ZW RXIEN,RXRFIEN R ">>>",%,!
; Sadly, it is possible F some of the refills to be deleted
; after the fact! Have to U more $Gs and IFs
N X I RXRFIEN S X=$P($G(^PSRX(RXIEN,1,RXRFIEN,0)),U)
E S X=$P(^PSRX(RXIEN,2),U,2)
S DRUGINFO("Date Filled")=X ;$P($G(^AUPNVSIT(VSTIEN,0)),U,1)
S DRUGINFO(DRUGN,"RX Number")=$P($G(^PSRX(RXIEN,0)),U,1)
;
; THIS REFILL COUNT IS GOING TO BE WRONG I YOU PRINT THE BILL
; AFTER THE NEXT REFILL HAS HAPPENED!!!
;S X=$P($G(^PSRX(RXIEN,0)),U,9) I X,$L(X<2) S X=0_X
S X=$$RXRFN^ABSPOSCD(RXIEN,RXRFIEN) ; SO USE THESE-CLAIMS SUBROUTINE INSTEAD
S DRUGINFO(DRUGN,"N/Refill")=$TR($J(X,2)," ","0") ;$S(X:X,1:"00") K X
;S DRUGINFO(DRUGN,"Metric Quantity")=$S(VMEDIEN:$P($G(^AUPNVMED(VMEDIEN,0)),U,6),1:"")
;I 'VMEDIEN S DRUGINFO(DRUGN,"Metric Quantity")=$S(RXIEN:$P($G(^PSRX(RXIEN,0)),U,7),1:"")
I RXRFIEN S X=$P($G(^PSRX(RXIEN,1,RXRFIEN,0)),U,4)
E S X=$P(^PSRX(RXIEN,0),U,7)
S DRUGINFO(DRUGN,"Metric Quantity")=X ; actually Metric Decimal Quantity
I RXRFIEN S X=$P($G(^PSRX(RXIEN,1,RXRFIEN,0)),U,10)
E S X=$P(^PSRX(RXIEN,0),U,8)
S DRUGINFO(DRUGN,"Days Supply")=X ;$S(VMEDIEN:$P($G(^AUPNVMED(VMEDIEN,0)),U,7),1:"")
;I 'VMEDIEN S DRUGINFO(DRUGN,"Days Supply")=$S(RXIEN:$P($G(^PSRX(RXIEN,0)),U,8),1:"")
;IHS/SD/lwj 03/10/04 patch 10 rmkd next line out, new line added
;I RXRFIEN S X=$P($G(^PSRX(RXIEN,1,RXRFIEN,0)),U,13) ;patch 10
I RXRFIEN S X=$$NDCVAL^ABSPFUNC(RXIEN,RXRFIEN) ;patch 10
E S X=$P(^PSRX(RXIEN,2),U,7)
;IHS/SD/lwj 03/10/04 patch 10 end change
S DRUGINFO(DRUGN,"NDC Code")=X ;$S(DRUGIEN="":"",1:$P($G(^PSDRUG(DRUGIEN,2)),U,4))
S DRUGINFO(DRUGN,"DRUG Name")=$S(DRUGIEN="":"",1:$P($G(^PSDRUG(DRUGIEN,0)),U,1))
S DRUGINFO(DRUGN,"Prescriber")=$S(PERIEN'="":PERIEN,1:"")
S DRUGINFO(DRUGN,"Presc. DEA #")=$S(PROVIEN'="":$P($G(^VA(200,PROVIEN,"PS")),U,2),1:"")
S DRUGINFO(DRUGN,"Presc. Mcaid #")=$S(PROVIEN'="":$P($G(^VA(200,PROVIEN,9999999)),U,7),1:"") ;2/18/2000 DL
I DRUGINFO(DRUGN,"Presc. Mcaid #")="" D
. N PHARM S PHARM=$P(^ABSPTL(F57IEN,1),U,7)
. S DRUGINFO(DRUGN,"Presc. Mcaid #")=$P($G(^ABSP(9002313.56,PHARM,"CAID")),U,2) ; default Medicaid Provider # F this PHARmacy
I DRUGINFO(DRUGN,"Presc. DEA #")="" D
. N PHARM S PHARM=$P(^ABSPTL(F57IEN,1),U,7)
. S DRUGINFO(DRUGN,"Presc. DEA #")=$P(^ABSP(9002313.56,PHARM,0),U,3)
N X S X=^ABSPTL(F57IEN,5)
S DRUGINFO(DRUGN,"Disp. Fee")=$P(X,U,4)
S DRUGINFO(DRUGN,"Total Price")=$P(X,U,5) ;$S(VCPTIEN="":"",1:$P($G(^ABSVCPT(9002301,VCPTIEN,0)),U,5))
S DRUGINFO(DRUGN,"Ingr. Cost")=$P(X,U,3) ;DRUGINFO(DRUGN,"Total Price")-DRUGINFO(DRUGN,"Disp. Fee")
;S:DRUGINFO(DRUGN,"Ingr. Cost")<0 DRUGINFO(DRUGN,"Ingr. Cost")=0
S DRUGINFO(DRUGN,"Balance")=DRUGINFO(DRUGN,"Total Price")
Q
ABSPOSN3 ; IHS/FCS/DRS - NCPDP Fms F ILC A/R ; [ 09/12/2002 10:16 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3,10**;JUN 21, 2001;Build 27
+2 ;----------------------------------------------------------------------
+3 ;IHS/SD/lwj 03/10/04 patch 10
+4 ; Routine adjusted to call ABSPFUNC to retrieve
+5 ; the Prescription Refill NDC value. At some
+6 ; point the call needs to be modified to call APSPFUNC.
+7 ; See ABSPFUNC for details on why call was done.
+8 ;----------------------------------------------------------------------
+9 ;
+10 ; YOU REALLY REALLY REALLY SHOULD GET THIS DATA BY
+11 ; CALLING ABSPOSQ*
+12 ; an ABSP(...) array, just like what is done F the point of sale
+13 ; claims.
PATINFO(PATIEN,PATINFO) ;EP
+1 ;Manage local variables
+2 NEW XDATA
+3 ;
+4 IF $GET(PATIEN)=""
QUIT
+5 IF '$DATA(^DPT(PATIEN,0))
QUIT
+6 ;
+7 SET XDATA=$GET(^DPT(PATIEN,0))
+8 SET PATINFO("Name")=$PIECE(XDATA,U,1)
+9 SET PATINFO("Sex")=$PIECE(XDATA,U,2)
+10 SET PATINFO("DOB")=$PIECE(XDATA,U,3)
+11 SET PATINFO("SSN")=$PIECE(XDATA,U,9)
+12 QUIT
+13 ;---------------------------------------------------------------------
INSADDR ; Given INSDFN
+1 NEW X,Y
SET X=$GET(^AUTNINS(INSDFN,0))
+2 SET INSINFO("INS. Co. Name")=$PIECE(X,U)
+3 SET INSINFO("INS. Co. Addr 1")=$PIECE(X,U,2)
+4 SET INSINFO("INS. Co. Addr 2")=""
+5 SET Y=$PIECE(X,U,4)
IF Y
SET Y=$PIECE(^DIC(5,Y,0),U,2)
+6 SET INSINFO("INS. Co. City/State/Zip")=$PIECE(X,U,3)_" "_Y_" "_$PIECE(X,U,5)
+7 QUIT
INSINFO(INSDATA,INSINFO,TYPE) ;EP
+1 IF TYPE="INSCOV1"
Begin DoDot:1
+2 SET (INSINFO("IEN"),INSDFN)=$PIECE(INSDATA(1),U,2)
+3 DO INSADDR
+4 SET INSINFO("Cardholder Name")=$PIECE(INSDATA(0),U,3)
+5 DO INSREL1($PIECE(INSDATA(0),U,13))
+6 SET INSINFO("Other 3rd Party Coverage")=$$OTHER3RD
+7 SET INSINFO("Cardholder Number")=$PIECE(INSDATA(0),U,2)
+8 ; INSCOV1 has a group number but no group name?
+9 ; F now, U the same value F both name and number
+10 SET INSINFO("Group Name")=$PIECE(INSDATA(0),U,9)
+11 SET INSINFO("Group Number")=$PIECE(INSDATA(0),U,9)
End DoDot:1
QUIT
+12 NEW X,Y
+13 NEW INSDFN
SET INSDFN=$PIECE(INSDATA,U,$SELECT(TYPE="CARE":4,1:5))
+14 ; cannot let INSINFO("IEN")=""
SET INSINFO("IEN")=$SELECT(INSDFN:INSDFN,1:-1)
+15 DO INSADDR
+16 SET INSINFO("Cardholder Name")=$PIECE(INSDATA,U,$SELECT(TYPE="PRVT":7,TYPE="CAID":6,1:0))
+17 DO INSREL($SELECT(TYPE="PRVT":$PIECE(INSDATA,U,6),1:""))
+18 SET INSINFO("Other 3rd Party Coverage")=$$OTHER3RD
+19 SET INSINFO("Cardholder Number")=$PIECE(INSDATA,U,$SELECT(TYPE="PRVT":2,1:1))
+20 SET INSINFO("Group Name")=$SELECT(TYPE="PRVT":$PIECE(INSDATA,U,10),1:"")
+21 SET INSINFO("Group Number")=$SELECT(TYPE="PRVT":$PIECE(INSDATA,U,11),1:"")
+22 QUIT
INSREL(X) ;
+1 IF 'X
SET X=$ORDER(^AUTTRLSH("B","SELF",0))
+2 SET INSINFO("Relationship")=X
+3 QUIT
INSREL1(X) ; the INSCOV1 version
+1 ; it's already 1-2-3-4'd
SET INSINFO("Relationship")=X
+2 QUIT
+3 ;--------------------------------------------------------------------
OTHER3RD() ; return true or false ; a best-efFt quickie,
+1 ; not entirely sure I this works 100% of the time
+2 ; Also, D they mean "other 3rd party coverage available now"?
+3 ; And really, what D we D F rollovers? This is a mess.
+4 ;
+5 ; assume not
NEW RETVAL
SET RETVAL=0
+6 ; I there's no second INSCOV, say NO
+7 NEW NEXT
SET NEXT=IADTINS+1
+8 ; N INSCOV1 version
IF $DATA(^ABSBITMS(9002302,PCNDFN,"INSCOV1"))
Begin DoDot:1
+9 IF '$DATA(^ABSBITMS(9002302,PCNDFN,"INSCOV1",NEXT))
QUIT
+10 IF ^ABSBITMS(9002302,PCNDFN,"INSCOV1",NEXT,1)["SELF"
QUIT
+11 SET RETVAL=1
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 IF '$DATA(^ABSBITMS(9002302,PCNDFN,"INSCOV",NEXT))
QUIT
+14 ; I the second INSCOV is SELF PAY or SELF, say NO
+15 IF $ORDER(^ABSBITMS(9002302,PCNDFN,"INSCOV",NEXT,""))["SELF"
QUIT
+16 ; Otherwise, there's a second INSCOV and it must be CARE,CAID,PRVT,RR
+17 SET RETVAL=1
End DoDot:1
+18 ; so "yes", there is other 3rd party coverage
QUIT RETVAL
+19 ; following is another quick and dirty version of it:
OLD3RD() ; this was never actually Ud. Interesting to see I it agrees
+1 ; with OTHER3RD, above
+2 NEW IADTINS
SET IADTINS=$PIECE(^ABSBITMS(9002302,PCNDFN,0),U,4)
+3 IF 'IADTINS
SET IADTINS=1
+4 IF IADTINS=IADTINS+1
+5 NEW X
SET X=$ORDER(^ABSBITMS(9002302,PCNDFN,"INSCOV",IADTINS,""))
+6 QUIT $SELECT(X="PRVT":1,X="CAID":1,X="CARE":1,X="RR":1,X["SELF":0,1:0)
PHARINFO(PHARINFO,F57IEN) ;EP
+1 ; want to create field in PEC/MIS - PHARmacies file
+2 ; and take it from here
+3 NEW PHARM1
SET PHARM1=$ORDER(^ABSP(9002313.56,0))
+4 NEW PHARM
IF $GET(F57IEN)
SET PHARM=$PIECE($GET(^ABSPTL(F57IEN,1)),U,7)
+5 IF '$GET(PHARM)
SET PHARM=PHARM1
+6 ;
+7 SET X=$PIECE(^ABSP(9002313.56,PHARM,0),U)
+8 IF X=""
SET X=$PIECE(^ABSP(9002313.56,PHARM1,0),U)
+9 IF X=""
SET X=$PIECE($GET(^ABSSETUP(9002314,1,50)),U,5)
+10 SET PHARINFO("Name")=X
+11 ;
+12 NEW X
SET X=$GET(^ABSP(9002313.56,PHARM,"ADDR"))
+13 IF X=""
SET X=$GET(^ABSP(9002313.56,PHARM1,"ADDR1"))
+14 IF X=""
SET X=$GET(^ABSSETUP(9002314,1,50))
SET X=$PIECE(X,U,4)_U_U_$PIECE(X,U,1,3)
+15 SET PHARINFO("Street")=$PIECE(X,U)
+16 SET PHARINFO("City/State/ZIP")=$TRANSLATE($PIECE(X,U,3,5),U," ")
+17 ;
+18 SET X=$GET(^ABSP(9002313.56,PHARM,"REP"))
+19 IF X=""
SET X=$GET(^ABSP(9002313.56,PHARM1,"REP"))
+20 IF X=""
SET X="PHARmacy Billing Staff"_U_$PIECE($GET(^ABSSETUP(9002314,1,50)),U,6)
+21 ; X=rep, Y=phone
NEW Y
SET Y=$PIECE(X,U,2)
SET X=$PIECE(X,U)
+22 ; randomly choose from among several reps
NEW Z
SET Z=$RANDOM($LENGTH(X,"/"))+1
+23 SET PHARINFO("Phone")=$PIECE(Y,"/",Z)
+24 SET PHARINFO("Representative")=$PIECE(X,"/",Z)
+25 IF PHARINFO("Phone")=""
IF DUZ(2)=1859
Begin DoDot:1
+26 SET PHARINFO("Phone")="(999) 999-9999"
End DoDot:1
+27 ;
+28 SET X=$PIECE(^ABSP(9002313.56,PHARM,0),U,2)
+29 IF X=""
SET X=$PIECE(^ABSP(9002313.56,PHARM1,0),U,2)
+30 IF X=""
SET X=$PIECE($GET(^ABSSETUP(9002314,1,"RX")),U,2)
+31 SET PHARINFO("PHARmacy #")=X
+32 ;
+33 SET X=$PIECE($GET(^ABSP(9002313.56,PHARM,"CAID")),U)
+34 IF X=""
SET X=$PIECE($GET(^ABSP(9002313.56,PHARM1,"CAID")),U)
+35 SET PHARINFO("Medicaid PHARmacy #")=X
+36 ;
+37 ; Tax ID # - some INSurance companies want this printed, INStead
Begin DoDot:1
+38 ; maybe PHARm-specific
SET X=$PIECE($GET(^ABSP(9002313.56,PHARM,0)),U,5)
+39 ; else billing setup
IF X=""
SET X=$PIECE($GET(^ABSSETUP(9002314,1,60)),U)
+40 SET PHARINFO("Tax ID #")=X
End DoDot:1
+41 QUIT
+42 ;--------------------------------------------------------------------
DRUGINFO(VMEDINFO,DRUGN,DRUGINFO) ;EP
+1 ;Manage local variables
+2 NEW VMEDIEN,RXIEN,RXRFIEN,DRUGIEN,PROVIEN,PERIEN,VCPTIEN,F57IEN
+3 ;
+4 IF $GET(VMEDINFO)=""
QUIT
+5 IF $GET(DRUGN)=""
QUIT
+6 ;
+7 SET VMEDIEN=$PIECE(VMEDINFO,U,1)
+8 SET RXIEN=$PIECE(VMEDINFO,U,2)
+9 SET RXRFIEN=$PIECE(VMEDINFO,U,3)
+10 SET F57IEN=$PIECE(VMEDINFO,U,6)
+11 SET DRUGIEN=$PIECE($GET(^PSRX(RXIEN,0)),U,6)
+12 ; points to file 200
SET PROVIEN=$PIECE($GET(^PSRX(RXIEN,0)),U,4)
+13 SET PERIEN=$SELECT(PROVIEN="":"",1:$PIECE($GET(^VA(200,PROVIEN,0)),U,1))
+14 SET VCPTIEN=$PIECE(VMEDINFO,U,5)
+15 ;
+16 SET DRUGINFO("Date Written")=$PIECE(VMEDINFO,U,4)
+17 ;ZW RXIEN,RXRFIEN R ">>>",%,!
+18 ; Sadly, it is possible F some of the refills to be deleted
+19 ; after the fact! Have to U more $Gs and IFs
+20 NEW X
IF RXRFIEN
SET X=$PIECE($GET(^PSRX(RXIEN,1,RXRFIEN,0)),U)
+21 IF '$TEST
SET X=$PIECE(^PSRX(RXIEN,2),U,2)
+22 ;$P($G(^AUPNVSIT(VSTIEN,0)),U,1)
SET DRUGINFO("Date Filled")=X
+23 SET DRUGINFO(DRUGN,"RX Number")=$PIECE($GET(^PSRX(RXIEN,0)),U,1)
+24 ;
+25 ; THIS REFILL COUNT IS GOING TO BE WRONG I YOU PRINT THE BILL
+26 ; AFTER THE NEXT REFILL HAS HAPPENED!!!
+27 ;S X=$P($G(^PSRX(RXIEN,0)),U,9) I X,$L(X<2) S X=0_X
+28 ; SO USE THESE-CLAIMS SUBROUTINE INSTEAD
SET X=$$RXRFN^ABSPOSCD(RXIEN,RXRFIEN)
+29 ;$S(X:X,1:"00") K X
SET DRUGINFO(DRUGN,"N/Refill")=$TRANSLATE($JUSTIFY(X,2)," ","0")
+30 ;S DRUGINFO(DRUGN,"Metric Quantity")=$S(VMEDIEN:$P($G(^AUPNVMED(VMEDIEN,0)),U,6),1:"")
+31 ;I 'VMEDIEN S DRUGINFO(DRUGN,"Metric Quantity")=$S(RXIEN:$P($G(^PSRX(RXIEN,0)),U,7),1:"")
+32 IF RXRFIEN
SET X=$PIECE($GET(^PSRX(RXIEN,1,RXRFIEN,0)),U,4)
+33 IF '$TEST
SET X=$PIECE(^PSRX(RXIEN,0),U,7)
+34 ; actually Metric Decimal Quantity
SET DRUGINFO(DRUGN,"Metric Quantity")=X
+35 IF RXRFIEN
SET X=$PIECE($GET(^PSRX(RXIEN,1,RXRFIEN,0)),U,10)
+36 IF '$TEST
SET X=$PIECE(^PSRX(RXIEN,0),U,8)
+37 ;$S(VMEDIEN:$P($G(^AUPNVMED(VMEDIEN,0)),U,7),1:"")
SET DRUGINFO(DRUGN,"Days Supply")=X
+38 ;I 'VMEDIEN S DRUGINFO(DRUGN,"Days Supply")=$S(RXIEN:$P($G(^PSRX(RXIEN,0)),U,8),1:"")
+39 ;IHS/SD/lwj 03/10/04 patch 10 rmkd next line out, new line added
+40 ;I RXRFIEN S X=$P($G(^PSRX(RXIEN,1,RXRFIEN,0)),U,13) ;patch 10
+41 ;patch 10
IF RXRFIEN
SET X=$$NDCVAL^ABSPFUNC(RXIEN,RXRFIEN)
+42 IF '$TEST
SET X=$PIECE(^PSRX(RXIEN,2),U,7)
+43 ;IHS/SD/lwj 03/10/04 patch 10 end change
+44 ;$S(DRUGIEN="":"",1:$P($G(^PSDRUG(DRUGIEN,2)),U,4))
SET DRUGINFO(DRUGN,"NDC Code")=X
+45 SET DRUGINFO(DRUGN,"DRUG Name")=$SELECT(DRUGIEN="":"",1:$PIECE($GET(^PSDRUG(DRUGIEN,0)),U,1))
+46 SET DRUGINFO(DRUGN,"Prescriber")=$SELECT(PERIEN'="":PERIEN,1:"")
+47 SET DRUGINFO(DRUGN,"Presc. DEA #")=$SELECT(PROVIEN'="":$PIECE($GET(^VA(200,PROVIEN,"PS")),U,2),1:"")
+48 ;2/18/2000 DL
SET DRUGINFO(DRUGN,"Presc. Mcaid #")=$SELECT(PROVIEN'="":$PIECE($GET(^VA(200,PROVIEN,9999999)),U,7),1:"")
+49 IF DRUGINFO(DRUGN,"Presc. Mcaid #")=""
Begin DoDot:1
+50 NEW PHARM
SET PHARM=$PIECE(^ABSPTL(F57IEN,1),U,7)
+51 ; default Medicaid Provider # F this PHARmacy
SET DRUGINFO(DRUGN,"Presc. Mcaid #")=$PIECE($GET(^ABSP(9002313.56,PHARM,"CAID")),U,2)
End DoDot:1
+52 IF DRUGINFO(DRUGN,"Presc. DEA #")=""
Begin DoDot:1
+53 NEW PHARM
SET PHARM=$PIECE(^ABSPTL(F57IEN,1),U,7)
+54 SET DRUGINFO(DRUGN,"Presc. DEA #")=$PIECE(^ABSP(9002313.56,PHARM,0),U,3)
End DoDot:1
+55 NEW X
SET X=^ABSPTL(F57IEN,5)
+56 SET DRUGINFO(DRUGN,"Disp. Fee")=$PIECE(X,U,4)
+57 ;$S(VCPTIEN="":"",1:$P($G(^ABSVCPT(9002301,VCPTIEN,0)),U,5))
SET DRUGINFO(DRUGN,"Total Price")=$PIECE(X,U,5)
+58 ;DRUGINFO(DRUGN,"Total Price")-DRUGINFO(DRUGN,"Disp. Fee")
SET DRUGINFO(DRUGN,"Ingr. Cost")=$PIECE(X,U,3)
+59 ;S:DRUGINFO(DRUGN,"Ingr. Cost")<0 DRUGINFO(DRUGN,"Ingr. Cost")=0
+60 SET DRUGINFO(DRUGN,"Balance")=DRUGINFO(DRUGN,"Total Price")
+61 QUIT
