source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORCPY.m@ 1119

Last change on this file since 1119 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1PSOORCPY ;BIR/SAB-copy orders from backdoor ;10/17/96
2 ;;7.0;OUTPATIENT PHARMACY;**10,21,27,32,46,100,117,148**;DEC 1997
3 ;External references LK^ORX2 and ULK^ORX2 supported by DBIA 867
4 ;External reference to ^PSDRUG supported by DBIA 221
5 ;External references L, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
6 ;I '$D(^XUSEC("PSORPH",DUZ)) S VALMSG="Invalid Action Selection!",VALMBCK="" Q
7 I $$LMREJ^PSOREJU1($P(PSOLST(ORN),"^",2),,.VALMSG,.VALMBCK) Q
8 I $G(PSOBEDT) W $C(7),$C(7) S VALMSG="Invalid Action at this time !",VALMBCK="" Q
9 I $G(PSONACT) W $C(7),$C(7) S VALMSG="No Pharmacy Orderable Item !",VALMBCK="" K PSOCOPY D ^PSOBUILD Q
10 S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK S VALMSG=$S($P($G(PSOPLCK),"^",2)'="":$P($G(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is entering orders for this patient.") K PSOPLCK S VALMBCK="" Q
11 K PSOPLCK S X=PSODFN_";DPT(" D LK^ORX2 I 'Y S VALMSG="Another person is entering orders for this patient.",VALMBCK="" D UL^PSSLOCK(PSODFN) Q
12 D PSOL^PSSLOCK($P(PSOLST(ORN),"^",2)) I '$G(PSOMSG) S VALMSG=$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order."),VALMBCK="" K PSOMSG G EX
13 N VALMCNT K PSOEDIT S (PSOCOPY,COPY,PSORXED)=1 D FULL^VALM1
14 S PSORXED("DFLG")=0,(RXN,DA,PSORXED("IRXN"))=$P(PSOLST(ORN),"^",2),PSORXED("RX0")=^PSRX(PSORXED("IRXN"),0),PSORXED("RX2")=$G(^(2)),PSORXED("RX3")=$G(^(3)),PSOI=$P($G(^("OR1")),"^"),PSOSIG=$P($G(^("SIG")),"^"),STAT=+^("STA")
15 S PSORXED("INS")=$G(^PSRX(PSORXED("IRXN"),"INS")),PSORXED("ENT")=0
16 S:$G(^PSRX(PSORXED("IRXN"),"INSS"))]"" PSORXED("SINS")=^PSRX(PSORXED("IRXN"),"INSS")
17 S D=0 F S D=$O(^PSRX(PSORXED("IRXN"),"INS1",D)) Q:'D S PSORXED("SIG",D)=^PSRX(PSORXED("IRXN"),"INS1",D,0)
18 I '$O(PSORXED("SIG",0)),$G(PSORXED("INS"))]"" S PSORXED("SIG",1)=PSORXED("INS")
19 I $G(^PSRX(PSORXED("IRXN"),"TN"))]"" S PSODRUG("TRADE NAME")=^PSRX(PSORXED("IRXN"),"TN")
20 F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),6,I)) Q:'I S DOSE=^PSRX(PSORXED("IRXN"),6,I,0) D
21 .Q:$P(DOSE,"^")']""!($P(DOSE,"^",8)']"")
22 .S PSORXED("ENT")=PSORXED("ENT")+1
23 .S PSORXED("DOSE",PSORXED("ENT"))=$P(DOSE,"^"),PSORXED("UNITS",PSORXED("ENT"))=$P(DOSE,"^",3),PSORXED("DOSE ORDERED",PSORXED("ENT"))=$P(DOSE,"^",2)
24 .S PSORXED("ROUTE",PSORXED("ENT"))=$P(DOSE,"^",7),PSORXED("SCHEDULE",PSORXED("ENT"))=$P(DOSE,"^",8),PSORXED("DURATION",PSORXED("ENT"))=$P(DOSE,"^",5)
25 .S PSORXED("CONJUNCTION",PSORXED("ENT"))=$P(DOSE,"^",6),PSORXED("VERB",PSORXED("ENT"))=$P(DOSE,"^",9)
26 .I $G(^PSRX(PSORXED("IRXN"),6,I,1))]"" S PSORXED("ODOSE",PSORXED("ENT"))=^PSRX(PSORXED("IRXN"),6,I,1)
27 .I $G(PSORXED("DURATION",PSORXED("ENT")))]"" D K DR,DUR1
28 ..S DUR1=PSORXED("DURATION",PSORXED("ENT"))
29 ..S PSORXED("DURATION",PSORXED("ENT"))=$S($E(DUR1,1)'?.N:$E(DUR1,2,99)_$E(DUR1,1),1:DUR1)
30 .S PSORXED("NOUN",PSORXED("ENT"))=$P(DOSE,"^",4) K DOSE
31 I $G(^PSDRUG($P(PSORXED("RX0"),"^",6),"I"))]"",^("I")<DT S VALMSG="Cannot COPY. This drug has been inactivated!" S VALMBCK="R" G OUT
32 I $P(^PSDRUG($P(PSORXED("RX0"),"^",6),2),"^",3)'["O" S VALMSG="Cannot Copy. Drug no longer used by Outpatient!",VALMBCK="R" G OUT
33 ;Check for invalid Dosage
34 N PSOOCPRX,PSOOLPF,PSOOLPD,PSONOSIG S PSOOCPRX=PSORXED("IRXN") D CDOSE^PSORENW0
35 I PSOOLPF D S VALMBCK="R" G OUT
36 .S VALMSG="Cannot copy, invalid Dosage of "_$G(PSOOLPD)
37 I PSONOSIG D S VALMBCK="R" G OUT
38 .S VALMSG="Cannot copy, missing Sig"
39 I '$P($G(^PSDRUG($P(PSORXED("RX0"),"^",6),2)),"^") S VALMBCK="R" G OUT
40 S DREN=$P(PSORXED("RX0"),"^",6),PSODAYS=$P(PSORXED("RX0"),"^",8),PSORXST=+$P($G(^PS(53,$P(PSORXED("RX0"),"^",3),0)),"^",7) S POERR=1 D DRG^PSOORDRG K POERR
41 I $G(PSORX("DFLG")) S VALMBCK="R"
42 D EN^PSOORED1(.PSORXED) I $G(PSORX("FN")) S VALMBCK="Q",PSOFROM="NEW" D DCORD^PSONEW2
43 E S VALMBCK="R"
44OUT ;
45 D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2))
46 K PSOCOPY D ^PSOBUILD,ACT^PSOORNE2
47EX S X=PSODFN_";DPT(" D ULK^ORX2
48 D UL^PSSLOCK(PSODFN)
49 K PSOMSG,PSONEW,PSOSIG,STA,DREN,PSODAYS,PSORXST,PSOCOPY,PSORXED,FST,FLD,IEN,FLN,INCOM,PSOI,COPY,SIG,SIGOK,PSODRUG,^TMP("PSOPO",$J)
50 D CLEAN^PSOVER1,EOJ^PSONEW
51 Q
52LOCK ;
53 I $P($G(PSOPLCK),"^")'=0 Q
54 W !!,$S($P($G(PSOPLCK),"^",2)'="":$P($G(PSOPLCK),"^",2),1:"Another person")_" is working on this patient."
55 K DIR S DIR(0)="E",DIR("A")=" Press Return to Continue" D ^DIR K DIR
56 Q
Note: See TracBrowser for help on using the repository browser.