- PSOORCPY ;BIR/SAB-copy orders from backdoor ;29-May-2012 14:56;PLS
- ;;7.0;OUTPATIENT PHARMACY;**10,21,27,32,46,100,117,1001,1006,1009,148,1015**;DEC 1997;Build 62
- ;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
- ; Modified - IHS/CIA/PLS - 11/01/04 - Line PSOORCPY+19
- ; IHS/MSC/PLS - 09/17/07 - Added support for CLININD and CLININD2
- ; 12/09/10 - Line PSOORCPY+43
- ;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")
- ; IHS/CIA/PLS - 11/01/04 - Populate IHS fields during copy function.
- ; IHS/MSC/PLS - 09/17/07 - Added logic for CLININD and CLININD2
- I $D(^PSRX(PSORXED("IRXN"),9999999)) D
- .S PSORXED("AWP")=$P($G(^PSRX(PSORXED("IRXN"),9999999)),U,6)
- .S PSORXED("BST")=$P($G(^PSRX(PSORXED("IRXN"),9999999)),U,7)
- .S PSORXED("CM")=$P($G(^PSRX(PSORXED("IRXN"),9999999)),U,2)
- .S PSORXED("CLININD")=$P($G(^PSRX(PSORXED("IRXN")=999999921)),U,1)
- .S PSORXED("CLININD2")=$P($G(^PSRX(PSORXED("IRXN")=999999921)),U,2)
- 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
- I '$$SCREEN^APSPMULT(+$P(PSORXED("RX0"),"^",6),,1) S VALMSG="Cannot Copy. Drug is not available in facility",VALMBCK="R" G OUT ;JDS/MSC M
- ;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
- PSOORCPY ;BIR/SAB-copy orders from backdoor ;29-May-2012 14:56;PLS
- +1 ;;7.0;OUTPATIENT PHARMACY;**10,21,27,32,46,100,117,1001,1006,1009,148,1015**;DEC 1997;Build 62
- +2 ;External references LK^ORX2 and ULK^ORX2 supported by DBIA 867
- +3 ;External reference to ^PSDRUG supported by DBIA 221
- +4 ;External references L, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
- +5 ; Modified - IHS/CIA/PLS - 11/01/04 - Line PSOORCPY+19
- +6 ; IHS/MSC/PLS - 09/17/07 - Added support for CLININD and CLININD2
- +7 ; 12/09/10 - Line PSOORCPY+43
- +8 ;I '$D(^XUSEC("PSORPH",DUZ)) S VALMSG="Invalid Action Selection!",VALMBCK="" Q
- +9 IF $$LMREJ^PSOREJU1($PIECE(PSOLST(ORN),"^",2),,.VALMSG,.VALMBCK)
- QUIT
- +10 IF $GET(PSOBEDT)
- WRITE $CHAR(7),$CHAR(7)
- SET VALMSG="Invalid Action at this time !"
- SET VALMBCK=""
- QUIT
- +11 IF $GET(PSONACT)
- WRITE $CHAR(7),$CHAR(7)
- SET VALMSG="No Pharmacy Orderable Item !"
- SET VALMBCK=""
- KILL PSOCOPY
- DO ^PSOBUILD
- QUIT
- +12 SET PSOPLCK=$$L^PSSLOCK(PSODFN,0)
- IF '$GET(PSOPLCK)
- DO LOCK
- SET VALMSG=$SELECT($PIECE($GET(PSOPLCK),"^",2)'="":$PIECE($GET(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is entering orders for this patient.")
- KILL PSOPLCK
- SET VALMBCK=""
- QUIT
- +13 KILL PSOPLCK
- SET X=PSODFN_";DPT("
- DO LK^ORX2
- IF 'Y
- SET VALMSG="Another person is entering orders for this patient."
- SET VALMBCK=""
- DO UL^PSSLOCK(PSODFN)
- QUIT
- +14 DO PSOL^PSSLOCK($PIECE(PSOLST(ORN),"^",2))
- IF '$GET(PSOMSG)
- SET VALMSG=$SELECT($PIECE($GET(PSOMSG),"^",2)'="":$PIECE($GET(PSOMSG),"^",2),1:"Another person is editing this order.")
- SET VALMBCK=""
- KILL PSOMSG
- GOTO EX
- +15 NEW VALMCNT
- KILL PSOEDIT
- SET (PSOCOPY,COPY,PSORXED)=1
- DO FULL^VALM1
- +16 SET PSORXED("DFLG")=0
- SET (RXN,DA,PSORXED("IRXN"))=$PIECE(PSOLST(ORN),"^",2)
- SET PSORXED("RX0")=^PSRX(PSORXED("IRXN"),0)
- SET PSORXED("RX2")=$GET(^(2))
- SET PSORXED("RX3")=$GET(^(3))
- SET PSOI=$PIECE($GET(^("OR1")),"^")
- SET PSOSIG=$PIECE($GET(^("SIG")),"^")
- SET STAT=+^("STA")
- +17 SET PSORXED("INS")=$GET(^PSRX(PSORXED("IRXN"),"INS"))
- SET PSORXED("ENT")=0
- +18 IF $GET(^PSRX(PSORXED("IRXN"),"INSS"))]""
- SET PSORXED("SINS")=^PSRX(PSORXED("IRXN"),"INSS")
- +19 SET D=0
- FOR
- SET D=$ORDER(^PSRX(PSORXED("IRXN"),"INS1",D))
- IF 'D
- QUIT
- SET PSORXED("SIG",D)=^PSRX(PSORXED("IRXN"),"INS1",D,0)
- +20 IF '$ORDER(PSORXED("SIG",0))
- IF $GET(PSORXED("INS"))]""
- SET PSORXED("SIG",1)=PSORXED("INS")
- +21 IF $GET(^PSRX(PSORXED("IRXN"),"TN"))]""
- SET PSODRUG("TRADE NAME")=^PSRX(PSORXED("IRXN"),"TN")
- +22 ; IHS/CIA/PLS - 11/01/04 - Populate IHS fields during copy function.
- +23 ; IHS/MSC/PLS - 09/17/07 - Added logic for CLININD and CLININD2
- +24 IF $DATA(^PSRX(PSORXED("IRXN"),9999999))
- Begin DoDot:1
- +25 SET PSORXED("AWP")=$PIECE($GET(^PSRX(PSORXED("IRXN"),9999999)),U,6)
- +26 SET PSORXED("BST")=$PIECE($GET(^PSRX(PSORXED("IRXN"),9999999)),U,7)
- +27 SET PSORXED("CM")=$PIECE($GET(^PSRX(PSORXED("IRXN"),9999999)),U,2)
- +28 SET PSORXED("CLININD")=$PIECE($GET(^PSRX(PSORXED("IRXN")=999999921)),U,1)
- +29 SET PSORXED("CLININD2")=$PIECE($GET(^PSRX(PSORXED("IRXN")=999999921)),U,2)
- End DoDot:1
- +30 FOR I=0:0
- SET I=$ORDER(^PSRX(PSORXED("IRXN"),6,I))
- IF 'I
- QUIT
- SET DOSE=^PSRX(PSORXED("IRXN"),6,I,0)
- Begin DoDot:1
- +31 IF $PIECE(DOSE,"^")']""!($PIECE(DOSE,"^",8)']"")
- QUIT
- +32 SET PSORXED("ENT")=PSORXED("ENT")+1
- +33 SET PSORXED("DOSE",PSORXED("ENT"))=$PIECE(DOSE,"^")
- SET PSORXED("UNITS",PSORXED("ENT"))=$PIECE(DOSE,"^",3)
- SET PSORXED("DOSE ORDERED",PSORXED("ENT"))=$PIECE(DOSE,"^",2)
- +34 SET PSORXED("ROUTE",PSORXED("ENT"))=$PIECE(DOSE,"^",7)
- SET PSORXED("SCHEDULE",PSORXED("ENT"))=$PIECE(DOSE,"^",8)
- SET PSORXED("DURATION",PSORXED("ENT"))=$PIECE(DOSE,"^",5)
- +35 SET PSORXED("CONJUNCTION",PSORXED("ENT"))=$PIECE(DOSE,"^",6)
- SET PSORXED("VERB",PSORXED("ENT"))=$PIECE(DOSE,"^",9)
- +36 IF $GET(^PSRX(PSORXED("IRXN"),6,I,1))]""
- SET PSORXED("ODOSE",PSORXED("ENT"))=^PSRX(PSORXED("IRXN"),6,I,1)
- +37 IF $GET(PSORXED("DURATION",PSORXED("ENT")))]""
- Begin DoDot:2
- +38 SET DUR1=PSORXED("DURATION",PSORXED("ENT"))
- +39 SET PSORXED("DURATION",PSORXED("ENT"))=$SELECT($EXTRACT(DUR1,1)'?.N:$EXTRACT(DUR1,2,99)_$EXTRACT(DUR1,1),1:DUR1)
- End DoDot:2
- KILL DR,DUR1
- +40 SET PSORXED("NOUN",PSORXED("ENT"))=$PIECE(DOSE,"^",4)
- KILL DOSE
- End DoDot:1
- +41 IF $GET(^PSDRUG($PIECE(PSORXED("RX0"),"^",6),"I"))]""
- IF ^("I")<DT
- SET VALMSG="Cannot COPY. This drug has been inactivated!"
- SET VALMBCK="R"
- GOTO OUT
- +42 IF $PIECE(^PSDRUG($PIECE(PSORXED("RX0"),"^",6),2),"^",3)'["O"
- SET VALMSG="Cannot Copy. Drug no longer used by Outpatient!"
- SET VALMBCK="R"
- GOTO OUT
- +43 ;JDS/MSC M
- IF '$$SCREEN^APSPMULT(+$PIECE(PSORXED("RX0"),"^",6),,1)
- SET VALMSG="Cannot Copy. Drug is not available in facility"
- SET VALMBCK="R"
- GOTO OUT
- +44 ;Check for invalid Dosage
- +45 NEW PSOOCPRX,PSOOLPF,PSOOLPD,PSONOSIG
- SET PSOOCPRX=PSORXED("IRXN")
- DO CDOSE^PSORENW0
- +46 IF PSOOLPF
- Begin DoDot:1
- +47 SET VALMSG="Cannot copy, invalid Dosage of "_$GET(PSOOLPD)
- End DoDot:1
- SET VALMBCK="R"
- GOTO OUT
- +48 IF PSONOSIG
- Begin DoDot:1
- +49 SET VALMSG="Cannot copy, missing Sig"
- End DoDot:1
- SET VALMBCK="R"
- GOTO OUT
- +50 IF '$PIECE($GET(^PSDRUG($PIECE(PSORXED("RX0"),"^",6),2)),"^")
- SET VALMBCK="R"
- GOTO OUT
- +51 SET DREN=$PIECE(PSORXED("RX0"),"^",6)
- SET PSODAYS=$PIECE(PSORXED("RX0"),"^",8)
- SET PSORXST=+$PIECE($GET(^PS(53,$PIECE(PSORXED("RX0"),"^",3),0)),"^",7)
- SET POERR=1
- DO DRG^PSOORDRG
- KILL POERR
- +52 IF $GET(PSORX("DFLG"))
- SET VALMBCK="R"
- +53 DO EN^PSOORED1(.PSORXED)
- IF $GET(PSORX("FN"))
- SET VALMBCK="Q"
- SET PSOFROM="NEW"
- DO DCORD^PSONEW2
- +54 IF '$TEST
- SET VALMBCK="R"
- OUT ;
- +1 DO PSOUL^PSSLOCK($PIECE(PSOLST(ORN),"^",2))
- +2 KILL PSOCOPY
- DO ^PSOBUILD
- DO ACT^PSOORNE2
- EX SET X=PSODFN_";DPT("
- DO ULK^ORX2
- +1 DO UL^PSSLOCK(PSODFN)
- +2 KILL PSOMSG,PSONEW,PSOSIG,STA,DREN,PSODAYS,PSORXST,PSOCOPY,PSORXED,FST,FLD,IEN,FLN,INCOM,PSOI,COPY,SIG,SIGOK,PSODRUG,^TMP("PSOPO",$JOB)
- +3 DO CLEAN^PSOVER1
- DO EOJ^PSONEW
- +4 QUIT
- LOCK ;
- +1 IF $PIECE($GET(PSOPLCK),"^")'=0
- QUIT
- +2 WRITE !!,$SELECT($PIECE($GET(PSOPLCK),"^",2)'="":$PIECE($GET(PSOPLCK),"^",2),1:"Another person")_" is working on this patient."
- +3 KILL DIR
- SET DIR(0)="E"
- SET DIR("A")=" Press Return to Continue"
- DO ^DIR
- KILL DIR
- +4 QUIT
