| 1 | PSIVOD ;BIR/JCH-CREATE NEW IV ORDER FROM OLD ONE ;25 Nov 98 / 3:34 PM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**110,127**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^PS(55 is supported by DBIA 2191.
|
|---|
| 5 | ; Reference to ^ORX2 is supported by DBIA 867.
|
|---|
| 6 | ;
|
|---|
| 7 | COPY(DFN,OLDON) ;Ask to enter new order.
|
|---|
| 8 | N PSIVOORD,OLDP,PSIVCOPY,PSGCOPY M OLDP=P
|
|---|
| 9 | Q:'$$HIDDEN^PSJLMUTL("COPY") D ^PSJHVARS
|
|---|
| 10 | I $P($G(^PS(55,PSGP,"IV",+PSGORD,.2)),U,4)="D",'$P($G(^(4)),"^",3) D G Q
|
|---|
| 11 | .W !!,"Nurse verified orders with a priority of DONE may not be Copied." D PAUSE^VALM1 Q
|
|---|
| 12 | S PSGOEAV=$P(PSJSYSP0,U,9)&PSJSYSU S PSIVOORD=PSJORD
|
|---|
| 13 | D FULL^VALM1
|
|---|
| 14 | F W !!,"Do you want to copy this order" S %=2 D YN^DICN Q:% D CH
|
|---|
| 15 | G:%'=1 Q
|
|---|
| 16 | S P("RES")="N",PSIVAC="PN",P("PON")=ON55,PSIVUP=+$$GTPCI^PSIVUTL,PSJORD=ON55,PSGORD=PSJORD
|
|---|
| 17 | N OLDACT,PSIVCHG S OLDACT=PSGACT S PSGACT=PSGACT_"E",P(17)="N",(P("LOG"),P("LF"))="",P(21)="" K P("NAT")
|
|---|
| 18 | S:'$G(PSGDT) PSGDT=$$DATE^PSJUTL2() S P("LOG")=PSGDT,P("PRNTON")=""
|
|---|
| 19 | D ENT^PSIVCAL,ENSTOP^PSIVCAL S ND4="^^^^" F I=5,6,8,9 S $P(ND2,"^",I)=""
|
|---|
| 20 | S P(17)=$S($G(PSGOEAV):"A",1:"N") S P("CLRK")=DUZ_"^"_$P($G(^VA(200,+DUZ,0)),"^")
|
|---|
| 21 | S PSIVCHG=0,PSJNEWOE=0,PSIVCOPY=1,VALMBCK="Q" K PSIVACEP
|
|---|
| 22 | N PSGORD,ON,ON55,PSJORD D NEW55^PSIVORFB S (PSJORD,ON)=ON55,PSIVCOPY=2
|
|---|
| 23 | D EN^VALM("PSJ LM IV AC/EDIT")
|
|---|
| 24 | I $G(P("NAT"))=""&($G(PSJORNAT)="") D G Q
|
|---|
| 25 | .D FULL^VALM1 W !!,"Order not copied" D PAUSE^VALM1
|
|---|
| 26 | W !!,"...copying..."
|
|---|
| 27 | ;
|
|---|
| 28 | I '$G(PSGOEAV) D INMED
|
|---|
| 29 | ;
|
|---|
| 30 | D FULL^VALM1 W !!?5,"You are finished with the new order.",!,"The following ACTION prompt is for the original order." D PAUSE^VALM1
|
|---|
| 31 | Q ; Kill and exit.
|
|---|
| 32 | L:'$D(PSJOE) -^PS(53.45,DUZ) S PSJNKF=1 D Q^PSIV
|
|---|
| 33 | K FIL,I1,ND,PC,PDM,PSGDT,PSGID,PSGLMT,PSGSI,PSJNARC,PSIVAC,PSIVCHG,PSIVUP,PSIVX,PSJOPC
|
|---|
| 34 | S VALMBCK="R"
|
|---|
| 35 | I '$G(PSGDT) S PSGDT=$$DATE^PSJUTL2
|
|---|
| 36 | S PSGACT=$$ENACTION^PSGOE1(PSGP,PSIVOORD) ; resets PSGACT after copy
|
|---|
| 37 | D RESTORE^PSJHVARS
|
|---|
| 38 | K P M P=OLDP
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | INMED ;
|
|---|
| 42 | K PSJACEPT S VALMBCK="Q",PSIVCOPY=2,PSIVCHG=0 ;D ACEDIT^PSJLIACT
|
|---|
| 43 | N ON55TMP,P21TMP S ON55TMP=ON55,P21TMP=$G(P(21)) S P(21)="" I $G(ON55)["P",($G(PSJORD)["V") S ON55=PSJORD
|
|---|
| 44 | D DEL55^PSIVORE2 I $G(ON55TMP)]"" S ON55=ON55TMP,P(21)=P21TMP
|
|---|
| 45 | ;S (PSJORNAT,P("NAT"))="W"
|
|---|
| 46 | ;D OK^PSIVORE
|
|---|
| 47 | D EN^VALM("PSJ LM IV INPT ACTIVE")
|
|---|
| 48 | L -^PS(55,DFN,"IV",+ON55) D ULK
|
|---|
| 49 | I $G(P("NAT"))="" D G Q
|
|---|
| 50 | .D FULL^VALM1 W !!,"Order not copied" D PAUSE^VALM1
|
|---|
| 51 | Q
|
|---|
| 52 | ULK ;
|
|---|
| 53 | Q:'$G(PSJLSORX) ;If NEW^PSIVORE did not lock, don't kill it here.
|
|---|
| 54 | NEW X S X=DFN_";DPT(" D ULK^ORX2 K PSJLSORX
|
|---|
| 55 | Q
|
|---|
| 56 | HK ;Queue job to print MAR labels generated for this patient.
|
|---|
| 57 | I PSGOP,PSGOP'=DFN D
|
|---|
| 58 | .N PSJACPF,PSJACNWP,PSJPWD,PSJSYSL,PSJSYSW,PSJSYSW0,DFN,VAIN,VAERR S DFN=PSGOP
|
|---|
| 59 | .D INP^VADPT S PSJPWD=+VAIN(4) I PSJPWD S PSJACPF=10 S PSJACPF=10 D WP^PSJAC D:$P(PSJSYSL,U,2)]"" ENQL^PSGLW
|
|---|
| 60 | S PSGOP=DFN
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | SPSOL S SPSOL=0 F XXX=0:0 S XXX=$O(^PS(55,DFN,"IV",+ON55,"SOL",XXX)) Q:'XXX S SPSOL=SPSOL+$P(^(XXX,0),U,2)
|
|---|
| 64 | K XXX Q
|
|---|
| 65 | CH ;
|
|---|
| 66 | W !!?2,"Answer 'YES' to have a new, non-verified order created for this patient,"
|
|---|
| 67 | W !,"using the information from this order. (The START and STOP dates will be",!,"recalculated.) Enter 'NO' (or '^') to stop now."
|
|---|
| 68 | Q
|
|---|
