PSJLIFNI ;BIR/MV-U/D ORDER FINISHES AS IV ;13 Jan 98 / 11:32 AM
;;5.0;INPATIENT MEDICATIONS;**1,29,34,37,50,94,116,110,111,181,261,256,347**;16 DEC 97;Build 6
;
IV(PSJORD,OI) ; Prompt for missing data to be finished as IV.
L +^PS(53.1,+PSJORD):1 I '$T W !,$C(7),$C(7),"This order is being edited by another user. Try later." D PAUSE^VALM1 Q
D HOLDHDR^PSJOE
;** PSIVFN1 is used so it will display the AC/Edit screen
;** instead of go to the "IS this O.K." prompt
;** PSJLIFNI is a flag to indicate U/D finishes as IV.
K PSJIVBD
NEW PSIVFN1,ON55,PSGORQF,PSIVACEP,DRGOC,PSJLIFNI,PSIVOI,PSJOLDNM
K PSGORQF
S PSJLIFNI=1
S PSIVAC="CF" S (P("PON"),ON,ON55)=+PSJORD_"P",DFN=PSGP
S PSIVUP=+$$GTPCI^PSIVUTL D GT531^PSIVORFA(DFN,ON) S P("PD")=OI_U_$$OIDF^PSJLMUT1(+OI)
D:'$D(P("OT")) GTOT^PSIVUTL(P(4))
S P("OPI")=$$ENPC^PSJUTL("V",+PSIVUP,60,P("OPI"))
D 53^PSIVORC1
I $E(P("OT"))="I" D GTDATA^PSJLIFN Q:P(4)=""
;I $$SCHREQ^PSJLIVFD(.P),(P(9))]"",'$$PRNOK^PSGS0(P(9)) N PSGOES,X,PSGS0XT,PSJNSS S PSJNSS=1,PSGOES=1,X=P(9),PSGS0XT=P(15) D Q2^PSGS0
I $$SCHREQ^PSJLIVFD(.P),(P(9))]"",'$$PRNOK^PSGS0(P(9)) N PSJNSS,PSGOES,PSGS0XT,PSGS0Y,PSGAT S X=P(9),PSGS0XT=P(15),PSGAT=P(11) D
.;
.;PSJ*5*256
. S PSJOLDNM("ORD_SCHD")=P(9)
. I ($G(P("RES"))'="R"),$$CHKSCHD^PSJMISC2(.PSJOLDNM) S PSGORQF=1,VALMBCK="R" Q
. S:$G(PSJOLDNM("NEW_SCHD"))]"" P(9)=PSJOLDNM("NEW_SCHD")
.;
.;D EN^PSGS0 I $G(X)="" D S PSGORQF=1 Q
.D EN^PSGS0
.I $G(X)="" S PSGORQF=1 Q
.;Update the schedule if diff value enttered.
.I ($G(X)]""),($G(P(9))]"") S P(9)=X
.I $G(PSGS0Y)>1 S P(11)=PSGS0Y
I $E(P("OT"))="I",'$D(DRG("AD")),('$D(DRG("SOL"))) S DNE=0 D GTIVDRG^PSIVORC2 S P(3)="" D ENSTOP^PSIVCAL
I $D(PSGORQF) S VALMBCK="R",P(4)="" K DRG Q
S ^TMP("PSJI",$J,0)=""
S PSIVOK="1^3^10^25^26^39^57^58^59^63^64" D CKFLDS^PSIVORC1 I EDIT]"" D EDIT^PSIVEDT
;I $G(EDIT)="" D OC^PSIVOC
I $G(DONE) S VALMBCK="R" D EXIT Q
;PSJ*5*261 - Remedy #490875 PSPO 2040
D ENSTOP^PSIVCAL
D COMPLTE^PSIVORC1
S:$D(PSIVACEP) VALMBCK="Q"
EXIT ;
L -^PS(53.1,+PSJORD)
Q
ORDCHK(DFN,TYPE) ;
;TYPE ="DD" - Duplicate drug
; ="DC" - Duplicate class
; -"DI" - Drug Interaction
;
NEW ON,PSJL,PSIVX,PSJOC,PSJORIEN,PSJPACK,PSJLINE
S PSJOC=0,PSJLINE=1
F PSIVX=0:0 S PSIVX=$O(^TMP($J,TYPE,PSIVX)) Q:'PSIVX D
. I TYPE="DI",($P(^TMP($J,TYPE,PSIVX,0),U,4)="CRITICAL") S PSJIREQ=1
. D WRITE(TYPE),CONT^PSGSICHK
.; I ON["V" D
.;. I '$O(^PS(55,DFN,"IV",+ON,0)) D SETPSJOC Q
.;. D DSPLORDV(DFN,ON) S PSJOC=PSJOC+1
.; I ON'["V" D DSPLORDU(DFN,ON) S PSJOC=PSJOC+1
.; S PSJOC(ON,PSJLINE)="",PSJLINE=PSJLINE+1
;D:PSJOC WRITE(TYPE)
;S ON="" F S ON=$O(PSJOC(ON)) Q:ON="" W ! S PSJLINE=PSJLINE+1 D
;. F PSIVX=0:0 S PSIVX=$O(PSJOC(ON,PSIVX)) Q:'PSIVX W !,PSJOC(ON,PSIVX) S PSJLINE=PSJLINE+1 D:'(PSIVX#6) PAUSE
;W !
Q
WRITE(TYPE) ;Display order check description
S PSJPDRG=1
I TYPE="DD" W !!,"There are duplicate ",$P(^TMP($J,TYPE,PSIVX,0),U,2),!,"medications prescribed for this order.",! Q
I TYPE="DC" W !!,"This medication: ",$P(^TMP($J,TYPE,PSIVX,0),U,4),!,"is in the same class as the following medication(s) within this order: "
I TYPE="DI" W !!,"This medication: ",$P(^TMP($J,TYPE,PSIVX,0),U,2),!,"has an interaction with the following medication(s) within this order: "
F X=0:0 S X=$O(^TMP($J,TYPE,X)) Q:'X W !,$S(TYPE="DC":$P(^TMP($J,TYPE,X,0),U,4),TYPE="DI":$P(^TMP($J,TYPE,X,0),U,6),1:$P(^TMP($J,TYPE,X,0),U,2)),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJLIFNI 3477 printed Dec 13, 2024@02:07:20 Page 2
PSJLIFNI ;BIR/MV-U/D ORDER FINISHES AS IV ;13 Jan 98 / 11:32 AM
+1 ;;5.0;INPATIENT MEDICATIONS;**1,29,34,37,50,94,116,110,111,181,261,256,347**;16 DEC 97;Build 6
+2 ;
IV(PSJORD,OI) ; Prompt for missing data to be finished as IV.
+1 LOCK +^PS(53.1,+PSJORD):1
IF '$TEST
WRITE !,$CHAR(7),$CHAR(7),"This order is being edited by another user. Try later."
DO PAUSE^VALM1
QUIT
+2 DO HOLDHDR^PSJOE
+3 ;** PSIVFN1 is used so it will display the AC/Edit screen
+4 ;** instead of go to the "IS this O.K." prompt
+5 ;** PSJLIFNI is a flag to indicate U/D finishes as IV.
+6 KILL PSJIVBD
+7 NEW PSIVFN1,ON55,PSGORQF,PSIVACEP,DRGOC,PSJLIFNI,PSIVOI,PSJOLDNM
+8 KILL PSGORQF
+9 SET PSJLIFNI=1
+10 SET PSIVAC="CF"
SET (P("PON"),ON,ON55)=+PSJORD_"P"
SET DFN=PSGP
+11 SET PSIVUP=+$$GTPCI^PSIVUTL
DO GT531^PSIVORFA(DFN,ON)
SET P("PD")=OI_U_$$OIDF^PSJLMUT1(+OI)
+12 if '$DATA(P("OT"))
DO GTOT^PSIVUTL(P(4))
+13 SET P("OPI")=$$ENPC^PSJUTL("V",+PSIVUP,60,P("OPI"))
+14 DO 53^PSIVORC1
+15 IF $EXTRACT(P("OT"))="I"
DO GTDATA^PSJLIFN
if P(4)=""
QUIT
+16 ;I $$SCHREQ^PSJLIVFD(.P),(P(9))]"",'$$PRNOK^PSGS0(P(9)) N PSGOES,X,PSGS0XT,PSJNSS S PSJNSS=1,PSGOES=1,X=P(9),PSGS0XT=P(15) D Q2^PSGS0
+17 IF $$SCHREQ^PSJLIVFD(.P)
IF (P(9))]""
IF '$$PRNOK^PSGS0(P(9))
NEW PSJNSS,PSGOES,PSGS0XT,PSGS0Y,PSGAT
SET X=P(9)
SET PSGS0XT=P(15)
SET PSGAT=P(11)
Begin DoDot:1
+18 ;
+19 ;PSJ*5*256
+20 SET PSJOLDNM("ORD_SCHD")=P(9)
+21 IF ($GET(P("RES"))'="R")
IF $$CHKSCHD^PSJMISC2(.PSJOLDNM)
SET PSGORQF=1
SET VALMBCK="R"
QUIT
+22 if $GET(PSJOLDNM("NEW_SCHD"))]""
SET P(9)=PSJOLDNM("NEW_SCHD")
+23 ;
+24 ;D EN^PSGS0 I $G(X)="" D S PSGORQF=1 Q
+25 DO EN^PSGS0
+26 IF $GET(X)=""
SET PSGORQF=1
QUIT
+27 ;Update the schedule if diff value enttered.
+28 IF ($GET(X)]"")
IF ($GET(P(9))]"")
SET P(9)=X
+29 IF $GET(PSGS0Y)>1
SET P(11)=PSGS0Y
End DoDot:1
+30 IF $EXTRACT(P("OT"))="I"
IF '$DATA(DRG("AD"))
IF ('$DATA(DRG("SOL")))
SET DNE=0
DO GTIVDRG^PSIVORC2
SET P(3)=""
DO ENSTOP^PSIVCAL
+31 IF $DATA(PSGORQF)
SET VALMBCK="R"
SET P(4)=""
KILL DRG
QUIT
+32 SET ^TMP("PSJI",$JOB,0)=""
+33 SET PSIVOK="1^3^10^25^26^39^57^58^59^63^64"
DO CKFLDS^PSIVORC1
IF EDIT]""
DO EDIT^PSIVEDT
+34 ;I $G(EDIT)="" D OC^PSIVOC
+35 IF $GET(DONE)
SET VALMBCK="R"
DO EXIT
QUIT
+36 ;PSJ*5*261 - Remedy #490875 PSPO 2040
+37 DO ENSTOP^PSIVCAL
+38 DO COMPLTE^PSIVORC1
+39 if $DATA(PSIVACEP)
SET VALMBCK="Q"
EXIT ;
+1 LOCK -^PS(53.1,+PSJORD)
+2 QUIT
ORDCHK(DFN,TYPE) ;
+1 ;TYPE ="DD" - Duplicate drug
+2 ; ="DC" - Duplicate class
+3 ; -"DI" - Drug Interaction
+4 ;
+5 NEW ON,PSJL,PSIVX,PSJOC,PSJORIEN,PSJPACK,PSJLINE
+6 SET PSJOC=0
SET PSJLINE=1
+7 FOR PSIVX=0:0
SET PSIVX=$ORDER(^TMP($JOB,TYPE,PSIVX))
if 'PSIVX
QUIT
Begin DoDot:1
+8 IF TYPE="DI"
IF ($PIECE(^TMP($JOB,TYPE,PSIVX,0),U,4)="CRITICAL")
SET PSJIREQ=1
+9 DO WRITE(TYPE)
DO CONT^PSGSICHK
+10 ; I ON["V" D
+11 ;. I '$O(^PS(55,DFN,"IV",+ON,0)) D SETPSJOC Q
+12 ;. D DSPLORDV(DFN,ON) S PSJOC=PSJOC+1
+13 ; I ON'["V" D DSPLORDU(DFN,ON) S PSJOC=PSJOC+1
+14 ; S PSJOC(ON,PSJLINE)="",PSJLINE=PSJLINE+1
End DoDot:1
+15 ;D:PSJOC WRITE(TYPE)
+16 ;S ON="" F S ON=$O(PSJOC(ON)) Q:ON="" W ! S PSJLINE=PSJLINE+1 D
+17 ;. F PSIVX=0:0 S PSIVX=$O(PSJOC(ON,PSIVX)) Q:'PSIVX W !,PSJOC(ON,PSIVX) S PSJLINE=PSJLINE+1 D:'(PSIVX#6) PAUSE
+18 ;W !
+19 QUIT
WRITE(TYPE) ;Display order check description
+1 SET PSJPDRG=1
+2 IF TYPE="DD"
WRITE !!,"There are duplicate ",$PIECE(^TMP($JOB,TYPE,PSIVX,0),U,2),!,"medications prescribed for this order.",!
QUIT
+3 IF TYPE="DC"
WRITE !!,"This medication: ",$PIECE(^TMP($JOB,TYPE,PSIVX,0),U,4),!,"is in the same class as the following medication(s) within this order: "
+4 IF TYPE="DI"
WRITE !!,"This medication: ",$PIECE(^TMP($JOB,TYPE,PSIVX,0),U,2),!,"has an interaction with the following medication(s) within this order: "
+5 FOR X=0:0
SET X=$ORDER(^TMP($JOB,TYPE,X))
if 'X
QUIT
WRITE !,$SELECT(TYPE="DC":$PIECE(^TMP($JOB,TYPE,X,0),U,4),TYPE="DI":$PIECE(^TMP($JOB,TYPE,X,0),U,6),1:$PIECE(^TMP($JOB,TYPE,X,0),U,2)),!
+6 QUIT
