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

ABSPOSPE.m

Go to the documentation of this file. 
  1. ABSPOSPE ; IHS/OIT/RAN - Pharmacy EXPENSE report modeled after ABSPOSEX Patient Expense report
  1.  ;;1.0;PHARMACY POINT OF SALE;**38,40,44**;MAR 8, 2010;Build 38
  1.   Q
  1.     ;
  1. MAIN(ABSPTRNS) ;PHAREX
  1.  N ABSPPNAM,ABSPPINF,ABSPPHRM,ABSPRXDT,ABSPARRY,ABSPDOB,ABSPTMP,ABSPPHRN,ABSPEND
  1.  N ABSPPDOB,ABSPSDAT,ABSPSDAT,ABSPSTRT,ABSPEND,ABSPPRMI,ABSPFROM,ABSPTO,ABSPPROV
  1.  N ABSPDTOT,ABSPDINS,ABSPDDUE,ABSPRUN,OK,IO
  1.  S ABSPPIEN=$P(^ABSPTL(ABSPTRNS,0),U,6)
  1.  Q:ABSPPIEN=""
  1.  S ABSPPHRM=$P(^ABSPTL(ABSPTRNS,1),U,7)
  1.  Q:ABSPPHRM=""
  1.  S ABSPRUN=$$CHKPARMS(ABSPPIEN,ABSPPHRM) ;MAKE SURE THEY HAVE ASKED TO RUN THESE REPORTS
  1.  Q:'ABSPRUN
  1.  S ABSPPNAM=$P(^DPT(ABSPPIEN,0),U,1)  ;VA(200 patient name
  1.  S ABSPPDOB=$$DOB^AUPNPAT(ABSPPIEN,"E")
  1.  S ABSPPHRN=$$HRN^AUPNPAT(ABSPPIEN,DUZ(2))
  1.  S OK=0
  1.  ;IHS/OIT/CASSEVERN/RCS patch 44 5/21/2012 Make Device selection Pharmacy Specific
  1.  S OK=$$DEVSEL(ABSPPHRM)
  1.  Q:'OK  ;Even if they chose to run this report, if they didn't set up a device don't bother
  1.  D GETINFO(ABSPPIEN,ABSPTRNS)
  1.  S ABSPSDAT=""
  1.  U IO W !,"PATIENT: "_ABSPPNAM_"   DOB: "_ABSPPDOB_"    HRN: "_ABSPPHRN
  1.  F  S ABSPSDAT=$O(ABSPTMP(ABSPSDAT)) Q:ABSPSDAT=""  D
  1.  . Q:ABSPTMP(ABSPSDAT)=""
  1.  . S Y=ABSPSDAT D DD^%DT
  1.  . U IO W !!?10,"RELEASE DATE: "_Y
  1.  . S ABSPPHRM=""
  1.  . F  S ABSPPHRM=$O(ABSPTMP(ABSPSDAT,ABSPPHRM)) Q:ABSPPHRM=""  D
  1.  . . S ABSPDTOT=0,ABSPDINS=0,ABSPDDUE=0
  1.  . . U IO W !!?8,"PHARMACY: "_$P($G(^ABSP(9002313.56,ABSPPHRM,0)),"^",1)
  1.  . . S ABSPPRMI=""
  1.  . . F  S ABSPPRMI=$O(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRMI)) Q:ABSPPRMI=""  D
  1.  . . . U IO W !!,"RX #/REFILL: `"_ABSPPRMI_"/"_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRMI),U,1)
  1.  . . . S Y=$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRMI),"^",2) D DD^%DT
  1.  . . . U IO W !?0,"TRANSACTION DATE: "_Y,?40,"TRANSACTION TYPE: "_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRMI),"^",4)
  1.  . . . U IO W !?5,"DRUG NAME: "_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRMI),"^",5),?50,"NDC#: "_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRMI),"^",6)
  1.  . . . U IO W !?5,"QTY: "_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRMI),"^",9),?50,"D/S: "_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRMI),"^",10)
  1.  . . . S ABSPPROV=$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRMI),"^",7)
  1.  . . . U IO W !?5,"PROVIDER NAME: "_$P(^VA(200,ABSPPROV,0),"^",1),?50,"PROVIDER NPI#: "_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRMI),"^",8)
  1.  . . . U IO W !?0,"TOTAL PRICE: "_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRMI),"^",11),?25,"INSURER PAID: "_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRMI),"^",12),?53,"AMOUNT DUE: "_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRMI),"^",13)
  1.  . . . S ABSPDTOT=ABSPDTOT+$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRMI),"^",11)
  1.  . . . S ABSPDINS=ABSPDINS+$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRMI),"^",12)
  1.  . . . S ABSPDDUE=ABSPDDUE+$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRMI),"^",13)
  1.  . U IO W !!,?0,"TOTAL: "_ABSPDTOT,?25,"INS PAID: "_ABSPDINS,?53,"DUE: "_ABSPDDUE
  1.  D ZEND
  1.  Q
  1.  ;
  1. GETINFO(ABSPPIEN,ABSPTRNS)  ;GET PRESCRIPTION INFO
  1.  N ABSPRDT,ABSPPHRM,ABSPCTYP,ABSPDAT,ABSPTRXI,ABSPDRGP,ABSPDRGN,ABSPNDC,ABSPPROV
  1.  N ABSPPNPI,ABSPQTY,ABSPDAYS,ABSPCPAY,ABSPDAYS,ABSPTDAT,ABSPDONE,ABSPCTYN,ABSPTPAT,ABSPRXR,ABSPRXN
  1.  N ABSPRESP,ABSPPSTN,ABSPNET,RESP
  1.  S ABSPTPAT=$P($G(^ABSPTL(ABSPTRNS,0)),U,6) ;TRANSACTION PATIENT
  1.  Q:ABSPTPAT'=ABSPPIEN  ;NOT SELECTED PATIENT
  1.  S ABSPPHRM=$P($G(^ABSPTL(ABSPTRNS,1)),U,7)
  1.  S:ABSPPHRM="" ABSPPHRM=0
  1.  S FILENUM=9002313.57
  1.  S ABSPPSTN=$$GET1^DIQ(FILENUM,ABSPTRNS_",",14)
  1.  S ABSPRESP=$$GET1^DIQ(FILENUM,ABSPTRNS_",",4,"I")
  1.  ;S ABSPCTYP=$$RESP1000^ABSPOSQ4(RESP,POS,"I")
  1.  ;IHS/OIT/CNI/RAN 9/20/2010 Patch 40 Fix for Non-Ben Patients which don't have a response file associated - BEGIN
  1.  I +$G(ABSPRESP)'=0 S ABSPCTYP=$$RESP1000^ABSPOSQ4(ABSPRESP,ABSPPSTN,"I")
  1.  E  S ABSPCTYP="PAPER"
  1.  ;IHS/OIT/CNI/RAN Patch 40 Fix for Non-Ben Patients which don't have a response file associated - END
  1.  S ABSPRICE=$P($G(^ABSPTL(ABSPTRNS,5)),U,5)
  1.  S ABSPTDAT=$P($P($G(^ABSPTL(ABSPTRNS,0)),U,8),".",1) ;TRANSACTION DATE
  1.  S ABSPTRXI=$P($P($G(^ABSPTL(ABSPTRNS,0)),U,1),".",1) ;POINTER TO PRESCRIPTION FILE
  1.  S ABSPCTYN=""
  1.  S ABSPNET=0
  1.  I ABSPCTYP="R" D
  1.  . S ABSPCTYN="REJECTED"
  1.  . S ABSPPAID=0
  1.  . S ABSPCPAY=ABSPRICE
  1.  ;IHS/OIT/CNI/RAN Patch 40 Fix for Non-Ben Patients which don't have a response file associated - BEGIN
  1.  I ABSPCTYP="PAPER" D
  1.  . S ABSPCTYN="PAPER"
  1.  . S ABSPPAID=0
  1.  . S ABSPCPAY=ABSPRICE
  1.  ;IHS/OIT/CNI/RAN Patch 40 Fix for Non-Ben Patients which don't have a response file associated - END
  1.  I (ABSPCTYP="P")!(ABSPCTYP="DP") D
  1.  . S ABSPCTYN="E PAYABLE"
  1.  . Q:ABSPRESP=""
  1.  . Q:ABSPPSTN=""
  1.  . S ABSPCPAY=$$505^ABSPOS03(ABSPRESP,ABSPPSTN) ;PATIENT PAY AMOUNT
  1.  . S ABSPPAID=$$509^ABSPOS03(ABSPRESP,ABSPPSTN) ;(#509) Total Amount Paid
  1.  Q:ABSPCTYN=""
  1.  S ABSPTRXR=+$P($G(^PSRX(ABSPTRXI,1,0)),U,4)    ;REFILL NUMBER
  1.  S ABSPTRXN=$P($G(^PSRX(ABSPTRXI,0)),U,1)  ;EXTERNAL PRESCRIPTION NUMBER
  1.  S ABSPDRGP=$P($G(^PSRX(ABSPTRXI,0)),U,6) ;POINTER TO DRUG FILE
  1.  S ABSPDRGN=$P($G(^PSDRUG(ABSPDRGP,0)),U,1) ;DRUG NAME
  1.  S ABSPDSYN=$P($G(^PSDRUG(ABSPDRGP,0)),U,1) ;DRUG NAME
  1.  S ABSPNDC=$P($G(^ABSPTL(ABSPTRNS,1)),U,2)  ;NDC NUMBER
  1.  S ABSPPROV=$P($G(^PSRX(ABSPTRXI,0)),U,4) ;POINTER TO NEW PERSON FILE (PROVIDER)
  1.  S ABSPPNPI=$P($$NPI^XUSNPI("Individual_ID",ABSPPROV),U)  ;PROVIDER NPI
  1.  S ABSPQTY=$P($G(^PSRX(ABSPTRXI,0)),U,7) ;PRESCRIPTION QUANTITY
  1.  S ABSPDAYS=$P($G(^PSRX(ABSPTRXI,0)),U,8) ;PRESCRIPTION DAYS SUPPLY
  1.  S ABSPCPAY=$FNUMBER(ABSPCPAY,"",2)
  1.  S ABSPPAID=$FNUMBER(ABSPPAID,"",2)
  1.  S ABSPRICE=$FNUMBER(ABSPRICE,"",2)
  1.  S ABSPTMP(ABSPTDAT)=1
  1.  S ABSPTMP(ABSPTDAT,ABSPPHRM,ABSPTRXI)=ABSPTRXR_"^"_ABSPTDAT_"^"_ABSPCTYP_"^"_ABSPCTYN_"^"_ABSPDRGN_"^"_ABSPNDC_"^"_ABSPPROV_"^"_ABSPPNPI_"^"_ABSPQTY_"^"_ABSPDAYS_"^"_ABSPRICE_"^"_ABSPPAID_"^"_ABSPCPAY
  1.  Q
  1.  ;
  1. CHKPARMS(ABSBPATI,ABSPPHRM)  ;CHECK PARAMETERS TO SEE IF THIS SHOULD RUN
  1.  ;ABSP PHARMACIES FILE=$P(^ABSP(9002313.56,ABSPPHRM,"REP"),U,3)
  1.  ; 1="All Patients"
  1.  ; 0="No Patients"
  1.  ; NB="Only Non-Ben Patients"
  1.  N OK
  1.  S OK=0
  1.  I $P($G(^ABSP(9002313.56,ABSPPHRM,"REP")),U,3)=0 Q 0 ;THEY DONT WANT THESE REPORTS FOR THIS PHARMACY
  1.  I $P($G(^ABSP(9002313.56,ABSPPHRM,"REP")),U,3)=1 S OK=1
  1.  I $P($G(^ABSP(9002313.56,ABSPPHRM,"REP")),U,3)="NB" D
  1.  . I '$$ISBEN^ABSPOS26  S OK=1  ;NON BENIFICIERY
  1.  Q OK
  1.  ;
  1.  ;IHS/OIT/CASSEVERN/RCS patch 44 5/21/2012 Pass Pharmacy parameter
  1. DEVSEL(ABSPPHRM)  ;SELECT DEVICE
  1.  N ABSPSTOP,IOP,OK
  1.  S OK=0
  1.  ;IHS/OIT/CASSEVERN/RCS patch 44 5/21/2012 Add Pharmacy variable
  1.  S IOP=$P($G(^ABSP(9002313.56,ABSPPHRM,"REP")),U,4)
  1.  Q:IOP="" 0
  1.  S IOP="`"_IOP
  1.  S %ZIS("HFSMODE")="W"  ;Just in case the Device is a flat file
  1.  S ABSPSTOP=0
  1.  D ^%ZIS
  1.  I POP D
  1.  . D ^%ZIS
  1.  I $D(DUOUT) D
  1.  . D ^%ZISC
  1.  . S ABSPSTOP=1
  1.  Q:ABSPSTOP 0
  1.  I 'POP S OK=1
  1.  Q OK
  1.  ;
  1. ZEND  ;CLOSE DEVICE
  1.  D ^%ZISC
  1.  Q
  1.  ;