source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIV.m@ 811

Last change on this file since 811 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.8 KB
Line 
1PSIV ;BIR/PR,MLM-MISC UTILITIES ;19 Mar 99 / 9:45 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**7,16,29,38,53,56,72,58,110**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA 2191
5 ; Reference to ^PSSLOCK is supported by DBIA 2789
6 ; Reference to ^%DTC is supported by DBIA 10000
7 ; Reference to ^DIC is supported by DBIA 10006
8 ; Reference to ^DIE is supported by DBIA 10018
9 ; Reference to ^DIR is supported by DBIA 10026
10 ; Reference to ^VALM is supported by DBIA 10118
11 ; Reference to ^VALM1 is supported by DBIA 10116
12 ; Reference to ^PS(51.1 is supported by DBIA 2177
13 ;
14ENGETP ;Enter here to select patient.
15 K DIC S DIC("W")="W "" "",$P(^(0),""^"",9) W:$D(^(.1)) "" "",^(.1)",DIC="^DPT(",DIC(0)="QEM"
16 D FULL^VALM1
17GETP1 ;
18 S PSGPTMP=0,PPAGE=1,DFN=-1,X="Select PATIENT:^^^^1" D ENQ Q:"^"[X
19 D EN^PSJDPT
20 I Y<0 G ENGETP
21 N PSGP,PSJACNWP S (PSGP,DFN)=+Y D ENBOTH^PSJAC S PSJORL=$$ENORL^PSJUTL($G(VAIN(4)))
22 Q
23 ;
24ENYN ;Enter here for yes/no responses. This is a general reader that I have
25 ;been phasing out with ^DICN
26 S X=X_"^Y:YES;N:NO^YES,NO"
27 ;
28ENQ ;Enter here to read X. This is the general reader that I have
29 ;been slowly phasing out
30 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
31 I $L(QUX)>500 W " ??" G ENQ
32 S:QUX?1L QUX=$C($A(QUX)-32)
33 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
34VAR 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
35PAT I $P(X,"^",5)]"",@$P(X,"^",5,999) G KILL
36 W $C(7)," ???" G ENQ
37KILL S X=QUX K QUX,QUX1,QUD Q
38 ;
39ENADM ;Edit administration schedules.
40 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
41 ;
42ENOW D NOW^%DTC S Y=% K %,%H,%I
43 Q
44 ;
45ENC ;Get unit of measure for drug seleted.
46 S X=$P($P(";"_$P(Y,U,3),";"_X_":",2),";")
47 Q
48 ;
49ENCHS ;Needs PSIVBR (Branch point)
50 D ENGETP G:DFN<0 Q
51 ;* Lock patient if calling FROM PSJI DELETE ORDER.
52 ;* I PSIVBR="D ENT^PSIVPGE" S X=DFN_";DPT(" D LK^ORX2 Q:'Y
53 I PSIVBR="D ENT^PSIVPGE",('$$L^PSSLOCK(DFN,1)) Q
54OE N CONT S CONT=0
55 F Q:CONT D ENCHS1
56 Q:$D(ORVP)
57 G ENCHS
58ENCHS1 ;
59 S PSJORQF=0,CONT=0
60 S PSJPROT=2,PSJOL="",(PSGOP,PSGP)=DFN
61 K PSJLMPRO D EN^VALM("PSJ LM BRIEF PATIENT INFO")
62 S VALMCNT=30
63 I PSIVBR="D PROCESS^PSIVRD",(PSJOL="N") D ORDNO^PSIVRD Q
64 I $G(PSJNEWOE) S PSJOL="S"
65 I PSJOL="S"!(PSJOL="L") F Q:CONT S P("PT")=PSJOL D
66 . S PSJORQF=0,PSJNEWOE=0
67 . D ENNB^PSIVACT
68 . 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
69 . NEW PSJIVPRF S PSJIVPRF=1
70 . S PSJOL=$S(",S,L,"[(","_$G(PSJOL)_","):PSJOL,1:"S")
71 . D EN^VALM("PSJ LM IV OE")
72 . I $G(VALMBCK)="Q" Q
73 . S CONT=1
74 ;* Unlock patient if come from PSJI DELETE ORDER
75 ;* I PSIVBR="D ENT^PSIVPGE" S X=DFN_";DPT(" D ULK^ORX2
76 I '$G(PSJORQF) S CONT=1
77 I PSIVBR="D ENT^PSIVPGE" D UL^PSSLOCK(DFN)
78 K PSJLMPRO
79 Q
80SELSO ;SELECT ORDER USING "SO" OPTION
81 S PSGLMT=^TMP("PSJPRO",$J,0) D ENASR^PSGON,OV
82 Q
83SELNUM ;SELECT ORDERS WITH NUMBERS
84 S PSGLMT=^TMP("PSJPRO",$J,0),X=$P(XQORNOD(0),"=",2) D ENCHK^PSGON,OV
85 Q
86OV ;
87 I '$D(PSGODDD) S VALMBCK="R" Q
88 N DONE
89 F PSIVOV1=1:1:PSGODDD F PSIVOV2=1:1:$L(PSGODDD(PSIVOV1),",")-1 D
90 .;;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
91 .S ON=+$P(PSGODDD(PSIVOV1),",",PSIVOV2)
92 .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:"")
93 .Q:'ON!$G(DONE)
94 .D OV1
95 S VALMBCK="Q"
96 Q
97OV1 ;
98 S (ON,ON55,P("PON"))=9999999999-ON_$S(ON["V":"V",1:"P")
99 I PSIVBR["D ^PSIVVW1" D
100 . S VALMSG="Select either ""AL"" , ""LL"" or ""AL,LL"" for both"
101 . S PSJORD=ON D EN^PSJLIPRF
102 E D
103 . I PSIVBR="D ^PSIVOPT",'($$LS^PSSLOCK(PSGP,ON)) Q
104 . X PSIVBR
105 . D:PSIVBR="D ^PSIVOPT" UNL^PSSLOCK(PSGP,ON)
106 ;K:'$D(DUOUT) DONE
107 K:'$D(DUOUT)&($G(Y)'=-1) DONE
108 Q
109 ;
110 ;
111ENU ;Get IV additive strength. Called from templates.
112 N Y S Y=+^PS(55,DA(2),"IV",DA(1),"AD",DA,0),PSIVSTR=$$ENU^PSIVUTL(Y)
113 Q
114Q ;
115 K ^TMP("PSIV",$J),^TMP("PSJ",$J),^TMP("PSJPRO",$J),^TMP("PSJALL",$J),^TMP("PSJI",$J),^TMP("PSJON",$J)
116 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
117 K PSIVC,PSIVDT,PSIVFLAG,PSIVLN,PSIVNOW,PSIVNU,PSIVON,PSIVOV1,PSIVOV2,PSIVREA,PSIVSTR,PSIVSTRT,PSIVNOL,PSIVTYPE,PSJNKF
118 K PSJORF,PSJORIFN,RDWARD,START,STOP,SCHED,USER,V,XT
119 K %,%I,DIC,PSIVC,PSIVNU,PSIVON,PSIVREA,PSIVOV1,PSIVOV2,RDWARD,V,VAERR,VW,X,X2,Y,Y1,Z,Z1,Z2
120 ;D KVAR^VADPT ;ENKV^PSGSETU
121 Q
Note: See TracBrowser for help on using the repository browser.