PSIV ;BIR/PR,MLM - MISC UTILITIES ;3/19/99 9:45 AM
;;5.0;INPATIENT MEDICATIONS;**7,16,29,38,53,56,72,58,110,181,267,275,281,256**;16 DEC 97;Build 34
;
; Reference to ^PS(55 is supported by DBIA 2191
; Reference to ^PSSLOCK is supported by DBIA 2789
; Reference to ^%DTC is supported by DBIA 10000
; Reference to ^DIC is supported by DBIA 10006
; Reference to ^DIE is supported by DBIA 10018
; Reference to ^DIR is supported by DBIA 10026
; Reference to ^VALM is supported by DBIA 10118
; Reference to ^VALM1 is supported by DBIA 10116
;
ENGETP ;Enter here to select patient.
K DIC S DIC("W")="W "" "",$P(^(0),""^"",9) W:$D(^(.1)) "" "",^(.1)",DIC="^DPT(",DIC(0)="QEM"
D FULL^VALM1
GETP1 ;
;NEW arrays use in order checks
NEW PSJEXCPT,PSJOCER
S PSGPTMP=0,PPAGE=1,DFN=-1,X="Select PATIENT:^^^^1" D ENQ Q:"^"[X
D EN^PSJDPT
I Y<0 G ENGETP
N PSGP,PSJACNWP S (PSGP,DFN)=+Y D ENBOTH^PSJAC S PSJORL=$$ENORL^PSJUTL($G(VAIN(4)))
Q
;
ENYN ;Enter here for yes/no responses. This is a general reader that I have
;been phasing out with ^DICN
S X=X_"^Y:YES;N:NO^YES,NO"
;
ENQ ;Enter here to read X. This is the general reader that I have
;been slowly phasing out
S QUD=$P(X,"^",2) W !!,$P(X,"^")," " W:QUD]"" QUD,"// " R QUX:DTIME W:'$T $C(7) S:'$T QUX="^" S:QUX="" QUX=QUD I QUX["^"!(QUX["?") G KILL
I $L(QUX)>500 W " ??" G ENQ
S:QUX?1L QUX=$C($A(QUX)-32)
S QUD=";"_$P(X,"^",3)_";" G:QUD'[(";"_QUX_":") VAR S QUX1=$E(QUD,$F(QUD,QUX_":"),($F(QUD,";",$F(QUD,QUX_":"))-2)) G:QUX1[":" VAR W " ",QUX1 G KILL
VAR F QUX1=1:1 S QUD=$P($P(X,"^",4),",",QUX1) Q:QUD="" I $P(QUD,QUX)="" W $S($P(X,"^",2)=QUX:" "_QUX,1:"")_$P(QUD,QUX,2,99) S QUX=QUD G KILL
PAT I $P(X,"^",5)]"",@$P(X,"^",5,999) G KILL
W $C(7)," ???" G ENQ
KILL S X=QUX K QUX,QUX1,QUD,PSJDCEXP Q
;
ENADM ;Edit administration schedules.
; reference to ^PS(51.1 is supported by DBIA #2177
S DIC="^PS(51.1,",DIC(0)="QEAML",DLAYGO=51.1 D ^DIC K:+Y<0 %,DA,D0,DIC,DIE,DLAYGO,DR,Z,Y Q:'$D(Y) S DIE=DIC,DR=".01;1",DA=+Y K DIC D ^DIE G ENADM
;
ENOW D NOW^%DTC S Y=% K %,%H,%I
Q
;
ENC ;Get unit of measure for drug selected.
S X=$P($P(";"_$P(Y,U,3),";"_X_":",2),";")
Q
;
ENCHS ;Needs PSIVBR (Branch point)
D ENGETP G:DFN<0 Q
;* Lock patient if calling FROM PSJI DELETE ORDER.
I PSIVBR="D ENT^PSIVPGE",('$$L^PSSLOCK(DFN,1)) Q
OE N CONT S CONT=0
F Q:CONT D ENCHS1
Q:$D(ORVP)
G ENCHS
ENCHS1 ;
I '($$AA^PSJDPT(DFN)>0) S CONT=1 Q
S PSJORQF=0,CONT=0
S PSJPROT=2,PSJOL="",(PSGOP,PSGP)=DFN
K PSJLMPRO D EN^VALM("PSJ LM BRIEF PATIENT INFO")
S VALMCNT=30
I PSIVBR="D PROCESS^PSIVRD",(PSJOL="N") D ORDNO^PSIVRD Q
I $G(PSJNEWOE) S PSJOL="S"
I PSJOL="S"!(PSJOL="L") F Q:CONT S P("PT")=PSJOL D
. S PSJORQF=0,PSJNEWOE=0
. D ENNB^PSIVACT
. I '$D(^TMP("PSIV",$J)) D FULL^VALM1 W !!,?30,"NO ORDERS FOUND",! K DIR S DIR(0)="E" D ^DIR W @IOF S CONT=0
. NEW PSJIVPRF S PSJIVPRF=1
. S PSJOL=$S(",S,L,"[(","_$G(PSJOL)_","):PSJOL,1:"S")
. D EN^VALM("PSJ LM IV OE")
. I $G(VALMBCK)="Q" Q
. S CONT=1
;* Unlock patient if come from PSJI DELETE ORDER
I '$G(PSJORQF) S CONT=1
I PSIVBR="D ENT^PSIVPGE" D UL^PSSLOCK(DFN)
K PSJLMPRO
Q
SELSO ;SELECT ORDER USING "SO" OPTION
S PSGLMT=^TMP("PSJPRO",$J,0) D ENASR^PSGON,OV
Q
SELNUM ;SELECT ORDERS WITH NUMBERS
S PSGLMT=^TMP("PSJPRO",$J,0),X=$P(XQORNOD(0),"=",2) D ENCHK^PSGON,OV
Q
OV ;
I '$D(PSGODDD) S VALMBCK="R" Q
N DONE
F PSIVOV1=1:1:PSGODDD F PSIVOV2=1:1:$L(PSGODDD(PSIVOV1),",")-1 D
.S ON=+$P(PSGODDD(PSIVOV1),",",PSIVOV2)
.S ON=$$GTON(ON)
.Q:'ON!$G(DONE)
.D OV1
S VALMBCK="Q"
Q
GTON(X) ;
;Return the ON node from ^Tmp
I $G(X)="" Q ""
I $D(^TMP("PSIV",$J,"AB",X)) Q ^(X)
I $D(^TMP("PSIV",$J,"NB",X)) Q ^(X)
I $D(^TMP("PSIV",$J,"PB",X)) Q ^(X)
I $D(^TMP("PSIV",$J,"XB",X)) Q ^(X)
I $D(^TMP("PSIV",$J,"NDB",X)) Q ^(X)
I $D(^TMP("PSIV",$J,"PDB",X)) Q ^(X)
I $D(^TMP("PSIV",$J,"RDB",X)) Q ^(X)
; clinic orders
N REF,REF2,PSJCLND S (REF,REF2,PSJCLND)="" F S PSJCLND=$O(^TMP("PSIV",$J,PSJCLND)) Q:($G(REF)]"") D
.I $P(PSJCLND,"^",4)="AB" I $D(^TMP("PSIV",$J,PSJCLND,X)) S REF=^(X) Q
.I $P(PSJCLND,"^",4)="NB" I $D(^TMP("PSIV",$J,PSJCLND,X)) S REF=^(X) Q
.I $P(PSJCLND,"^",4)="PB" I $D(^TMP("PSIV",$J,PSJCLND,X)) S REF=^(X) Q
.I $P(PSJCLND,"^",4)="XB" I $D(^TMP("PSIV",$J,PSJCLND,X)) S REF=^(X) Q
.I $P(PSJCLND,"^",4)="NDB" I $D(^TMP("PSIV",$J,PSJCLND,X)) S REF=^(X) Q
.I $P(PSJCLND,"^",4)="PDB" I $D(^TMP("PSIV",$J,PSJCLND,X)) S REF=^(X) Q
.I $P(PSJCLND,"^",4)="RDB" I $D(^TMP("PSIV",$J,PSJCLND,X)) S REF=^(X) Q
I ($G(REF)]"") Q REF
Q ""
OV1 ;
;PSJENHOC=1 if DI,DT were displayed. This will be used by dosing OC to check if error messages should display or not
NEW PSJDSVFY,PSJENHOC
K PSJEXCPT("PROSPECTIVE") ;*256
S (ON,ON55,P("PON"))=9999999999-ON_$S(ON["V":"V",1:"P")
I PSIVBR["D ^PSIVVW1" D
. S VALMSG="Select either ""AL"" , ""LL"" or ""AL,LL"" for both"
. S PSJORD=ON D EN^PSJLIPRF
E D
. I PSIVBR="D ^PSIVOPT",'($$LS^PSSLOCK(PSGP,ON)) Q
. X PSIVBR
. D:PSIVBR="D ^PSIVOPT" UNL^PSSLOCK(PSGP,ON)
K:'$D(DUOUT)&($G(Y)'=-1) DONE
Q
;
;
ENU ;Get IV additive strength. Called from templates.
N Y S Y=+^PS(55,DA(2),"IV",DA(1),"AD",DA,0),PSIVSTR=$$ENU^PSIVUTL(Y)
Q
Q ;
K ^TMP($J,"PSJPRE")
K ^TMP("PSIV",$J),^TMP("PSJ",$J),^TMP("PSJPRO",$J),^TMP("PSJALL",$J),^TMP("PSJI",$J),^TMP("PSJON",$J)
K DRG,DRGI,DRGN,DRGT,ERR,I,JJ,MI,N,N2,ON,ON55,P,P1,P3,P16,P17,PNOW,PS,PSGODD,PSGODDD,PSIV,PSIVAAT,PSIVACT,PSIVADM,PSIVAT
K PSIVC,PSIVDT,PSIVFLAG,PSIVLN,PSIVNOW,PSIVNU,PSIVON,PSIVOV1,PSIVOV2,PSIVREA,PSIVSTR,PSIVSTRT,PSIVNOL,PSIVTYPE,PSJNKF
K PSJORF,PSJORIFN,RDWARD,START,STOP,SCHED,USER,V,XT,DUOUT,DTOUT
K %,%I,DIC,PSIVC,PSIVNU,PSIVON,PSIVREA,PSIVOV1,PSIVOV2,RDWARD,V,VAERR,VW,X,X2,Y,Y1,Z,Z1,Z2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIV 5812 printed Sep 23, 2025@19:39:53 Page 2
PSIV ;BIR/PR,MLM - MISC UTILITIES ;3/19/99 9:45 AM
+1 ;;5.0;INPATIENT MEDICATIONS;**7,16,29,38,53,56,72,58,110,181,267,275,281,256**;16 DEC 97;Build 34
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA 2191
+4 ; Reference to ^PSSLOCK is supported by DBIA 2789
+5 ; Reference to ^%DTC is supported by DBIA 10000
+6 ; Reference to ^DIC is supported by DBIA 10006
+7 ; Reference to ^DIE is supported by DBIA 10018
+8 ; Reference to ^DIR is supported by DBIA 10026
+9 ; Reference to ^VALM is supported by DBIA 10118
+10 ; Reference to ^VALM1 is supported by DBIA 10116
+11 ;
ENGETP ;Enter here to select patient.
+1 KILL DIC
SET DIC("W")="W "" "",$P(^(0),""^"",9) W:$D(^(.1)) "" "",^(.1)"
SET DIC="^DPT("
SET DIC(0)="QEM"
+2 DO FULL^VALM1
GETP1 ;
+1 ;NEW arrays use in order checks
+2 NEW PSJEXCPT,PSJOCER
+3 SET PSGPTMP=0
SET PPAGE=1
SET DFN=-1
SET X="Select PATIENT:^^^^1"
DO ENQ
if "^"[X
QUIT
+4 DO EN^PSJDPT
+5 IF Y<0
GOTO ENGETP
+6 NEW PSGP,PSJACNWP
SET (PSGP,DFN)=+Y
DO ENBOTH^PSJAC
SET PSJORL=$$ENORL^PSJUTL($GET(VAIN(4)))
+7 QUIT
+8 ;
ENYN ;Enter here for yes/no responses. This is a general reader that I have
+1 ;been phasing out with ^DICN
+2 SET X=X_"^Y:YES;N:NO^YES,NO"
+3 ;
ENQ ;Enter here to read X. This is the general reader that I have
+1 ;been slowly phasing out
+2 SET QUD=$PIECE(X,"^",2)
WRITE !!,$PIECE(X,"^")," "
if QUD]""
WRITE QUD,"// "
READ QUX:DTIME
if '$TEST
WRITE $CHAR(7)
if '$TEST
SET QUX="^"
if QUX=""
SET QUX=QUD
IF QUX["^"!(QUX["?")
GOTO KILL
+3 IF $LENGTH(QUX)>500
WRITE " ??"
GOTO ENQ
+4 if QUX?1L
SET QUX=$CHAR($ASCII(QUX)-32)
+5 SET QUD=";"_$PIECE(X,"^",3)_";"
if QUD'[(";"_QUX_"
GOTO VAR
SET QUX1=$EXTRACT(QUD,$FIND(QUD,QUX_":"),($FIND(QUD,";",$FIND(QUD,QUX_":"))-2))
if QUX1["
GOTO VAR
WRITE " ",QUX1
GOTO KILL
VAR FOR QUX1=1:1
SET QUD=$PIECE($PIECE(X,"^",4),",",QUX1)
if QUD=""
QUIT
IF $PIECE(QUD,QUX)=""
WRITE $SELECT($PIECE(X,"^",2)=QUX:" "_QUX,1:"")_$PIECE(QUD,QUX,2,99)
SET QUX=QUD
GOTO KILL
PAT IF $PIECE(X,"^",5)]""
IF @$PIECE(X,"^",5,999)
GOTO KILL
+1 WRITE $CHAR(7)," ???"
GOTO ENQ
KILL SET X=QUX
KILL QUX,QUX1,QUD,PSJDCEXP
QUIT
+1 ;
ENADM ;Edit administration schedules.
+1 ; reference to ^PS(51.1 is supported by DBIA #2177
+2 SET DIC="^PS(51.1,"
SET DIC(0)="QEAML"
SET DLAYGO=51.1
DO ^DIC
if +Y<0
KILL %,DA,D0,DIC,DIE,DLAYGO,DR,Z,Y
if '$DATA(Y)
QUIT
SET DIE=DIC
SET DR=".01;1"
SET DA=+Y
KILL DIC
DO ^DIE
GOTO ENADM
+3 ;
ENOW DO NOW^%DTC
SET Y=%
KILL %,%H,%I
+1 QUIT
+2 ;
ENC ;Get unit of measure for drug selected.
+1 SET X=$PIECE($PIECE(";"_$PIECE(Y,U,3),";"_X_":",2),";")
+2 QUIT
+3 ;
ENCHS ;Needs PSIVBR (Branch point)
+1 DO ENGETP
if DFN<0
GOTO Q
+2 ;* Lock patient if calling FROM PSJI DELETE ORDER.
+3 IF PSIVBR="D ENT^PSIVPGE"
IF ('$$L^PSSLOCK(DFN,1))
QUIT
OE NEW CONT
SET CONT=0
+1 FOR
if CONT
QUIT
DO ENCHS1
+2 if $DATA(ORVP)
QUIT
+3 GOTO ENCHS
ENCHS1 ;
+1 IF '($$AA^PSJDPT(DFN)>0)
SET CONT=1
QUIT
+2 SET PSJORQF=0
SET CONT=0
+3 SET PSJPROT=2
SET PSJOL=""
SET (PSGOP,PSGP)=DFN
+4 KILL PSJLMPRO
DO EN^VALM("PSJ LM BRIEF PATIENT INFO")
+5 SET VALMCNT=30
+6 IF PSIVBR="D PROCESS^PSIVRD"
IF (PSJOL="N")
DO ORDNO^PSIVRD
QUIT
+7 IF $GET(PSJNEWOE)
SET PSJOL="S"
+8 IF PSJOL="S"!(PSJOL="L")
FOR
if CONT
QUIT
SET P("PT")=PSJOL
Begin DoDot:1
+9 SET PSJORQF=0
SET PSJNEWOE=0
+10 DO ENNB^PSIVACT
+11 IF '$DATA(^TMP("PSIV",$JOB))
DO FULL^VALM1
WRITE !!,?30,"NO ORDERS FOUND",!
KILL DIR
SET DIR(0)="E"
DO ^DIR
WRITE @IOF
SET CONT=0
+12 NEW PSJIVPRF
SET PSJIVPRF=1
+13 SET PSJOL=$SELECT(",S,L,"[(","_$GET(PSJOL)_","):PSJOL,1:"S")
+14 DO EN^VALM("PSJ LM IV OE")
+15 IF $GET(VALMBCK)="Q"
QUIT
+16 SET CONT=1
End DoDot:1
+17 ;* Unlock patient if come from PSJI DELETE ORDER
+18 IF '$GET(PSJORQF)
SET CONT=1
+19 IF PSIVBR="D ENT^PSIVPGE"
DO UL^PSSLOCK(DFN)
+20 KILL PSJLMPRO
+21 QUIT
SELSO ;SELECT ORDER USING "SO" OPTION
+1 SET PSGLMT=^TMP("PSJPRO",$JOB,0)
DO ENASR^PSGON
DO OV
+2 QUIT
SELNUM ;SELECT ORDERS WITH NUMBERS
+1 SET PSGLMT=^TMP("PSJPRO",$JOB,0)
SET X=$PIECE(XQORNOD(0),"=",2)
DO ENCHK^PSGON
DO OV
+2 QUIT
OV ;
+1 IF '$DATA(PSGODDD)
SET VALMBCK="R"
QUIT
+2 NEW DONE
+3 FOR PSIVOV1=1:1:PSGODDD
FOR PSIVOV2=1:1:$LENGTH(PSGODDD(PSIVOV1),",")-1
Begin DoDot:1
+4 SET ON=+$PIECE(PSGODDD(PSIVOV1),",",PSIVOV2)
+5 SET ON=$$GTON(ON)
+6 if 'ON!$GET(DONE)
QUIT
+7 DO OV1
End DoDot:1
+8 SET VALMBCK="Q"
+9 QUIT
GTON(X) ;
+1 ;Return the ON node from ^Tmp
+2 IF $GET(X)=""
QUIT ""
+3 IF $DATA(^TMP("PSIV",$JOB,"AB",X))
QUIT ^(X)
+4 IF $DATA(^TMP("PSIV",$JOB,"NB",X))
QUIT ^(X)
+5 IF $DATA(^TMP("PSIV",$JOB,"PB",X))
QUIT ^(X)
+6 IF $DATA(^TMP("PSIV",$JOB,"XB",X))
QUIT ^(X)
+7 IF $DATA(^TMP("PSIV",$JOB,"NDB",X))
QUIT ^(X)
+8 IF $DATA(^TMP("PSIV",$JOB,"PDB",X))
QUIT ^(X)
+9 IF $DATA(^TMP("PSIV",$JOB,"RDB",X))
QUIT ^(X)
+10 ; clinic orders
+11 NEW REF,REF2,PSJCLND
SET (REF,REF2,PSJCLND)=""
FOR
SET PSJCLND=$ORDER(^TMP("PSIV",$JOB,PSJCLND))
if ($GET(REF)]"")
QUIT
Begin DoDot:1
+12 IF $PIECE(PSJCLND,"^",4)="AB"
IF $DATA(^TMP("PSIV",$JOB,PSJCLND,X))
SET REF=^(X)
QUIT
+13 IF $PIECE(PSJCLND,"^",4)="NB"
IF $DATA(^TMP("PSIV",$JOB,PSJCLND,X))
SET REF=^(X)
QUIT
+14 IF $PIECE(PSJCLND,"^",4)="PB"
IF $DATA(^TMP("PSIV",$JOB,PSJCLND,X))
SET REF=^(X)
QUIT
+15 IF $PIECE(PSJCLND,"^",4)="XB"
IF $DATA(^TMP("PSIV",$JOB,PSJCLND,X))
SET REF=^(X)
QUIT
+16 IF $PIECE(PSJCLND,"^",4)="NDB"
IF $DATA(^TMP("PSIV",$JOB,PSJCLND,X))
SET REF=^(X)
QUIT
+17 IF $PIECE(PSJCLND,"^",4)="PDB"
IF $DATA(^TMP("PSIV",$JOB,PSJCLND,X))
SET REF=^(X)
QUIT
+18 IF $PIECE(PSJCLND,"^",4)="RDB"
IF $DATA(^TMP("PSIV",$JOB,PSJCLND,X))
SET REF=^(X)
QUIT
End DoDot:1
+19 IF ($GET(REF)]"")
QUIT REF
+20 QUIT ""
OV1 ;
+1 ;PSJENHOC=1 if DI,DT were displayed. This will be used by dosing OC to check if error messages should display or not
+2 NEW PSJDSVFY,PSJENHOC
+3 ;*256
KILL PSJEXCPT("PROSPECTIVE")
+4 SET (ON,ON55,P("PON"))=9999999999-ON_$SELECT(ON["V":"V",1:"P")
+5 IF PSIVBR["D ^PSIVVW1"
Begin DoDot:1
+6 SET VALMSG="Select either ""AL"" , ""LL"" or ""AL,LL"" for both"
+7 SET PSJORD=ON
DO EN^PSJLIPRF
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 IF PSIVBR="D ^PSIVOPT"
IF '($$LS^PSSLOCK(PSGP,ON))
QUIT
+10 XECUTE PSIVBR
+11 if PSIVBR="D ^PSIVOPT"
DO UNL^PSSLOCK(PSGP,ON)
End DoDot:1
+12 if '$DATA(DUOUT)&($GET(Y)'=-1)
KILL DONE
+13 QUIT
+14 ;
+15 ;
ENU ;Get IV additive strength. Called from templates.
+1 NEW Y
SET Y=+^PS(55,DA(2),"IV",DA(1),"AD",DA,0)
SET PSIVSTR=$$ENU^PSIVUTL(Y)
+2 QUIT
Q ;
+1 KILL ^TMP($JOB,"PSJPRE")
+2 KILL ^TMP("PSIV",$JOB),^TMP("PSJ",$JOB),^TMP("PSJPRO",$JOB),^TMP("PSJALL",$JOB),^TMP("PSJI",$JOB),^TMP("PSJON",$JOB)
+3 KILL DRG,DRGI,DRGN,DRGT,ERR,I,JJ,MI,N,N2,ON,ON55,P,P1,P3,P16,P17,PNOW,PS,PSGODD,PSGODDD,PSIV,PSIVAAT,PSIVACT,PSIVADM,PSIVAT
+4 KILL PSIVC,PSIVDT,PSIVFLAG,PSIVLN,PSIVNOW,PSIVNU,PSIVON,PSIVOV1,PSIVOV2,PSIVREA,PSIVSTR,PSIVSTRT,PSIVNOL,PSIVTYPE,PSJNKF
+5 KILL PSJORF,PSJORIFN,RDWARD,START,STOP,SCHED,USER,V,XT,DUOUT,DTOUT
+6 KILL %,%I,DIC,PSIVC,PSIVNU,PSIVON,PSIVREA,PSIVOV1,PSIVOV2,RDWARD,V,VAERR,VW,X,X2,Y,Y1,Z,Z1,Z2
+7 QUIT
