- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORNW1.m
r613 r623 1 PSOORNW1 ;ISC BHAM/SAB - continuation of finish of new order ;5/10/07 8:30am2 ;;7.0;OUTPATIENT PHARMACY;**23,46,78,117,131,133,172,148,222,268,206**;DEC 1997;Build 393 4 5 6 7 8 2 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 CT1 42 43 44 45 46 47 48 49 50 51 ETX 52 TX 53 54 EX 55 56 URX 57 58 59 REF 60 61 62 63 64 65 66 67 68 69 I '$D(CLOZPAT) I PSODRUG("DEA")["A"&(PSODRUG("DEA")'["B")!(PSODRUG("DEA")["F")!(PSODRUG("DEA")[1)!(PSODRUG("DEA")[2) S PSOX=0,PSONEW("# OF REFILLS")=0 K PSDY,PSDY1,PTRF Q70 71 72 73 EDNEW 74 75 76 77 78 79 80 81 82 83 84 85 STATDAY 86 EDSTAT 87 88 OERF 89 90 91 92 93 REFX 94 95 KV 96 1 PSOORNW1 ;ISC BHAM/SAB - continuation of finish of new order ;07/19/96 12:58 PM 2 ;;7.0;OUTPATIENT PHARMACY;**23,46,78,117,131,133,172,148,222,268**;DEC 1997;Build 9 3 ;Reference ^YSCL(603.01 supported by DBIA 2697 4 ;Reference ^PS(55 supported by DBIA 2228 5 ;Reference ^PSDRUG( supported by DBIA 221 6 ;Reference to $$GETNDC^PSSNDCUT supported by IA 4707 7 ; 8 2 I $G(ORD) W !!,"Instructions: " D 9 .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 10 ..F SG=1:1:$L(MIG," ") W:$X+$L($P(MIG," ",SG)_" ")>IOM !?14 W $P(MIG," ",SG)_" " 11 .S:'$D(PSODRUG("OI")) PSODRUG("OI")=$P(OR0,"^",8) 12 .K INST,TY,MIG,SG 13 S (PSDC,PSI)=0 W !!,"The following Drug(s) are available for selection:" 14 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 15 .S PSDC=PSDC+1 W !,PSDC_". "_$P(^PSDRUG(PSI,0),"^")_$S($P(^(0),"^",9):" (N/F)",1:"") 16 .S PSDC(PSDC)=PSI 17 I PSDC=0 D 18 . N X,DRG 19 . S DRG=+$P($G(^PS(52.41,+$G(ORD),0)),"^",9) 20 . S X=$$GET1^DIQ(50,DRG,100) 21 . I X'="",(DT>X) D 22 . . W !!," This Dispense Drug is now Inactive. You may select a" 23 . . W !," new Orderable Item, or you can enter a new Order with" 24 . . W !," an Active Drug.",! 25 . E W !!,"No drugs available!",! 26 . K DIR S DIR(0)="E",DIR("A")="Press return to continue" 27 . D ^DIR K DIR 28 G:'PSDC ETX I $G(PSOBDRG),'$D(PSOBDR) M PSOBDR=PSODRUG 29 I PSDC'=1 D 30 .I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),2)),"^")=$G(PSODRUG("OI")) Q 31 .K PSODRUG("NAME"),PSODRUG("IEN") 32 W ! D KV S DIR(0)="N^1:"_PSDC,DIR("A")="Select Drug by number" D ^DIR 33 I $D(DIRUT) S OUT=1 G EX 34 D KV K PSOY S PSOY=PSDC(Y),PSOY(0)=^PSDRUG(PSOY,0),PSOCSIG=0 35 I $G(PSOBDR("IEN")),PSOBDR("IEN")'=+PSOY D:$G(ORD) G:$D(DIRUT) EX 36 .D KV S DIR(0)="Y",DIR("B")="YES",DIR("A",1)="You have changed the dispense drug from",DIR("A",2)=PSOBDR("NAME")_" to "_$P(^PSDRUG(+PSOY,0),"^")_".",DIR("A")="Do You want to Edit the SIG" 37 .D ^DIR I $D(DIRUT) S OUT=1 Q 38 .S:Y PSOCSIG=1 39 .I 'Y D URX I $D(DIRUT) S OUT=1 Q 40 D KV 41 CT1 I $P($G(^PSDRUG(PSOY,"CLOZ1")),"^")="PSOCLO1",'$O(^YSCL(603.01,"C",PSODFN,0)) S VALMSG="Patient Not Registered in Clozapine Program",VALMBCK="Q" K PSOY,PSDC Q 42 S PSODRUG("IEN")=+PSOY,PSODRUG("VA CLASS")=$P(PSOY(0),"^",2),PSODRUG("NAME")=$P(PSOY(0),"^") 43 S PSODRUG("NDF")=$S($G(^PSDRUG(+PSOY,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0) 44 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) 45 S PSODRUG("SIG")=$P(PSOY(0),"^",5),PSODRUG("NDC")=$$GETNDC^PSSNDCUT(+PSOY,$G(PSOSITE)),PSODRUG("STKLVL")=$G(^PSDRUG(+PSOY,660.1)) 46 S PSODRUG("DAW")=+$$GET1^DIQ(50,+PSOY,81) 47 I $G(^PSDRUG(+PSOY,660))']"" D:'$G(PSOFIN)&('$G(PSOCOPY)) POST^PSODRG G ETX 48 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) 49 D:'$G(PSOFIN)&('$G(PSOCOPY)) POST^PSODRG 50 I $G(PSORX("DFLG")) K PSODRUG N LST Q:$G(PSOAC)!($G(NEWEDT)) D DSPL^PSOORFI1 S VALMBCK="Q" Q 51 ETX D REF S VALMBCK="R" I 'PSDC S VALMSG="NO dispense drugs tied to this orderable item!" S PSOQFLG=1 52 TX D KV K PSDC,PSI,X,Y,PSOX1,PSOY 53 Q 54 EX M PSODRUG=PSOBDR K PSOBDR,PSOBDRG S PSOQFLG=1,VALMBCK="R" D MP1^PSOOREDX 55 D TX Q 56 URX D KV S DIR(0)="Y",DIR("A")="Are You Sure You Want to Update Rx",DIR("B")="Yes" 57 D ^DIR S:$D(DIRUT)!('Y) DIRUT=1 58 Q 59 REF Q:'$D(PSODRUG("DEA"))!('$G(PSODRUG("IEN")))!('$G(^PS(55,PSODFN,"PS"))) 60 S PSONEW("CS")=0,PTRF=$S(+$G(^PS(55,PSODFN,"PS"))&($P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",4)]""):$P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",4),1:5) 61 F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)="" I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S $P(PSONEW("CS"),"^")=1 S:$E(+PSODRUG("DEA"),DEA)=2 $P(PSONEW("CS"),"^",2)=1 62 I $P($G(PSONEW("CS")),"^",2)=1 S PSONEW("# OF REFILLS")=0 Q 63 I +PSONEW("CS") D 64 .S PSOX=$S($P($G(OR0),"^",11)>5:5,1:+$P($G(OR0),"^",11)) 65 .S PSOX=$S(PSOX>PTRF:PTRF,1:PSOX) 66 .S PSONEW("# OF REFILLS")=PSOX 67 E D 68 .S PSOX=$S($P($G(OR0),"^",11)'>PTRF&($P($G(OR0),"^",11)'>11):11,1:PTRF) 69 I '$D(CLOZPAT) I PSODRUG("DEA")["A"&(PSODRUG("DEA")'["B")!(PSODRUG("DEA")["F") S PSOX=0,PSONEW("# OF REFILLS")=0 K PSDY,PSDY1,PTRF Q 70 I $D(CLOZPAT) S (PSOX,PSONEW("N# REF"),PSONEW("# OF REFILLS"))=$S(CLOZPAT=2&($G(PSONEW("# OF REFILLS"))>2):3,CLOZPAT&($G(PSONEW("# OF REFILLS"))>1):1,1:0),PSONEW("DAYS SUPPLY")=7,ORCHK=1 K PSDY,PSDY1,PTRF Q 71 S PSONEW("# OF REFILLS")=$S($G(PSONEW("# OF REFILLS"))'="":$G(PSONEW("# OF REFILLS")),1:PSOX) K PSDY,PSDY1,PTRF 72 Q 73 EDNEW K PSMAX,PSFMAX F DEA=1:1 Q:$E(PSODEA,DEA)="" I $E(+PSODEA,DEA)>1,$E(+PSODEA,DEA)<6 S CS=1 74 I CS D 75 .S PSOX1=$S(PTRF>5:5,1:PTRF),PSOX=$S(PSOX1=5:5,1:PSOX1) 76 .S PSOX=$S('PSOX:0,PSDAYS=90:1,1:PSOX),PSDY1=$S(PSDAYS<60:5,PSDAYS'<60&(PSDAYS'>89):2,PSDAYS=90:1,1:0) S MAX=$S(PSOX'>PSDY1:PSOX,1:PSDY1) 77 E D 78 .S PSOX1=PTRF,PSOX=$S(PSOX1=11:11,1:PSOX1),PSOX=$S('PSOX:0,PSDAYS=90:3,1:PSOX) 79 .S PSDY1=$S(PSDAYS<60:11,PSDAYS'<60&(PSDAYS'>89):5,PSDAYS=90:3,1:0) S MAX=$S(PSOX'>PSDY1:PSOX,1:PSDY1) 80 I PSRF>MAX D 81 .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 "_MAX_".",! 82 .S (PSMAX("MAX"),PSFMAX("MAX"))=MAX,(PSMAX("RF"),PSFMAX("RF"))=PSRF,(PSMAX("DAYS"),PSFMAX("DAYS"))=PSDAYS,(PSMAX,PSFMAX)=1 83 K PSTMAX D EDSTAT 84 Q 85 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) 86 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,"^") 87 Q 88 OERF S DIR(0)="N^0:"_PSOX,DIR("A")="# OF REFILLS" 89 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) 90 S DIR("?")="Enter a whole number. The maximum is set by the Rx Patient Status because there is no Dispense Drug." 91 D ^DIR G:$D(DIRUT) REFX 92 S (PSONEW("N# REF"),PSONEW("# OF REFILLS"))=Y 93 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) 94 K X,Y,PSOX,PSOX1,PSDY,PSDY1,DEA 95 KV K DIR,DIRUT,DUOUT,DTOUT 96 Q
Note:
See TracChangeset
for help on using the changeset viewer.
