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

PSOORNW1.m

Go to the documentation of this file.
  1. PSOORNW1 ;ISC BHAM/SAB - continuation of finish of new order ;Jun 25, 2018@13:38
  1. ;;7.0;OUTPATIENT PHARMACY;**23,46,78,117,131,133,172,148,222,268,206,251,379,391,313,444,469,422,477,651,747**;DEC 1997;Build 7
  1. ; Reference to ^YSCL(603.01 in ICR #2697
  1. ; Reference to ^PS(55 in ICR #2228
  1. ; Reference to ^PSDRUG( in ICR #221
  1. ; Reference to $$GETNDC^PSSNDCUT in ICR #4707
  1. ;
  1. 2 I $G(ORD),$G(ORSV) W !!,$S($$ERXIEN^PSOERXUT(ORD_"P"):"eRx ",1:""),"Instructions: " D
  1. .S INST=0 F S INST=$O(^PS(52.41,ORD,2,INST)) Q:'INST S (MIG,INST(INST))=^PS(52.41,ORD,2,INST,0) D
  1. ..F SG=1:1:$L(MIG," ") W:$X+$L($P(MIG," ",SG)_" ")>IOM !?14 W $P(MIG," ",SG)_" "
  1. .S:'$D(PSODRUG("OI")) PSODRUG("OI")=$P(OR0,"^",8)
  1. .K INST,TY,MIG,SG
  1. N DEFAULT
  1. S (PSDC,PSI,DEFAULT)=0 W !!,"The following Drug(s) are available for selection:"
  1. F PSI=0:0 S PSI=$O(^PSDRUG("ASP",PSODRUG("OI"),PSI)) Q:'PSI I $S('$D(^PSDRUG(PSI,"I")):1,'^("I"):1,DT'>^("I"):1,1:0),$S($P($G(^PSDRUG(PSI,2)),"^",3)'["O":0,1:1) D
  1. .S PSDC=PSDC+1 W !,PSDC_". "_$P(^PSDRUG(PSI,0),"^")_$S($P(^(0),"^",9):" (N/F)",1:"")
  1. .S PSDC(PSDC)=PSI I $G(PSORXED("DRUG IEN")),PSI=$G(PSORXED("DRUG IEN")) S DEFAULT=PSDC
  1. I PSDC=0 D
  1. . N X,DRG
  1. . S DRG=+$P($G(^PS(52.41,+$G(ORD),0)),"^",9)
  1. . S X=$$GET1^DIQ(50,DRG,100)
  1. . I X'="",(DT>X) D
  1. . . W !!," This Dispense Drug is now Inactive. You may select a"
  1. . . W !," new Orderable Item, or you can enter a new Order with"
  1. . . W !," an Active Drug.",!
  1. . E W !!,"No drugs available!",!
  1. . K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press return to continue"
  1. . D ^DIR K DIR
  1. G:'PSDC ETX I $G(PSOBDRG),'$D(PSOBDR) M PSOBDR=PSODRUG
  1. I PSDC'=1 D
  1. .I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),2)),"^")=$G(PSODRUG("OI")) Q
  1. .K PSODRUG("NAME"),PSODRUG("IEN")
  1. W ! D KV
  1. S DIR(0)="N^1:"_PSDC S:$G(DEFAULT) DIR("B")=DEFAULT
  1. S DIR("A")="Select Drug by number" D ^DIR
  1. I $D(DIRUT) S OUT=1 G EX
  1. D KV K PSOY S PSOY=PSDC(Y),PSOY(0)=^PSDRUG(PSOY,0),PSOCSIG=0
  1. I $G(PSOBDR("IEN")),PSOBDR("IEN")'=+PSOY D:$G(ORD) ;G:$D(DIRUT) EX ;*422
  1. .N PSOMSG S PSOMSG(1)="You have changed the dispense drug from",PSOMSG(2)=$G(PSOBDR("NAME"))_" to "_$P(^PSDRUG(+PSOY,0),"^")_"." D EN^DDIOL(.PSOMSG,"","!") S (PSOAC,PSOCSIG)=1 ;*422
  1. .K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press return to continue" ;*422
  1. .D ^DIR K DIR ;*422
  1. CT1 I $P($G(^PSDRUG(PSOY,"CLOZ1")),"^")="PSOCLO1",'$O(^YSCL(603.01,"C",PSODFN,0)) D Q
  1. .S VALMSG="Patient Not Registered in Clozapine Program",VALMBCK="Q" K PSOY,PSDC
  1. I $G(ORD) S ^TMP("PSORXPO",$J,ORD,0)=1
  1. S PSODRUG("IEN")=+PSOY,PSODRUG("VA CLASS")=$P(PSOY(0),"^",2),PSODRUG("NAME")=$P(PSOY(0),"^")
  1. S PSODRUG("NDF")=$S($G(^PSDRUG(+PSOY,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
  1. S PSODRUG("MAXDOSE")=$P(PSOY(0),"^",4),PSODRUG("DEA")=$P(PSOY(0),"^",3),PSODRUG("CLN")=$S($D(^PSDRUG(+PSOY,"ND")):+$P(^("ND"),"^",6),1:0)
  1. S PSODRUG("SIG")=$P(PSOY(0),"^",5),PSODRUG("NDC")=$$GETNDC^PSSNDCUT(+PSOY,$G(PSOSITE)),PSODRUG("STKLVL")=$G(^PSDRUG(+PSOY,660.1))
  1. S PSODRUG("DAW")=$$GET1^DIQ(50,+PSOY,81)
  1. I PSODRUG("DAW")="" S PSODRUG("DAW")=0
  1. S PSOX1=$G(^PSDRUG(+PSOY,660)),PSODRUG("COST")=$P($G(PSOX1),"^",6),PSODRUG("UNIT")=$P($G(PSOX1),"^",8),PSODRUG("EXPIRATION DATE")=$P($G(PSOX1),"^",9)
  1. D:('$G(PSOFIN)&('$G(PSOCOPY)))!($G(PSOAC)) POST^PSODRG I $G(PSORX("DFLG")) K PSODRUG N LST Q:$G(PSOAC)!($G(NEWEDT)) D DSPL^PSOORFI1 S VALMBCK="Q" Q
  1. ;
  1. ; If current DAYS SUPPLY on the order > Maximum allowed for Dispense Drug prompt user for DAYS SUPPLY
  1. I $$MXDAYSUP^PSSUTIL1(PSOY)<$G(PSONEW("DAYS SUPPLY")) D DAYS^PSODIR1(.PSONEW)
  1. I $G(PSONEW("DFLG")) K PSODRUG S OUT=1 G EX
  1. ;
  1. ETX D REF S VALMBCK="R" I 'PSDC S VALMSG="NO dispense drugs tied to this orderable item!" S PSOQFLG=1
  1. TX D KV K PSDC,PSI,X,Y,PSOX1,PSOY
  1. Q
  1. EX M PSODRUG=PSOBDR K PSOBDR,PSOBDRG S PSOQFLG=1,VALMBCK="R" D MP1^PSOOREDX
  1. D TX Q
  1. URX D KV S DIR(0)="Y",DIR("A")="Are You Sure You Want to Update Rx",DIR("B")="Yes"
  1. D ^DIR S:$D(DIRUT)!('Y) DIRUT=1
  1. I Y S ^TMP("PSORXPO",$J,ORD,0)=1 ;screens 4 order checks
  1. Q
  1. REF ;
  1. ; Retrieving the Maximum Number of Refills allowed
  1. N MAXRF S MAXRF=$$MAXNUMRF^PSOUTIL(+$G(PSODRUG("IEN")),+$G(PSONEW("DAYS SUPPLY")),+$G(PSONEW("PATIENT STATUS")),.CLOZPAT)
  1. I ($G(PSONEW("# OF REFILLS"))'="")&($G(PSONEW("# OF REFILLS"))'>MAXRF) D
  1. . S PSONEW("N# REF")=PSONEW("# OF REFILLS")
  1. E D
  1. . S (PSONEW("N# REF"),PSONEW("# OF REFILLS"))=MAXRF
  1. Q
  1. ;
  1. EDNEW ;
  1. N MAXRF S MAXRF=$$MAXNUMRF^PSOUTIL(+$G(PSODRUG("IEN")),+$G(PSONEW("DAYS SUPPLY")),+$G(PSONEW("PATIENT STATUS")),.CLOZPAT)
  1. I PSRF>MAXRF D
  1. .W $C(7),!!,PSRF_" refills are not correct for a "_PSDAYS_" day supply.",!,"Please enter correct # of refills for a "_PSDAYS_" day supply. Max refills allowed is "_MAXRF_".",!
  1. .S (PSMAX("MAX"),PSFMAX("MAX"))=MAXRF,(PSMAX("RF"),PSFMAX("RF"))=PSRF,(PSMAX("DAYS"),PSFMAX("DAYS"))=PSDAYS,(PSMAX,PSFMAX)=1
  1. K PSTMAX D EDSTAT
  1. Q
  1. STATDAY K PSMAX,PSRMAX,PSFMAX,PSTMAX S PSDAYS=$P(^PSRX(DA,0),"^",8),PSRF=$P(^PSRX(DA,0),"^",9),PTST=$P(^PS(53,X,0),"^"),PTDY=$P(^(0),"^",3),PTRF=$P(^(0),"^",4)
  1. EDSTAT I PSRF>PTRF W !,$C(7),PSRF_" refills are greater than "_PTRF_" allowed for "_$P(PTST,"^")_" Rx Patient Status.",! S PSTMAX=1,PSTMAX("PTRF")=PTRF,PSTMAX("PSRF")=PSRF,PSTMAX("PT")=$P(PTST,"^")
  1. Q
  1. OERF S DIR(0)="N^0:"_PSOX,DIR("A")="# OF REFILLS"
  1. S DIR("B")=$S($G(POERR):PSONEW("# OF REFILLS"),$G(PSONEW("N# REF"))]"":PSONEW("N# REF"),$G(PSONEW("# OF REFILLS"))]"":PSONEW("# OF REFILLS"),$G(PSOX1)]""&(PSOX>PSOX1):PSOX1,1:PSOX)
  1. S DIR("?")="Enter a whole number. The maximum is set by the Rx Patient Status because there is no Dispense Drug."
  1. D ^DIR G:$D(DIRUT) REFX
  1. S (PSONEW("N# REF"),PSONEW("# OF REFILLS"))=Y
  1. REFX S:'$D(PSONEW("# OF REFILLS")) PSONEW("# OF REFILLS")=$S($G(PSONEW("N# REF"))]"":PSONEW("N# REF"),$G(PSOX1)]""&($G(PSOX)>PSOX1):PSOX1,1:PSOX)
  1. K X,Y,PSOX,PSOX1,PSDY,PSDY1,DEA
  1. KV K DIR,DIRUT,DUOUT,DTOUT
  1. Q