BEXRX7.m

BEXRX7 ;cmi/anch/maw - BEX Audiocare Refill Driver - Pharmacy Version 7 Only [ 06/15/2010  9:18 PM ] ; 04 Dec 2015  8:08 AM

 ;;1.0;BEX TELEPHONE REFILL SYSTEM;**1,2,4,5,6**;APR 20, 2015;Build 7

 ;For O/P V7 only 

 ;

 ;

START ;

 S PSOBEX=1

 S (VEXRX,BEXRX)=1

 K PSOBEXI,PSOISITE,PSOBEXFL F PSOVX=0:0 S PSOVX=$O(^PS(59,PSOVX)) Q:'PSOVX  I $P($G(^PS(59,PSOVX,"I")),"^"),DT>$P($G(^("I")),"^") S PSOBEXI(PSOVX)=""

 I $O(PSOBEXI(0)) W !,"Looking for refill requests for inactive Outpatient divisions..." F PSOVIN=0:0 S PSOVIN=$O(^VEXHRX(19080,PSOVIN)) Q:'PSOVIN  S PSOVXLP="" F  S PSOVXLP=$O(^VEXHRX(19080,PSOVIN,PSOVXLP)) Q:PSOVXLP=""  D

 .S PSOISITE=$P($G(^PSRX(+$P(PSOVXLP,"-",2),2)),"^",9) Q:$G(PSOBEXI(+$G(PSOISITE)))

 .I PSOISITE,$D(PSOBEXI(PSOISITE)),$P($G(^VEXHRX(19080,PSOVIN,PSOVXLP)),U)="" S PSOBEXI(PSOISITE)=1,PSOBEXFL=1

 I '$G(PSOBEXFL),$O(PSOBEXI(0)) W ".none found.",!

 I $G(PSOBEXFL) W !!,"The following Inactive Outpatient sites have refill requests:",! F PSOVX=0:0 S PSOVX=$O(PSOBEXI(PSOVX)) Q:'PSOVX  I $G(PSOBEXI(PSOVX)) W !?5,$P($G(^PS(59,+$G(PSOVX),0)),"^")

 I $G(PSOBEXFL) K DIR W ! S DIR(0)="E",DIR("A")="Press Return to Continue, '^'to exit" D ^DIR W ! I Y'=1 G END

 ;

 ;

 ;IHS/BJI/DAY - Patch 6 - Improved Site Selection

 ;

 ;Store incoming Site values

 D HOLD^BEXSITE

 ;

 ;Display site values to user and ask for change

 D CHANGE^BEXSITE

 ;

 ;End Patch 6

 ;

 S PSOBBC1("FROM")="REFILL",PSOBBC("QFLG")=0,PSOBBC("DFLG")=0

 I '$G(PSOINST) S PSOINST=000 I $D(^DD("SITE",1)) S PSOINST=^DD("SITE",1)  ;maw 9/9/02

 S PSOFROM="REFILL"

 I '$D(^VEXHRX(19080,PSOINST)) S BEXANS="N" W !!?7,$C(7),"No telephone refills to process." G END

 D ASK^PSOBBC W:PSOBBC("QFLG")=1 !?7,$C(7),"No telephone refills were processed." G:PSOBBC("QFLG")=1 END

BEX I $$CUT G END

 W ! S DIR("B")="YES",DIR("A")="Process telephone refill requests at this time",DIR(0)="Y" D ^DIR K DIR S BEXANS="N" I $G(DIRUT) S BEXPTRX="" G END

 G:Y=0 END S BEXPTRX="" I Y=1 S BEXANS="Y"

 ;

 ;IHS/CMI/BJI - Patch 5 - Selection by division

 K BEXOPSIT

 S (BEXOPSIT,BEXQUIT,BEXEXIT)=0

 I BEXANS="Y" D

 .W !!,"Press Enter to process refills for ALL Outpatient Sites, or"

 .F  D  Q:BEXQUIT=1

 ..K DIC,DIE,DUOUT,DA

 ..S DIC(0)="AEQMZ"

 ..S DIC("A")="Select an 'Outpatient Site': "

 ..S DIC=59

 ..D ^DIC

 ..K DIR,DIC,DIR,DR

 ..I $G(DUOUT) K DUOUT S (BEXQUIT,BEXEXIT)=1 Q

 ..I X="" S BEXQUIT=1 Q

 ..I Y<1 Q

 ..S BEXOPSIT=BEXOPSIT+1

 ..S BEXOPSIT(+Y)=""

 ;

 I BEXEXIT=1 K DUOUT Q

 ;*

 ;

 ;IHS/CMI/BJI - Patch 5 - Limit to Mail, Local or Window

 K DIR

 S DIR(0)="S^A:All;L:Local;M:Mail;W:Window"

 S DIR("A")="Process All, Local Mail, Mail, or Window"

 D ^DIR

 K DIR

 I $D(DIRUT) K DIRUT S BEXANS="N" G END

 S BEXMAIL=Y

 W !

 ;*

 ;

 S (BEXCTR,VEXCTR)=0

BEX6 S PSOBBC("DFLG")=""

 I BEXANS["Y",$G(BEXPTRX) D BEX5

 D BEX3 I $G(BEXANS)="N" D ULK G END

 I $P(X,"-")'=PSOINST W !?7,$C(7),$C(7),$C(7),"Not from this institution.",! D ULK G BEX6

 S (PSOBBC("IRXN"),PSOBBC("OIRXN"))=$P(X,"-",2)

 S PSORX("PSOL",1)=$G(PSORX("PSOL",1))_PSOBBC("IRXN")_","

 I $D(^PSRX(PSOBBC("IRXN"),0))']"" W !,$C(7),"Rx data is not on file!",! D ULK G BEX6

 I $P($G(^PSRX(PSOBBC("IRXN"),"STA")),"^")=13 W !,$C(7),"Rx has already been deleted." D ULK G BEX6

 I $G(PSOBBC("DONE"))[PSOBBC("IRXN")_"," W !,$C(7),"Rx has already been entered." D ULK G BEX6

 K X,Y

 S PSOSELSE=0 I $G(PSODFN)'=$P(^PSRX(PSOBBC("IRXN"),0),"^",2) D KSRX S PSOSELSE=1 D PT^PSOBBC I $G(PSOBBC("DFLG")) K PSOSELSE D ULK G BEX6

 K PSOSELSE D PROFILE^PSORX1

 W !!

 ;

 ;IHS/CMI/DAY - Patch 6 - Wrong Labs Display during refills

 ;

 ;Change recommended by Phil Salmon - January 2015

 ;

 I +$G(PSODFN) S DFN=PSODFN

 S PSODRUG("IEN")=$P(^PSRX(PSOBBC("IRXN"),0),U,6)

 ;

 ;End Patch 6

 ;*

 ;

 S PSOBBC("DONE")=PSOBBC("IRXN")_"," D REFILL^PSOBBC D ULK G BEX6

 Q

 ;

KSRX ;-- kill and reset PSORX

 Q:$G(PSODFN)=""

 K PSORX("PSOL",1)

 S PSORX("PSOL",1)=PSOBBC("IRXN")_","

 Q

 ;

BEX3 K PSOBBC("IRXN"),BEXXFLAG F  S BEXPTRX=$O(^VEXHRX(19080,PSOINST,BEXPTRX)) D  Q:BEXANS="N"!($G(BEXXFLAG))

 .I BEXPTRX="" S BEXANS="N" Q

 .I '$D(^PSRX(+$P(BEXPTRX,"-",2),0)),$P(^VEXHRX(19080,PSOINST,BEXPTRX),U)="" D BEX5,BEX12 Q  ;SKIPS ERRONEOUS ENTRIES

BEX4 .I BEXANS["Y" Q:$P(^VEXHRX(19080,PSOINST,BEXPTRX),U)'=""  S X=PSOINST_"-"_$P(BEXPTRX,"-",2)

 .;

 .;IHS/CMI/DAY - Screen by O/P Site

 .;If quit, stay in loop and get next RX

 .S BEXOPIEN=0

 .S BEXRXIEN=+$P(BEXPTRX,"-",2)

 .I +BEXRXIEN S BEXOPIEN=$P($G(^PSRX(BEXRXIEN,2)),"^",9)

 .S BEXRFIEN=0

 .I +BEXRXIEN S BEXRFIEN=$O(^PSRX(BEXRXIEN,1,99),-1)

 .I +BEXRFIEN S BEXOPIEN=$P($G(^PSRX(BEXRXIEN,1,BEXRFIEN,0)),U,9)

 .I +BEXOPSIT,+BEXOPIEN=0 Q

 .I +BEXOPSIT,'$D(BEXOPSIT(BEXOPIEN)) Q

BEX10 .;

 .;*

 .;

 .;IHS/CMI/DAY - Patch 5 - Limit for Mail, Local, Window

 .S BEXFLAG=$G(^VEXHRX(19080,PSOINST,BEXPTRX))

 .I BEXFLAG="" S BEXFLAG="^^^M"

 .I $P(BEXFLAG,U,4)="M",BEXMAIL="W" Q

 .I $P(BEXFLAG,U,4)="M",BEXMAIL="L" Q

 .I $P(BEXFLAG,U,4)="L",BEXMAIL="W" Q

 .I $P(BEXFLAG,U,4)="L",BEXMAIL="M" Q

 .I $P(BEXFLAG,U,4)="W",BEXMAIL="L" Q

 .I $P(BEXFLAG,U,4)="W",BEXMAIL="M" Q

 .I $P(BEXFLAG,U,4)="M" S PSOBBC("MAIL/WINDOW")="M"

 .I $P(BEXFLAG,U,4)="L" S PSOBBC("MAIL/WINDOW")="M"

 .I $P(BEXFLAG,U,4)="W" S PSOBBC("MAIL/WINDOW")="W"

 .;*

 .;

 .S BEXPSORX=+$P($G(BEXPTRX),"-",2) I BEXPSORX D PSOL^PSSLOCK(BEXPSORX) I '$G(PSOMSG) K BEXPSORX,PSOMSG Q

 .K PSOMSG S BEXXFLAG=1

 Q

 ;MARK PROCESSED NODES

BEX5 I '$G(PSOINST) S PSOINST=000 I $D(^DD("SITE",1)) S PSOINST=^DD("SITE",1)

 S ^VEXHRX(19080,PSOINST,BEXPTRX)=DT

 I $D(PSOBBC("DFLG")),PSOBBC("DFLG")=1 D BEX12

 Q

BEX12 S $P(^VEXHRX(19080,PSOINST,BEXPTRX),U,2)="NOT FILLED" W !!,$C(7),"REFILL WAS NOT PROCESSED!  PLEASE TAKE APPROPRIATE ACTION."

 S PSOBBC("DFLG")=""

 W ! S DIR("A")="Do you wish to continue processing",DIR(0)="Y" D ^DIR K DIR I Y'=1 S BEXANS="N" Q

 Q

END D PROCESSX^PSOBBC

 K BEXRX,BEXPPL,PSORX

 I $P($G(^PS(59,+$G(PSOSITE),"I")),"^"),DT>$P($G(^("I")),"^") D FINAL^PSOLSET W !!,"Your Outpatient Site parameters have been deleted because you selected an",!,"inactive Outpatient Site!",!

 K DIR,PSOBBC,PSOBBC1,PSOVIN,PSOISITE,PSOBEXFL,PSOVXLP,PSOBEX,PSOVX,PSOBEXI,BEXANS,BEXANS2,BEXPTRX,BEXXFLAG,BEXPSORX,X,Y,PSODFN

 ;

 ;IHS/BJI/DAY - Patch 6 - Check if User Changed Sites

 ;

 ;Check if Inactive Site was deleted

 ;

 I $G(PSOSITE)="" K BEXHOLD D ^PSOLSET Q

 I $G(PSOPAR)="" K BEXHOLD D ^PSOLSET Q

 ;

 ;Check if User Changed Sites

 ;

 I $$CHECK^BEXSITE() D

 .;

 .W !!

 .W "You may have changed your Outpatient Site!",!

 .D CHANGE^BEXSITE

 .;

 .K BEXHOLD

 ;

 ;End Patch 6

 ;

 Q

 ;

BEXALT ;Menu action entry point to alert user

 S BEXCNT=0,BEXPTRN=""

 I '$G(PSOINST) S PSOINST="000" I $D(^DD("SITE",1)) S PSOINST=^(1)

 G:'$D(^VEXHRX(19080,PSOINST)) BEXEND

 F  S BEXPTRN=$O(^VEXHRX(19080,PSOINST,BEXPTRN)) Q:BEXPTRN=""  D

 .I $P(^VEXHRX(19080,PSOINST,BEXPTRN),U)="" S BEXCNT=BEXCNT+1

 W:BEXCNT !!,$C(7),BEXCNT_" Telephone Refills To Process"

BEXEND K BEXCNT,BEXPTRN

 Q

ULK ;

 I '$G(BEXPSORX) Q

 D PSOUL^PSSLOCK(BEXPSORX)

 K BEXPSORX

 Q

 ;

CUT() ;check cutoff time and now

 S VSITEO=$O(^BEXHRXP("B",DUZ(2),0))

 I '$G(VSITEO) Q 0

 S VSITE=$P($G(^BEXHRXP(VSITEO,0)),U)

 I '$G(VSITE) Q 0

 S VCUT=$P($G(^BEXHRXP(VSITEO,0)),U,3)

 I '$G(VCUT) Q 0

 D NOW^%DTC

 I $E($P(%,".",2),1,4)>+$G(VCUT) D  Q 1

 . W !,"Process time is past daily cut off time, refills will not be processed"

 Q 0

 ;

CR(BEXVIEN) ;EP - add a chart request

 I $G(U)="" S U="^"

 I $P($G(^VEXHRX0(19080.1,BEXVIEN,0)),U,5)="" Q

 S BEXPAT=$P($G(^VEXHRX0(19080.1,BEXVIEN,0)),U)

 I '$G(BEXPAT) Q

 S BEXTS=$P($G(^VEXHRX0(19080.1,BEXVIEN,0)),U,2)

 ;

 ;IHS/BJI/DAY - Patch 6

 ;Fix Site Lookup to use D Xref instead of C Xref

 ;I '$G(DUZ(2)) S DUZ(2)=$P($G(^AUTTSITE(1,0)),U)

 ;S BEXPSITE=$O(^PS(59,"C",DUZ(2),0))

 ;I '$G(BEXPSITE) S DUZ(2)=$P($G(^AUTTSITE(1,0)),U)

 ;S BEXPSITE=$O(^PS(59,"C",DUZ(2),0))

 S BEXPSITE=""

 I +$G(DUZ(2)) S BEXPSITE=$O(^PS(59,"D",DUZ(2),0))

 ;End Patch

 ;

 I '$G(BEXPSITE) Q

 S BEXVSITO=$O(^BEXHRXP("B",BEXPSITE,0))

 I '$G(BEXVSITO) Q

 S BEXVSITE=$P($G(^BEXHRXP(BEXVSITO,0)),U)

 I '$G(BEXVSITE) Q

 ;site screen

 N BEXSLOC

 S BEXSLOC=$P($G(^VEXHRX0(19080.1,BEXVIEN,0)),U,10)

 ;

 ;IHS/CMI/DAY - Patch 4 - P10 not always set, so calculate manually

 I BEXSLOC="" D

 .;Get Prescription Number

 .S Y=$P($G(^VEXHRX0(19080.1,BEXVIEN,0)),U,3)

 .I Y="" Q

 .;Get IEN in Prescription file

 .S BEXRXIEN=$O(^PSRX("B",Y,0))

 .I BEXRXIEN="" Q

 .;Get Division (O/P Site) from Prescription File

 .S Y=$$GET1^DIQ(52,BEXRXIEN,20,"I")

 .I Y="" Q

 .;Get Related Institution from Outpatient Site file

 .S Y=$$GET1^DIQ(59,Y,100,"I")

 .I Y="" Q

 .S BEXSLOC=Y

 ;

 I $G(BEXSLOC)]"",BEXSLOC'=DUZ(2) Q

 ;

 S BEXTSCA=$P($G(^BEXHRXP(BEXVSITO,0)),U,7)

 S BEXTSRA=$P($G(^BEXHRXP(BEXVSITO,0)),U,8)

 S BEXTSRP=$P($G(^BEXHRXP(BEXVSITO,0)),U,9)

 I '$G(BEXTS) S BEXTS=DT_".08"

 S BEXOTM=$E($P(BEXTS,".",2),1,4)

 I BEXOTM=0 Q

 I $L(BEXOTM)=1 S BEXOTM=BEXOTM_"000"

 I $L(BEXOTM)=2 S BEXOTM=BEXOTM_"00"

 I $L(BEXOTM)=3 S BEXOTM=BEXOTM_"0"

 S BEXTSP=$P(BEXTS,".")_"."_$S($G(BEXTSRP):BEXTSRP,1:2000)

 S BEXTSP=+BEXTSP

 S BEXTS=$P(BEXTS,".")_"."_$S($G(BEXTSRA):BEXTSRA,1:"08")

 S BEXTS=+BEXTS

 S BEXCLNA=$P($G(^BEXHRXP(BEXVSITO,0)),U,4)

 S BEXCLNB=$P($G(^BEXHRXP(BEXVSITO,0)),U,5)

 S BEXCUT=$P($G(^BEXHRXP(BEXVSITO,0)),U,3)

 S BEXREFO=$P($G(^BEXHRXP(BEXVSITO,0)),U,2)

 I '$G(BEXCLNA) S BEXCLNA=BEXCLNB  ;for blank am clinic

 I '$G(BEXCLNA) Q

 I '$D(^DPT(BEXPAT,0)) Q

 S BEXCLNI=BEXCLNA

 S BEXPM=0

 I $G(BEXCUT),$G(BEXCLNB) D

 . I (BEXOTM>BEXCUT)!(BEXOTM<BEXTSCA) S BEXCLNI=BEXCLNB,BEXTS=BEXTSP,BEXPM=1

 I 'BEXCLNI S BEXCLNI=BEXCLNA

 I 'BEXCLNI Q

 ;mark routing slip as printed

 I $G(BEXREFO),$P($G(^VEXHRX0(19080.1,BEXVIEN,0)),U,5)'="REFILLABLE" Q

 I $$PIMS53 D ADDCR(BEXCLNI,BEXPAT,BEXTS,+$G(BEXPM)),MARK(BEXVIEN) Q

 I $$LKPT(BEXPAT,BEXCLNI,BEXTS) Q

 I '$D(^SC(BEXCLNI,"S",BEXTS,0)) D

 . S ^SC(BEXCLNI,"S",BEXTS,0)=BEXTS

 I '$D(^SC(BEXCLNI,"S",BEXTS,1,0)) D

 . S ^SC(BEXCLNI,"S",BEXTS,1,0)="^44.003PA^^"

 S BEXNXT=$$GNXT(BEXCLNI,BEXTS)

 S ^SC(BEXCLNI,"S",BEXTS,1,BEXNXT,0)=BEXPAT_U_U_U_"PHARMACY CHART REQUEST (TA)"

 S ^SC(BEXCLNI,"S",BEXTS,1,BEXNXT,"C")=BEXTS

 I '$D(^DPT(BEXPAT,"S",0)) D

 . S ^DPT(BEXPAT,"S",0)="^2.98^^"

 S BEXAPTP=$O(^SD(409.1,"B","COMPUTER GENERATED",0))

 S ^DPT(BEXPAT,"S",BEXTS,0)=BEXCLNI_U_U_U_U_U_U_U_U_U_U_U_U_U_U_U_$G(BEXAPTP)

 D RS(BEXPAT,BEXCLNI)

 D MARK(BEXVIEN)

 Q

 ;

PIMS53() ;check for pims 5.3

 N BEXPIMS

 S BEXPIMS=$O(^DIC(9.4,"C","PIMS",0))

 I '$G(BEXPIMS) Q 0

 I $G(^DIC(9.4,BEXPIMS,"VERSION"))>5.29 Q 1

 Q 0

 ;

ADDCR(CLN,PAT,TS,PM) ;-- add cr and print rs

 S BEXTSO=TS

 S TS=$P(TS,".")

 Q:$O(^SC("AIHSCR",PAT,CLN,TS,0))  ;quit if chart request there already

 N BEXIENS,BEXERR,BEXFDA,BEXDATE,BEXNOW,BEXCLNE,BEXDEV

 S BEXIENS=""

 S BEXIENS(1)=CLN

 S BEXIENS(2)=TS

 ;

 S BEXCLNE=$P($G(^SC(CLN,0)),U)

 S BEXFDA(44.006,"?+2,"_BEXIENS(1)_",",.01)=TS

 S BEXFDA(44.007,"?+3,?+2,"_BEXIENS(1)_",",.01)=PAT

 S BEXFDA(44.007,"?+3,?+2,"_BEXIENS(1)_",",9999999.01)=BEXTSO

 S BEXFDA(44.007,"?+3,?+2,"_BEXIENS(1)_",",9999999.02)=$G(DUZ)

 S BEXFDA(44.007,"?+3,?+2,"_BEXIENS(1)_",",9999999.03)="Audiocare Telephone Refill"

 S BEXFDA(44.007,"?+3,?+2,"_BEXIENS(1)_",",9999999.04)=$$NOW^XLFDT()

 D UPDATE^DIE("","BEXFDA","BEXIENS","BEXERR(1)")

 Q:$D(BEXERR)

 I $G(PM) D

 . S BEXDEV=$$GET1^DIQ(90350.2,BEXVSITO,2)

 I $G(BEXDEV)="" S BEXDEV=$$GET1^DIQ(90350.2,BEXVSITO,1)

 Q:BEXDEV=""

 S DGQUIET=1

 D WISD^BSDROUT(PAT,$P(TS,"."),"CR",BEXDEV)

 Q

 ;

ADDDPT(CLN,PAT,TS) ;-- add the appointment to the patient file

 N BEXIENS,BEXERR,BEXFDA,BEXDATE,BEXNOW,BEXPATE,BEXAPTP

 S BEXAPTP=$O(^SD(409.1,"B","COMPUTER GENERATED",0))

 S BEXIENS=""

 S BEXIENS(1)=PAT

 S BEXIENS(2)=TS

 S BEXPATE=$P($G(^DPT(PAT,0)),U)

 S BEXFDA(2.98,"?+2,"_BEXIENS(1)_",",.01)=CLN

 S BEXFDA(2.98,"?+2,"_BEXIENS(1)_",",8)=DT

 S BEXFDA(2.98,"?+2,"_BEXIENS(1)_",",9.5)=BEXAPTP

 D UPDATE^DIE("","BEXFDA","BEXIENS","BEXERR(1)")

 Q:$D(BEXERR)

 Q

 ;

RS(DFN,CI) ;-- print a routine slip

 Q:'$P($G(^BEXHRXP(BEXVSITO,0)),U,6)

 S VAR="DIV^ORDER^SDX^DFN^SDREP^SDSTART^SDZHS^ASDLONG^SDZSC^SDZCV^SDPR",DGPGM="EN1^SDROUT1"

 ;

 S BEXDEV=$$GET1^DIQ(90350.2,BEXVSITO,1)

 I $G(BEXDEV)="" Q

 S DIV=$P($G(^SC(CI,0)),U,15)  ;for routing slip

 S (SDZZWI,SDZCV,DGUTQND)=1

 S IOP=BEXDEV,POP=0,%ZIS="Q" D ^%ZIS Q:$G(POP)

 ;D ^%ZIS  ;for testing

 ;

 D EN^XBNEW("Q1^DGUTQ","SD*;DFN;DG*;DIV;VAR;IO*")

 Q

 ;

LKPT(PT,CI,TM) ;-- check if patient has cr already

 K BEXCRE

 S BEXIEN=0 F  S BEXIEN=$O(^SC(CI,"S",TM,1,BEXIEN)) Q:'BEXIEN  D

 . I $P($G(^SC(CI,"S",TM,1,BEXIEN,0)),U)=PT S BEXCRE=1 Q

 Q $G(BEXCRE)

 ;

GNXT(CI,TM) ;-- get next ien for clinic

 K BEXNXT

 S BEXIEN=0 F  S BEXIEN=$O(^SC(CI,"S",TM,1,BEXIEN)) Q:'BEXIEN  D

 . S BEXNXT=BEXIEN

 Q $G(BEXNXT)+1

 ;

EOJCR ;-- kill vars

 D EN^XBVK("SD")

 D EN^XBVK("BEX")

 D EN^XBVK("VSIT")

 D EN^XBVK("CLN")

 K OTM,PAT,TS,TSM,TSCA,TSCP

 Q

 ;

TSK ;EP - loop trans file and request charts

 D ^XBKVAR

 S BEXRDA=0 F  S BEXRDA=$O(^VEXHRX0(19080.1,BEXRDA)) Q:'BEXRDA  D

 . Q:$P($G(^VEXHRX0(19080.1,BEXRDA,0)),U,9)

 . D CR(BEXRDA)

 Q

 ;

MARK(BEXRDA) ;EP - mark entries as completed

 N BEXFDA,BEXIENS,BEXERR

 S BEXIENS=BEXRDA_","

 S BEXFDA(90350.1,BEXIENS,9)=1

 D UPDATE^DIE("","BEXFDA","BEXIENS","BEXERR(1)")

 D EOJCR

 Q

 ;

IDX ;EP - reindex all x ref upon entry into menu

 W !!,"I need to update files, please stand by.."

 S DIK="^VEXHRX0(19080.1," D IXALL^DIK

 K DIK

 Q

 ;

DIE ;EP

 S DIE="^VEXHRX0(19080.1,"

 S BEXIDA=0 F  S BEXIDA=$O(^VEXHRX0(19080.1,"C",BEXIDA)) Q:BEXIDA=""  D

 . S BEXIIEN=0 F  S BEXIIEN=$O(^VEXHRX0(19080.1,"C",BEXIDA,BEXIIEN)) Q:'BEXIIEN  D

 .. S BEXIDT=$P($G(BEXIDA),".")

 .. Q:$P($G(BEXIDA),".",2)'=0

 .. S BEXNIDT=BEXIDT_".12"

 .. S BEXNIDT=+BEXNIDT

 .. S BEXEIDT=$$FMTE^XLFDT(BEXNIDT)

 .. S DA=BEXIIEN,DR="1///"_BEXEIDT

 .. D ^DIE

 .. K DR,DA

 K DIE,BEXIDA,BEXNIDT,BEXIIEN

 Q

 ;

HDR ;EP

 S BEXPKG="BEXR Audiocare Pharmacy Refill System"

 S BEXLOC="Location: "_$P($G(^DIC(4,DUZ(2),0)),U)

 S BEXTAB=(80-$L(BEXLOC))/2

 W !,?(80-$L(BEXPKG))/2,BEXPKG

 W !,?BEXTAB,BEXLOC

 Q

 ;

MED ;-- populate 90350.1 with med name in 11th piece

 N BEXDA

 S BEXDA=0 F  S BEXDA=$O(^VEXHRX0(19080.1,BEXDA)) Q:'BEXDA  D

 . Q:$P($G(^VEXHRX0(19080.1,BEXDA,0)),U,11)

 . N BEXRX,BEXRXI,BEXDRG

 . S BEXRX=$P($G(^VEXHRX0(19080.1,BEXDA,0)),U,3)

 . Q:'BEXRX

 . S BEXRXI=$O(^PSRX("B",BEXRX,0))

 . Q:'BEXRXI

 . S BEXDRG=$P($G(^PSRX(BEXRXI,0)),U,6)

 . Q:'BEXDRG

 . N BEXFDA,BEXIEN,BEXERR

 . S BEXIEN=BEXDA_","

 . S BEXFDA(90350.1,BEXIEN,11)=BEXDRG

 . D FILE^DIE("K","BEXFDA","BEXERR(1)")

 Q

 ;

BEXRX7    ;cmi/anch/maw - BEX Audiocare Refill Driver - Pharmacy Version 7 Only [ 06/15/2010  9:18 PM ] ; 04 Dec 2015  8:08 AM

 +1       ;;1.0;BEX TELEPHONE REFILL SYSTEM;**1,2,4,5,6**;APR 20, 2015;Build 7

 +2       ;For O/P V7 only 

 +3       ;

 +4       ;

START     ;

 +1        SET PSOBEX=1

 +2        SET (VEXRX,BEXRX)=1

 +3        KILL PSOBEXI,PSOISITE,PSOBEXFL

           FOR PSOVX=0:0

               SET PSOVX=$ORDER(^PS(59,PSOVX))

               IF 'PSOVX

                   QUIT 

               IF $PIECE($GET(^PS(59,PSOVX,"I")),"^")

                   IF DT>$PIECE($GET(^("I")),"^")

                       SET PSOBEXI(PSOVX)=""

 +4        IF $ORDER(PSOBEXI(0))

               WRITE !,"Looking for refill requests for inactive Outpatient divisions..."

               FOR PSOVIN=0:0

                   SET PSOVIN=$ORDER(^VEXHRX(19080,PSOVIN))

                   IF 'PSOVIN

                       QUIT 

                   SET PSOVXLP=""

                   FOR 

                       SET PSOVXLP=$ORDER(^VEXHRX(19080,PSOVIN,PSOVXLP))

                       IF PSOVXLP=""

                           QUIT 

                       Begin DoDot:1

 +5                        SET PSOISITE=$PIECE($GET(^PSRX(+$PIECE(PSOVXLP,"-",2),2)),"^",9)

                           IF $GET(PSOBEXI(+$GET(PSOISITE)))

                               QUIT 

 +6                        IF PSOISITE

                               IF $DATA(PSOBEXI(PSOISITE))

                                   IF $PIECE($GET(^VEXHRX(19080,PSOVIN,PSOVXLP)),U)=""

                                       SET PSOBEXI(PSOISITE)=1

                                       SET PSOBEXFL=1

                       End DoDot:1

 +7        IF '$GET(PSOBEXFL)

               IF $ORDER(PSOBEXI(0))

                   WRITE ".none found.",!

 +8        IF $GET(PSOBEXFL)

               WRITE !!,"The following Inactive Outpatient sites have refill requests:",!

               FOR PSOVX=0:0

                   SET PSOVX=$ORDER(PSOBEXI(PSOVX))

                   IF 'PSOVX

                       QUIT 

                   IF $GET(PSOBEXI(PSOVX))

                       WRITE !?5,$PIECE($GET(^PS(59,+$GET(PSOVX),0)),"^")

 +9        IF $GET(PSOBEXFL)

               KILL DIR

               WRITE !

               SET DIR(0)="E"

               SET DIR("A")="Press Return to Continue, '^'to exit"

               DO ^DIR

               WRITE !

               IF Y'=1

                   GOTO END

 +10      ;

 +11      ;

 +12      ;IHS/BJI/DAY - Patch 6 - Improved Site Selection

 +13      ;

 +14      ;Store incoming Site values

 +15       DO HOLD^BEXSITE

 +16      ;

 +17      ;Display site values to user and ask for change

 +18       DO CHANGE^BEXSITE

 +19      ;

 +20      ;End Patch 6

 +21      ;

 +22       SET PSOBBC1("FROM")="REFILL"

           SET PSOBBC("QFLG")=0

           SET PSOBBC("DFLG")=0

 +23      ;maw 9/9/02

           IF '$GET(PSOINST)

               SET PSOINST=000

               IF $DATA(^DD("SITE",1))

                   SET PSOINST=^DD("SITE",1)

 +24       SET PSOFROM="REFILL"

 +25       IF '$DATA(^VEXHRX(19080,PSOINST))

               SET BEXANS="N"

               WRITE !!?7,$CHAR(7),"No telephone refills to process."

               GOTO END

 +26       DO ASK^PSOBBC

           IF PSOBBC("QFLG")=1

               WRITE !?7,$CHAR(7),"No telephone refills were processed."

           IF PSOBBC("QFLG")=1

               GOTO END

BEX        IF $$CUT

               GOTO END

 +1        WRITE !

           SET DIR("B")="YES"

           SET DIR("A")="Process telephone refill requests at this time"

           SET DIR(0)="Y"

           DO ^DIR

           KILL DIR

           SET BEXANS="N"

           IF $GET(DIRUT)

               SET BEXPTRX=""

               GOTO END

 +2        IF Y=0

               GOTO END

           SET BEXPTRX=""

           IF Y=1

               SET BEXANS="Y"

 +3       ;

 +4       ;IHS/CMI/BJI - Patch 5 - Selection by division

 +5        KILL BEXOPSIT

 +6        SET (BEXOPSIT,BEXQUIT,BEXEXIT)=0

 +7        IF BEXANS="Y"

               Begin DoDot:1

 +8                WRITE !!,"Press Enter to process refills for ALL Outpatient Sites, or"

 +9                FOR 

                       Begin DoDot:2

 +10                       KILL DIC,DIE,DUOUT,DA

 +11                       SET DIC(0)="AEQMZ"

 +12                       SET DIC("A")="Select an 'Outpatient Site': "

 +13                       SET DIC=59

 +14                       DO ^DIC

 +15                       KILL DIR,DIC,DIR,DR

 +16                       IF $GET(DUOUT)

                               KILL DUOUT

                               SET (BEXQUIT,BEXEXIT)=1

                               QUIT 

 +17                       IF X=""

                               SET BEXQUIT=1

                               QUIT 

 +18                       IF Y<1

                               QUIT 

 +19                       SET BEXOPSIT=BEXOPSIT+1

 +20                       SET BEXOPSIT(+Y)=""

                       End DoDot:2

                       IF BEXQUIT=1

                           QUIT 

               End DoDot:1

 +21      ;

 +22       IF BEXEXIT=1

               KILL DUOUT

               QUIT 

 +23      ;*

 +24      ;

 +25      ;IHS/CMI/BJI - Patch 5 - Limit to Mail, Local or Window

 +26       KILL DIR

 +27       SET DIR(0)="S^A:All;L:Local;M:Mail;W:Window"

 +28       SET DIR("A")="Process All, Local Mail, Mail, or Window"

 +29       DO ^DIR

 +30       KILL DIR

 +31       IF $DATA(DIRUT)

               KILL DIRUT

               SET BEXANS="N"

               GOTO END

 +32       SET BEXMAIL=Y

 +33       WRITE !

 +34      ;*

 +35      ;

 +36       SET (BEXCTR,VEXCTR)=0

BEX6       SET PSOBBC("DFLG")=""

 +1        IF BEXANS["Y"

               IF $GET(BEXPTRX)

                   DO BEX5

 +2        DO BEX3

           IF $GET(BEXANS)="N"

               DO ULK

               GOTO END

 +3        IF $PIECE(X,"-")'=PSOINST

               WRITE !?7,$CHAR(7),$CHAR(7),$CHAR(7),"Not from this institution.",!

               DO ULK

               GOTO BEX6

 +4        SET (PSOBBC("IRXN"),PSOBBC("OIRXN"))=$PIECE(X,"-",2)

 +5        SET PSORX("PSOL",1)=$GET(PSORX("PSOL",1))_PSOBBC("IRXN")_","

 +6        IF $DATA(^PSRX(PSOBBC("IRXN"),0))']""

               WRITE !,$CHAR(7),"Rx data is not on file!",!

               DO ULK

               GOTO BEX6

 +7        IF $PIECE($GET(^PSRX(PSOBBC("IRXN"),"STA")),"^")=13

               WRITE !,$CHAR(7),"Rx has already been deleted."

               DO ULK

               GOTO BEX6

 +8        IF $GET(PSOBBC("DONE"))[PSOBBC("IRXN")_","

               WRITE !,$CHAR(7),"Rx has already been entered."

               DO ULK

               GOTO BEX6

 +9        KILL X,Y

 +10       SET PSOSELSE=0

           IF $GET(PSODFN)'=$PIECE(^PSRX(PSOBBC("IRXN"),0),"^",2)

               DO KSRX