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