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

PSOORCPY ;BIR/SAB-copy orders from backdoor ;10/17/96
 ;;7.0;OUTPATIENT PHARMACY;**10,21,27,32,46,100,117,148**;DEC 1997
 ;External references LK^ORX2 and ULK^ORX2 supported by DBIA 867
 ;External reference to ^PSDRUG supported by DBIA 221
 ;External references L, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
 ;I '$D(^XUSEC("PSORPH",DUZ)) S VALMSG="Invalid Action Selection!",VALMBCK="" Q
 I $$LMREJ^PSOREJU1($P(PSOLST(ORN),"^",2),,.VALMSG,.VALMBCK) Q
 I $G(PSOBEDT) W $C(7),$C(7) S VALMSG="Invalid Action at this time !",VALMBCK="" Q
 I $G(PSONACT) W $C(7),$C(7) S VALMSG="No Pharmacy Orderable Item !",VALMBCK="" K PSOCOPY D ^PSOBUILD Q
 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
 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
 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
 N VALMCNT K PSOEDIT S (PSOCOPY,COPY,PSORXED)=1 D FULL^VALM1
 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")
 S PSORXED("INS")=$G(^PSRX(PSORXED("IRXN"),"INS")),PSORXED("ENT")=0
 S:$G(^PSRX(PSORXED("IRXN"),"INSS"))]"" PSORXED("SINS")=^PSRX(PSORXED("IRXN"),"INSS")
 S D=0 F  S D=$O(^PSRX(PSORXED("IRXN"),"INS1",D)) Q:'D  S PSORXED("SIG",D)=^PSRX(PSORXED("IRXN"),"INS1",D,0)
 I '$O(PSORXED("SIG",0)),$G(PSORXED("INS"))]"" S PSORXED("SIG",1)=PSORXED("INS")
 I $G(^PSRX(PSORXED("IRXN"),"TN"))]"" S PSODRUG("TRADE NAME")=^PSRX(PSORXED("IRXN"),"TN")
 F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),6,I)) Q:'I  S DOSE=^PSRX(PSORXED("IRXN"),6,I,0) D
 .Q:$P(DOSE,"^")']""!($P(DOSE,"^",8)']"")
 .S PSORXED("ENT")=PSORXED("ENT")+1
 .S PSORXED("DOSE",PSORXED("ENT"))=$P(DOSE,"^"),PSORXED("UNITS",PSORXED("ENT"))=$P(DOSE,"^",3),PSORXED("DOSE ORDERED",PSORXED("ENT"))=$P(DOSE,"^",2)
 .S PSORXED("ROUTE",PSORXED("ENT"))=$P(DOSE,"^",7),PSORXED("SCHEDULE",PSORXED("ENT"))=$P(DOSE,"^",8),PSORXED("DURATION",PSORXED("ENT"))=$P(DOSE,"^",5)
 .S PSORXED("CONJUNCTION",PSORXED("ENT"))=$P(DOSE,"^",6),PSORXED("VERB",PSORXED("ENT"))=$P(DOSE,"^",9)
 .I $G(^PSRX(PSORXED("IRXN"),6,I,1))]"" S PSORXED("ODOSE",PSORXED("ENT"))=^PSRX(PSORXED("IRXN"),6,I,1)
 .I $G(PSORXED("DURATION",PSORXED("ENT")))]"" D  K DR,DUR1
 ..S DUR1=PSORXED("DURATION",PSORXED("ENT"))
 ..S PSORXED("DURATION",PSORXED("ENT"))=$S($E(DUR1,1)'?.N:$E(DUR1,2,99)_$E(DUR1,1),1:DUR1)
 .S PSORXED("NOUN",PSORXED("ENT"))=$P(DOSE,"^",4) K DOSE
 I $G(^PSDRUG($P(PSORXED("RX0"),"^",6),"I"))]"",^("I")<DT S VALMSG="Cannot COPY.  This drug has been inactivated!" S VALMBCK="R" G OUT
 I $P(^PSDRUG($P(PSORXED("RX0"),"^",6),2),"^",3)'["O" S VALMSG="Cannot Copy.  Drug no longer used by Outpatient!",VALMBCK="R" G OUT
 ;Check for invalid Dosage
 N PSOOCPRX,PSOOLPF,PSOOLPD,PSONOSIG S PSOOCPRX=PSORXED("IRXN") D CDOSE^PSORENW0
 I PSOOLPF D  S VALMBCK="R" G OUT
 .S VALMSG="Cannot copy, invalid Dosage of "_$G(PSOOLPD)
 I PSONOSIG D  S VALMBCK="R" G OUT
 .S VALMSG="Cannot copy, missing Sig"
 I '$P($G(^PSDRUG($P(PSORXED("RX0"),"^",6),2)),"^") S VALMBCK="R" G OUT
 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
 I $G(PSORX("DFLG")) S VALMBCK="R"
 D EN^PSOORED1(.PSORXED) I $G(PSORX("FN")) S VALMBCK="Q",PSOFROM="NEW" D DCORD^PSONEW2
 E  S VALMBCK="R"
OUT ;
 D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2))
 K PSOCOPY D ^PSOBUILD,ACT^PSOORNE2
EX S X=PSODFN_";DPT(" D ULK^ORX2
 D UL^PSSLOCK(PSODFN)
 K PSOMSG,PSONEW,PSOSIG,STA,DREN,PSODAYS,PSORXST,PSOCOPY,PSORXED,FST,FLD,IEN,FLN,INCOM,PSOI,COPY,SIG,SIGOK,PSODRUG,^TMP("PSOPO",$J)
 D CLEAN^PSOVER1,EOJ^PSONEW
 Q
LOCK ;
 I $P($G(PSOPLCK),"^")'=0 Q
 W !!,$S($P($G(PSOPLCK),"^",2)'="":$P($G(PSOPLCK),"^",2),1:"Another person")_" is working on this patient."
 K DIR S DIR(0)="E",DIR("A")="     Press Return to Continue" D ^DIR K DIR
 Q