Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABSPOSN3

ABSPOSN3.m

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