source: FOIAVistA/tag/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVORE.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1PSIVORE ;BIR/PR,MLM-ORDER ENTRY ;25 Nov 98 / 3:34 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**18,29,50,56,58,81,110,127,133,157**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA 2191
5 ; Reference to ^ORX2 is supported by DBIA #867
6 ; Reference to ^PSSLOCK is supported by DBIA #2789
7 ; Reference to ^DICN is supported by DBIA 10009.
8 ; Reference to ^DIR is supported by DBIA 10026.
9 ; Reference to EN^VALM is supported by DBIA 10118.
10 ; Reference to ^VADPT is supported by DBIA 10061.
11 ;
12 N PSJNEW,PSJOUT,PSGPTMP,PPAGE,FLAG S PSJNEW=1
13 ;
14 D SITE Q:'$G(PSIVQ) K PSIVQ S PSGOP=""
15 ;
16BEG ;Get patient and make sure he is living.
17 L +^PS(53.45,DUZ):1 E D LOCKERR^PSJOE G Q
18 ;* F K WSCHADM S PSGPTMP=0,PPAGE=1 D ENGETP^PSIV Q:DFN<0 D ASK
19 ;* F K WSCHADM S PSGPTMP=0,PPAGE=1 D ENGETP^PSIV Q:DFN<0 S X=DFN_";DPT(" D LK^ORX2 Q:'Y D ASK S X=DFN_";DPT(" D ULK^ORX2
20 NEW PSJLK
21 F K WSCHADM S PSGPTMP=0,PPAGE=1 D ENGETP^PSIV Q:DFN<0 S PSJLK='$$L^PSSLOCK(DFN,1) Q:PSJLK D ASK,UL^PSSLOCK(DFN)
22 I PSGOP,$P(PSJSYSL,"^",2)]"" D ENQL^PSGLW
23 G Q
24 ;
25ASK ;See if patient has been admitted.
26 I VADM(6) W !?5,"Patient has died." Q
27 I 'VAIN(4) K DIK S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="NO",DIR("??")="^S HELP=""ADMYN"" D ^PSIVHLP1" W !,"This patient has not been admitted." D ^DIR K DIR Q:'Y
28 S:VAIN(4) WSCHADM=+VAIN(4)
29 ;
30SETN ;Set up patient 0 node if needed.
31 I '$D(^PS(55,DFN,0)) K DO,DA,DD,DIC,PSIVFN S:$D(^(5.1)) PSIVFN=^(5.1) K:$D(PSIVFN) ^(5.1) S (DINUM,X)=DFN,DIC(0)="L",DIC="^PS(55," D FILE^DICN S:$D(PSIVFN) ^PS(55,DFN,5.1)=PSIVFN D K DIC,PSIVFN,DO,DA,DD,DINUM
32 .; Mark PSJ and PSO as converted
33 .S $P(^PS(55,DFN,5.1),"^",11)=2
34 S PSJNARC=1
35 S PSGP=DFN,PSJPWD=+VAIN(4),PSIVAC="P",PSIVBR="D ^PSIVOPT" D HK,ENCHS1^PSIV Q:'$D(DFN)
36 Q
37 ;
38NEW ;Ask to enter new order.
39 D:'$D(VADM(1)) DEM^VADPT
40 K P,PSIVCHG,PSIVTYPE,PSJOE,DIR S DIR(0)="Y",DIR("A")="New order for "_VADM(1),DIR("B")="YES",DIR("??")="^S HELP=""NEWORD"" D ^PSIVHLP" D ^DIR K DIR Q:'Y
41 NEW X S X=DFN_";DPT(" D LK^ORX2 Q:'Y S PSJLSORX=1
42INMED K ON55,PSJOUT S (P(4),P("OT"),P("FRES"))="" D NEW55^PSIVORFB I '$D(ON55) D ULK G:'$D(PSJOE)&('$D(PSJOUT)) NEW G Q
43 S P("RES")="N",PSIVAC="PN",P("PON")=ON55,PSIVUP=+$$GTPCI^PSIVUTL D NEW^PSIVORE2 I $G(P(2))="" D DEL55^PSIVORE2 D ULK G:'$D(PSJOE) NEW Q
44 D OK L -^PS(55,DFN,"IV",+ON55) D ULK G:'$D(PSJOE) NEW
45 ;
46Q ; Kill and exit.
47 L:'$D(PSJOE) -^PS(53.45,DUZ) S PSJNKF=1 D Q^PSIV
48 K FIL,I1,ND,PC,PDM,PSGDT,PSGID,PSGLMT,PSGSI,PSJNARC,PSIVAC,PSIVCHG,PSIVUP,PSIVX,PSJOPC
49 Q
50 ;
51ULK ;
52 Q:'$G(PSJLSORX) ;If NEW^PSIVORE did not lock, don't kill it here.
53 NEW X S X=DFN_";DPT(" D ULK^ORX2 K PSJLSORX
54 Q
55HK ;Queue job to print MAR labels generated for this patient.
56 I PSGOP,PSGOP'=DFN D
57 .N PSJACPF,PSJACNWP,PSJPWD,PSJSYSL,PSJSYSW,PSJSYSW0,DFN,VAIN,VAERR S DFN=PSGOP
58 .D INP^VADPT S PSJPWD=+VAIN(4) I PSJPWD S PSJACPF=10 S PSJACPF=10 D WP^PSJAC D:$P(PSJSYSL,U,2)]"" ENQL^PSGLW
59 S PSGOP=DFN
60 Q
61 ;
62SITE ;See if site parameters are ok.
63 K PSIVQ D ^PSIVXU Q:$D(XQUIT)
64 I '$D(PSIVSN)!('$D(PSIVSITE)) W $C(7),$C(7),!!,"You have no IV ROOM parameters ... PLEASE ... PLEASE ...",!,"Exit this package and reenter properly !!",!! Q
65 D ORPARM^PSIVOREN S PSIVQ=1
66 Q
67 ;
68OK ;Print example label, run order through checker, ask if it is ok.
69 S P16=0,PSIVEXAM=1,(PSIVNOL,PSIVCT)=1 D GTOT^PSIVUTL(P(4)) I $G(P("PD"))="" D GTPD^PSIVORE2
70 D ^PSIVCHK I $D(DUOUT) S X="^" G DOA
71 I ERR=1 S X="N" G BAD
72 W ! D ^PSIVORLB K PSIVEXAM S Y=P(2) W !,"Start date: " X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2),?30," Stop date: " S Y=P(3) X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2),!
73 ;PSJ*5*157 EFD for IVs
74 D EFDIV^PSJUTL($G(ZZND))
75 W:$G(PSIVCHG) !,"*** This change will cause a new order to be created. ***"
76 I '$G(PSIVCOPY) G:PSIVAC["R" OK1 S X="Is this O.K.: ^"_$S(ERR:"NO",1:"YES")_"^^NO"_$S(ERR'=1:",YES",1:"") D ENQ^PSIV
77 S PSJIVBD=1 ;var use to indicate order enter from back door
78BAD ;; I X["N" D GSTRING^PSIVORE1,^PSIVORV2,GTFLDS^PSIVORFE G OK
79 I ON55["V",($G(P(21))="") S P(17)="N"
80 I X["N" NEW PSGEBN,PSGLI S (P("INS"),PSGEBN,PSGLI)="",(PSJORD,ON)=ON55 D EN^VALM("PSJ LM IV AC/EDIT") S VALMBCK="Q" Q
81 I X["?" S HELP="OK" D ^PSIVHLP G OK
82DOA I X["^" D DEL55^PSIVORE2 Q
83 Q:$$NONVF("SN")
84OK1 S PSJORL=$$ENORL^PSJUTL($G(VAIN(4))),P(17)="A",ORSTS=6,ON=ON55,PSJORNP=+P(6)
85 D:'$D(PSJIVORF) ORPARM^PSIVOREN
86 I PSJIVORF D NATURE^PSIVOREN I '$D(P("NAT")) D DEL55^PSIVORE2 Q
87 D SET55^PSIVORFB
88 I PSJIVORF,($G(P(22))=.5) D CLINIC^PSIVOREN
89 I PSJIVORF D SET^PSIVORFE S ORNATR=P("NAT"),ON=+ON55,OD=P(2) D EN1^PSJHL2(DFN,"SN",+ON55_"V","SEND ORDER NUMBER") ;,EN1^PSJHL2(DFN,"SC",+ON55_"V","NEW ORDER CREATED")
90 D VF1^PSJLIACT("V","ORDER ENTERED AS ACTIVE BY ",1)
91 D ENLBL^PSIVOPT(2,DUZ,DFN,3,+ON55,"N")
92 ;
93CAL ;Calculate doses.
94 ;S OD=P(2) D EN,^PSIVORE1,^PSIVOPT
95 S OD=P(2) D EN,^PSIVOPT
96 Q
97 ;
98EN ;Update schedule interval P(15) only on continuous orders.
99 ;This includes Hyp/Adm/Continuous Syringes/Chemos =>P(5)=0
100 Q:'$D(DFN)!('$D(ON55)) Q:$P(^PS(55,DFN,"IV",+ON55,0),U,4)="P"!($P(^(0),U,5))!($P(^(0),U,23)="P")
101 D SPSOL S XXX=$P(^PS(55,DFN,"IV",+ON55,0),U,8) G:'SPSOL ENQ I XXX?1N.N.1"."1N.N1" ml/hr" S P(15)=$S('XXX:0,1:SPSOL\XXX*60+(SPSOL#XXX/XXX*60+.5)\1),$P(^PS(55,DFN,"IV",+ON55,0),U,15)=P(15) G ENQ
102 S P(15)=$S('$P(XXX,"@",2):0,1:1440/$P(XXX,"@",2)\1),$P(^PS(55,DFN,"IV",+ON55,0),U,15)=P(15)
103ENQ K SPSOL,XXX Q
104SPSOL S SPSOL=0 F XXX=0:0 S XXX=$O(^PS(55,DFN,"IV",+ON55,"SOL",XXX)) Q:'XXX S SPSOL=SPSOL+$P(^(XXX,0),U,2)
105 K XXX Q
106ENIN ;Entry for Combined IV/UD order entry. Called by PSJOE0.
107 D HOLDHDR^PSJOE
108 W !
109 N PSJOUT S (DONE,FLAG)=0,PSIVAC="PN"
110ENIN1 ;
111 N DA,DIR,PSJOE,PSJPCAF,PSJSYSL,WSCHADM S:$G(VAIN(4)) WSCHADM=VAIN(4)
112 K P,PSIVCHG,PSJCOM
113 S PSJOE=1,DIR(0)="55.01,.04O",DIR("A")="Select IV TYPE" D ^DIR
114 I X]"",X'="^",$P("^PROFILE",X)="" S PSJOEPF=X Q
115 S:$D(DTOUT) X="^" I "^"[X S PSJORQF=PSJORQF+$S(X="^":2,$G(FLAG):0,1:1),X="." Q
116 S FLAG=1,PSIVTYPE=Y,(P(5),P(23))="" I "SC"[Y D @(Y_"^PSIVORC1") S $P(PSIVTYPE,U,2)=P(23)
117 D INMED G:'$D(PSJOUT) ENIN S:$D(PSJOUT) PSJORQF=2
118 Q
119NONVF(PSJOC) ;If file at NonVF then quit with 1
120 NEW PSGOEAV S PSGOEAV=+$P(PSJSYSP0,U,9)
121 I +PSJSYSU=3,PSGOEAV Q 0
122 I +PSJSYSU=1,PSGOEAV Q 0
123 K DA D ENGNN^PSGOETO S ON=DA_"P",P(17)="N",P("REN")=0
124 D GTPD^PSIVORE2
125 D NATURE^PSIVOREN I '$D(P("NAT")) D:ON55["V" DEL55 Q 1
126 D:$G(VAIN(4))="" CLINIC^PSIVOREN
127 W !,"...transcribing this non-verified order...."
128 D PUT531^PSIVORFA
129 D:$G(PSJOC)]"" EN1^PSJHL2(DFN,PSJOC,ON,"SEND ORDER NUMBER")
130 D:ON55["V" DEL55
131 NEW PSJORD S (ON55,PSJORD)=ON
132 D VF^PSIVORC2
133 Q 1
134DEL55 ;
135 Q:ON55["P"
136 S X=$G(^PS(55,DFN,"IV",+ON55,0))
137 I $P(X,U,21)]"",($G(^PS(55,DFN,"IV",+ON55,2))]"") S $P(^(2),U,6)=ON,$P(^PS(53.1,+ON,0),U,25)=ON55 Q
138 NEW PSIVORFA S PSIVORFA=1
139 D DEL55^PSIVORE2
140 Q
Note: See TracBrowser for help on using the repository browser.