PSIV ;BIR/PR,MLM-MISC UTILITIES ;29-May-2012 14:32;PLS
;;5.0; INPATIENT MEDICATIONS ;**7,16,29,38,53,56,72,58,1011,110,1015**;16 DEC 97;Build 62
;
; 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
; Reference to ^PS(51.1 is supported by DBIA 2177
;
; Modified - IHS/MSC/PLS - 03/28/2011 - Line ENCHS1+3
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 ;
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 Q
;
ENADM ;Edit administration schedules.
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 seleted.
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" S X=DFN_";DPT(" D LK^ORX2 Q:'Y
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 ;
S PSJORQF=0,CONT=0
S PSJPROT=2,PSJOL="",(PSGOP,PSGP)=DFN
D SETPTCX^APSPFUNC(DFN) ;IHS/MSC/PLS - 03/28/11
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 PSIVBR="D ENT^PSIVPGE" S X=DFN_";DPT(" D ULK^ORX2
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),ON=$S($D(^TMP("PSIV",$J,"AB",ON)):^(ON),$D(^TMP("PSIV",$J,"PB",ON)):^(ON),$D(^TMP("PSIV",$J,"XB",ON)):^(ON),1:"") Q:'ON!$G(DONE) D OV1
.S ON=+$P(PSGODDD(PSIVOV1),",",PSIVOV2)
.S ON=$S($D(^TMP("PSIV",$J,"AB",ON)):^(ON),$D(^TMP("PSIV",$J,"NB",ON)):^(ON),$D(^TMP("PSIV",$J,"PB",ON)):^(ON),$D(^TMP("PSIV",$J,"XB",ON)):^(ON),$D(^TMP("PSIV",$J,"NDB",ON)):^(ON),$D(^TMP("PSIV",$J,"PDB",ON)):^(ON),1:"")
.Q:'ON!$G(DONE)
.D OV1
S VALMBCK="Q"
Q
OV1 ;
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) DONE
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("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
K %,%I,DIC,PSIVC,PSIVNU,PSIVON,PSIVREA,PSIVOV1,PSIVOV2,RDWARD,V,VAERR,VW,X,X2,Y,Y1,Z,Z1,Z2
;D KVAR^VADPT ;ENKV^PSGSETU
Q
PSIV ;BIR/PR,MLM-MISC UTILITIES ;29-May-2012 14:32;PLS
+1 ;;5.0; INPATIENT MEDICATIONS ;**7,16,29,38,53,56,72,58,1011,110,1015**;16 DEC 97;Build 62
+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 ; Reference to ^PS(51.1 is supported by DBIA 2177
+12 ;
+13 ; Modified - IHS/MSC/PLS - 03/28/2011 - Line ENCHS1+3
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 SET PSGPTMP=0
SET PPAGE=1
SET DFN=-1
SET X="Select PATIENT:^^^^1"
DO ENQ
IF "^"[X
QUIT
+2 DO EN^PSJDPT
+3 IF Y<0
GOTO ENGETP
+4 NEW PSGP,PSJACNWP
SET (PSGP,DFN)=+Y
DO ENBOTH^PSJAC
SET PSJORL=$$ENORL^PSJUTL($GET(VAIN(4)))
+5 QUIT
+6 ;
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
QUIT
+1 ;
ENADM ;Edit administration schedules.
+1 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
+2 ;
ENOW DO NOW^%DTC
SET Y=%
KILL %,%H,%I
+1 QUIT
+2 ;
ENC ;Get unit of measure for drug seleted.
+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 ;* I PSIVBR="D ENT^PSIVPGE" S X=DFN_";DPT(" D LK^ORX2 Q:'Y
+4 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 SET PSJORQF=0
SET CONT=0
+2 SET PSJPROT=2
SET PSJOL=""
SET (PSGOP,PSGP)=DFN
+3 ;IHS/MSC/PLS - 03/28/11
DO SETPTCX^APSPFUNC(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 ;* I PSIVBR="D ENT^PSIVPGE" S X=DFN_";DPT(" D ULK^ORX2
+19 IF '$GET(PSJORQF)
SET CONT=1
+20 IF PSIVBR="D ENT^PSIVPGE"
DO UL^PSSLOCK(DFN)
+21 KILL PSJLMPRO
+22 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 ;;S ON=+$P(PSGODDD(PSIVOV1),",",PSIVOV2),ON=$S($D(^TMP("PSIV",$J,"AB",ON)):^(ON),$D(^TMP("PSIV",$J,"PB",ON)):^(ON),$D(^TMP("PSIV",$J,"XB",ON)):^(ON),1:"") Q:'ON!$G(DONE) D OV1
+5 SET ON=+$PIECE(PSGODDD(PSIVOV1),",",PSIVOV2)
+6 SET ON=$SELECT($DATA(^TMP("PSIV",$JOB,"AB",ON)):^(ON),$DATA(^TMP("PSIV",$JOB,"NB",ON)):^(ON),$DATA(^TMP("PSIV",$JOB,"PB",ON)):^(ON),$DATA(^TMP("PSIV",$JOB,"XB",ON)):^(ON),$DATA(^TMP("PSIV",$JOB,"NDB",ON)):^(ON),...
... $DATA(^TMP("PSIV",$JOB,"PDB",ON)):^(ON),1:"")
+7 IF 'ON!$GET(DONE)
QUIT
+8 DO OV1
End DoDot:1
+9 SET VALMBCK="Q"
+10 QUIT
OV1 ;
+1 SET (ON,ON55,P("PON"))=9999999999-ON_$SELECT(ON["V":"V",1:"P")
+2 IF PSIVBR["D ^PSIVVW1"
Begin DoDot:1
+3 SET VALMSG="Select either ""AL"" , ""LL"" or ""AL,LL"" for both"
+4 SET PSJORD=ON
DO EN^PSJLIPRF
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 IF PSIVBR="D ^PSIVOPT"
IF '($$LS^PSSLOCK(PSGP,ON))
QUIT
+7 XECUTE PSIVBR
+8 IF PSIVBR="D ^PSIVOPT"
DO UNL^PSSLOCK(PSGP,ON)
End DoDot:1
+9 ;K:'$D(DUOUT) DONE
+10 IF '$DATA(DUOUT)&($GET(Y)'=-1)
KILL DONE
+11 QUIT
+12 ;
+13 ;
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("PSIV",$JOB),^TMP("PSJ",$JOB),^TMP("PSJPRO",$JOB),^TMP("PSJALL",$JOB),^TMP("PSJI",$JOB),^TMP("PSJON",$JOB)
+2 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
+3 KILL PSIVC,PSIVDT,PSIVFLAG,PSIVLN,PSIVNOW,PSIVNU,PSIVON,PSIVOV1,PSIVOV2,PSIVREA,PSIVSTR,PSIVSTRT,PSIVNOL,PSIVTYPE,PSJNKF
+4 KILL PSJORF,PSJORIFN,RDWARD,START,STOP,SCHED,USER,V,XT
+5 KILL %,%I,DIC,PSIVC,PSIVNU,PSIVON,PSIVREA,PSIVOV1,PSIVOV2,RDWARD,V,VAERR,VW,X,X2,Y,Y1,Z,Z1,Z2
+6 ;D KVAR^VADPT ;ENKV^PSGSETU
+7 QUIT
