Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSIV

PSIV.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; Reference to ^PS(55 is supported by DBIA 2191
  1.  ; Reference to ^PSSLOCK is supported by DBIA 2789
  1.  ; Reference to ^%DTC is supported by DBIA 10000
  1.  ; Reference to ^DIC is supported by DBIA 10006
  1.  ; Reference to ^DIE is supported by DBIA 10018
  1.  ; Reference to ^DIR is supported by DBIA 10026
  1.  ; Reference to ^VALM is supported by DBIA 10118
  1.  ; Reference to ^VALM1 is supported by DBIA 10116
  1.  ; Reference to ^PS(51.1 is supported by DBIA 2177
  1.  ;
  1.  ; Modified - IHS/MSC/PLS - 03/28/2011 - Line ENCHS1+3
  1. ENGETP ;Enter here to select patient.
  1.  K DIC S DIC("W")="W ""  "",$P(^(0),""^"",9) W:$D(^(.1)) ""  "",^(.1)",DIC="^DPT(",DIC(0)="QEM"
  1.  D FULL^VALM1
  1. GETP1 ;
  1.  S PSGPTMP=0,PPAGE=1,DFN=-1,X="Select PATIENT:^^^^1" D ENQ Q:"^"[X
  1.  D EN^PSJDPT
  1.  I Y<0 G ENGETP
  1.  N PSGP,PSJACNWP S (PSGP,DFN)=+Y D ENBOTH^PSJAC S PSJORL=$$ENORL^PSJUTL($G(VAIN(4)))
  1.  Q
  1.  ;
  1. ENYN ;Enter here for yes/no responses. This is a general reader that I have
  1.  ;been phasing out with ^DICN
  1.  S X=X_"^Y:YES;N:NO^YES,NO"
  1.  ;
  1. ENQ ;Enter here to read X. This is the general reader that I have
  1.  ;been slowly phasing out
  1.  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
  1.  I $L(QUX)>500 W "    ??" G ENQ
  1.  S:QUX?1L QUX=$C($A(QUX)-32)
  1.  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
  1. 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
  1. PAT I $P(X,"^",5)]"",@$P(X,"^",5,999) G KILL
  1.  W $C(7)," ???" G ENQ
  1. KILL S X=QUX K QUX,QUX1,QUD Q
  1.  ;
  1. ENADM ;Edit administration schedules.
  1.  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
  1.  ;
  1. ENOW D NOW^%DTC S Y=% K %,%H,%I
  1.  Q
  1.  ;
  1. ENC ;Get unit of measure for drug seleted.
  1.  S X=$P($P(";"_$P(Y,U,3),";"_X_":",2),";")
  1.  Q
  1.  ;
  1. ENCHS ;Needs PSIVBR (Branch point)
  1.  D ENGETP G:DFN<0 Q
  1.  ;* Lock patient if calling FROM PSJI DELETE ORDER.
  1.  ;* I PSIVBR="D ENT^PSIVPGE" S X=DFN_";DPT(" D LK^ORX2 Q:'Y
  1.  I PSIVBR="D ENT^PSIVPGE",('$$L^PSSLOCK(DFN,1)) Q
  1. OE N CONT S CONT=0
  1.  F  Q:CONT  D ENCHS1
  1.  Q:$D(ORVP)
  1.  G ENCHS
  1. ENCHS1 ;
  1.  S PSJORQF=0,CONT=0
  1.  S PSJPROT=2,PSJOL="",(PSGOP,PSGP)=DFN
  1.  D SETPTCX^APSPFUNC(DFN)  ;IHS/MSC/PLS - 03/28/11
  1.  K PSJLMPRO D EN^VALM("PSJ LM BRIEF PATIENT INFO")
  1.  S VALMCNT=30
  1.  I PSIVBR="D PROCESS^PSIVRD",(PSJOL="N") D ORDNO^PSIVRD Q
  1.  I $G(PSJNEWOE) S PSJOL="S"
  1.  I PSJOL="S"!(PSJOL="L") F  Q:CONT  S P("PT")=PSJOL D
  1.  . S PSJORQF=0,PSJNEWOE=0
  1.  . D ENNB^PSIVACT
  1.  . 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
  1.  . NEW PSJIVPRF S PSJIVPRF=1
  1.  . S PSJOL=$S(",S,L,"[(","_$G(PSJOL)_","):PSJOL,1:"S")
  1.  . D EN^VALM("PSJ LM IV OE")
  1.  . I $G(VALMBCK)="Q" Q
  1.  . S CONT=1
  1.  ;* Unlock patient if come from PSJI DELETE ORDER
  1.  ;* I PSIVBR="D ENT^PSIVPGE" S X=DFN_";DPT(" D ULK^ORX2
  1.  I '$G(PSJORQF) S CONT=1
  1.  I PSIVBR="D ENT^PSIVPGE" D UL^PSSLOCK(DFN)
  1.  K PSJLMPRO
  1.  Q
  1. SELSO ;SELECT ORDER USING "SO" OPTION
  1.  S PSGLMT=^TMP("PSJPRO",$J,0) D ENASR^PSGON,OV
  1.  Q
  1. SELNUM ;SELECT ORDERS WITH NUMBERS
  1.  S PSGLMT=^TMP("PSJPRO",$J,0),X=$P(XQORNOD(0),"=",2) D ENCHK^PSGON,OV
  1.  Q
  1. OV ;
  1.  I '$D(PSGODDD) S VALMBCK="R" Q
  1.  N DONE
  1.  F PSIVOV1=1:1:PSGODDD F PSIVOV2=1:1:$L(PSGODDD(PSIVOV1),",")-1 D
  1.  .;;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
  1.  .S ON=+$P(PSGODDD(PSIVOV1),",",PSIVOV2)
  1.  .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:"")
  1.  .Q:'ON!$G(DONE)
  1.  .D OV1
  1.  S VALMBCK="Q"
  1.  Q
  1. OV1 ;
  1.  S (ON,ON55,P("PON"))=9999999999-ON_$S(ON["V":"V",1:"P")
  1.  I PSIVBR["D ^PSIVVW1" D
  1.  . S VALMSG="Select either ""AL"" , ""LL"" or ""AL,LL"" for both"
  1.  . S PSJORD=ON D EN^PSJLIPRF
  1.  E  D
  1.  . I PSIVBR="D ^PSIVOPT",'($$LS^PSSLOCK(PSGP,ON)) Q
  1.  . X PSIVBR
  1.  . D:PSIVBR="D ^PSIVOPT" UNL^PSSLOCK(PSGP,ON)
  1.  ;K:'$D(DUOUT) DONE
  1.  K:'$D(DUOUT)&($G(Y)'=-1) DONE
  1.  Q
  1.  ;
  1.  ;
  1. ENU ;Get IV additive strength. Called from templates.
  1.  N Y S Y=+^PS(55,DA(2),"IV",DA(1),"AD",DA,0),PSIVSTR=$$ENU^PSIVUTL(Y)
  1.  Q
  1. Q ;
  1.  K ^TMP("PSIV",$J),^TMP("PSJ",$J),^TMP("PSJPRO",$J),^TMP("PSJALL",$J),^TMP("PSJI",$J),^TMP("PSJON",$J)
  1.  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
  1.  K PSIVC,PSIVDT,PSIVFLAG,PSIVLN,PSIVNOW,PSIVNU,PSIVON,PSIVOV1,PSIVOV2,PSIVREA,PSIVSTR,PSIVSTRT,PSIVNOL,PSIVTYPE,PSJNKF
  1.  K PSJORF,PSJORIFN,RDWARD,START,STOP,SCHED,USER,V,XT
  1.  K %,%I,DIC,PSIVC,PSIVNU,PSIVON,PSIVREA,PSIVOV1,PSIVOV2,RDWARD,V,VAERR,VW,X,X2,Y,Y1,Z,Z1,Z2
  1.  ;D KVAR^VADPT ;ENKV^PSGSETU
  1.  Q