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