source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJLIFN.m@ 1259

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

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1PSJLIFN ;BIR/MV-IV FINISH USING LM ;13 Jan 98 / 11:32 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**1,29,34,37,42,47,50,56,94,80,116,110**;16 DEC 97
3 ;
4 ; Reference to ^PS(51.2 is supported by DBIA #2178.
5 ; Reference to ^PS(52.6 supported by DBIA #1231.
6 ; Reference to ^PS(52.7 supported by DBIA #2173.
7 ; Reference to ^PSDRUG( is supported by DBIA #2192.
8 ; Reference to ^PSOORDRG is supported by DBIA #2190.
9 ; Reference to ^%DT is supported by DBIA #10003.
10 ; Reference to ^VALM is supported by DBIA #10118.
11 ; Reference to ^VALM1 is supported by DBIA #10116.
12 ; Reference to RE^VALM4 is supported by DBIA #10120.
13 ;
14EN ; Display order with numbers.
15 L +^PS(53.1,+PSJORD):1 I '$T W !,$C(7),$C(7),"This order is being edited by another user. Try later." D PAUSE^VALM1 Q
16 D PENDING K PSJREN
17 L -^PS(53.1,+PSJORD)
18 Q
19PENDING ; Process pending order.
20 ;* PSIVFN1 is use so it will dipslay the AC/Edit screen
21 ;* instead of go to the "IS this O.K." prompt
22 ;* PSIVACEP only when accept the order. Original screen won't redisp.
23 ;* PSJLMX is defined in WRTDRG^PSIVUTL and it was being call in PSJLIVMD & PSJLIVFD
24 ;* to count # of AD/SOL
25 NEW PSIVFN1,PSIVACEP,PSJLMX,PSIVOI
26 S PSIVAC="CF" S (P("PON"),ON)=+PSJORD_"P",DFN=PSGP
27 S PSIVUP=+$$GTPCI^PSIVUTL D GT531^PSIVORFA(DFN,ON)
28 D:'$D(P("OT")) GTOT^PSIVUTL(P(4))
29 NEW PSJL
30 N PSIVNUM,PSJSTAR S PSIVNUM=1
31 Q:ON'=PSJORD
32 I $G(PSJLYN)]"" Q:ON'=PSJLYN
33 S PSJMAI=ON
34 I P("OT")="I" D Q
35 . S PSJSTAR="(5)^(7)^(9)^(10)"
36 . D EN^VALM("PSJ LM IV INPT PENDING") ;; ^PSJLIVMD
37 S PSJSTAR="(1)^(2)^(3)^(5)^(7)^(9)"
38 D GTDATA D EN^VALM("PSJ LM IV PENDING") ;; ^PSJLIVFD
39 K PSJMAI Q
40 ;
41DISPLAY ;
42 S PSGACT=""
43 S VALMSG="Press Return to continue"
44 D:$E(P("OT"))="I" EN^VALM("PSJ LM IV INPT DISPLAY")
45 D:$E(P("OT"))'="I" EN^VALM("PSJ LM IV DISPLAY")
46 K PSJDISP
47 S:'$G(PSJHIS) VALMBCK=""
48 Q
49GTDATA ;
50 ;* D:P(4)="" 53^PSIVORC1 Q:P(4)="" S P("DTYP")=$S(P(4)="":0,P(4)="P"!(P(23)="P")!(P(5)):1,P(4)="H":2,1:3)
51 S P("DTYP")=$S(P(4)="":0,P(4)="P"!(P(23)="P")!(P(5)):1,P(4)="H":2,1:3)
52 I 'P(2) D
53 .I P("RES")="R" S PSJREN=1
54 .D ENT^PSIVCAL K %DT S X=P(2),%DT="RTX" D ^%DT S P(2)=+Y
55 I 'P(3) D ENSTOP^PSIVCAL K %DT S X=P(3),%DT="RTX" D ^%DT S P(3)=+Y
56 I 'P("MR") S P("MR")=$O(^PS(51.2,"B","INTRAVENOUS",0))_"^IV"
57 Q
58FINISH ; Prompt for missing data
59 ;* Ord chk for Inpat. pending only. Pend renew should not be checked.
60 ;* PSIVOCON needed so this order will be excluded from the order
61 ;* list(ORDCHK^PSJLMUT1)
62 ;* PSGORQF defined means cancel the order due to order check.
63 ;Q:'$$LS^PSSLOCK(DFN,PSJORD)
64 N PSJCOM S PSJCOM=+$P($G(^PS(53.1,+PSJORD,.2)),"^",8)
65 K PSJIVBD,PSGRDTX
66 N FIL,PSIVS,DRGOC,PSIVXD,DRGTMP,PSIVOCON,PSGORQF,ON55,NSFF S NSFF=1
67 S (ON,PSIVOCON,ON55,PSGORD)=PSJORD Q:PSJORD'=PSJMAI I $G(PSJLYN)]"" Q:PSJORD'=PSJLYN
68 D UDVARS^PSJLIORD
69 I $G(PSJPROT)=3,'$$ENIVUD^PSGOEF1(PSJORD) K NSFF Q
70 D HOLDHDR^PSJOE
71 ; force the display of the second screen if CPRS order checks exist
72 I $O(^PS(53.1,+PSJORD,12,0))!$O(^PS(53.1,+PSJORD,10,0)) D
73 .Q:$G(PSJLMX)=1 ;no second screen to display
74 .S VALMBG=16 D RE^VALM4,PAUSE^VALM1 S VALMBG=1
75 S P("OPI")=$$ENPC^PSJUTL("V",+PSIVUP,60,P("OPI"))
76 ;I $E(P("OT"))="I" D GTDATA Q:P(4)=""
77 ;I $E(P("OT"))="I",'$D(DRG("AD")),('$D(DRG("SOL"))) D
78 I $G(P("RES"))'="R" D 53^PSIVORC1
79 I $G(P(4))]"",$G(P(15))]"",$G(P(9))]"",$$SCHREQ^PSJLIVFD(.P) D
80 . N PSGS0XT,X,PSJNSS S PSJNSS=1,X=P(9),PSGS0XT=P(15) D Q2^PSGS0
81 I P(4)="" D RE^VALM4 Q
82 I $E(P("OT"))="I" D GTDATA D
83 . I '$D(DRG("AD")),('$D(DRG("SOL"))) S DNE=0 D GTIVDRG^PSIVORC2 S P(3)="" D ENSTOP^PSIVCAL
84 . D ORDCHK
85 S VALMBG=1
86 I $E(P("OT"))="F" S DNE=0 D ORDCHK I $G(PSGORQF) D RE^VALM4 Q
87 I $D(PSGORQF) S VALMBCK="R",P(4)="" K DRG Q
88 S PSIVOK="1^3^10^25^26^39^57^58^59^63^64" D CKFLDS^PSIVORC1 D:EDIT]"" EDIT^PSIVEDT
89 I $G(DONE) S VALMBCK="R" Q
90 D COMPLTE^PSIVORC1
91 S:$G(PSIVACEP) VALMBCK="Q"
92 I $G(PSGORQF) S VALMBG=1 D RE^VALM4
93 K NSFF
94 Q
95ORDCHK ;* Do order check for Inpatient Meds IV.
96 ; PSGORQF is defined (CONT^PSGSICHK) if not log an intervention
97 K PSGORQF
98 NEW DRGOC
99 D OCORD Q:$G(PSGORQF)
100 ;D GTIVDRG^PSIVORC2 S P(3)="" D ENSTOP^PSIVCAL
101ORDCHKA ;* Do order check agaist existing orders on the profile
102 F PSIVAS="AD","SOL" Q:$G(PSGORQF) S FIL=$S(PSIVAS="AD":52.6,1:52.7) D
103 . F PSIVX=0:0 S PSIVX=$O(DRG(PSIVAS,PSIVX)) Q:'PSIVX!($G(PSGORQF)) D
104 .. S DRGTMP=DRG(PSIVAS,PSIVX)
105 .. ;* Do only 1 duplicate warning when order has >1 of the same additive
106 .. Q:$D(PSJADTMP(+DRGTMP))
107 .. D ORDERCHK^PSIVEDRG(PSGP,ON,$D(DRGOC(ON)))
108 .. S DRGOC(ON,PSIVAS,PSIVX)=DRG(PSIVAS,PSIVX)
109 .. S PSJADTMP(+DRGTMP)=""
110 K PSJADTMP
111 Q
112OCORD ;* Do order check for each drug against the drugs within the order.
113 NEW X,Y,DDRUG,PSIVX,PSJAD,PSJSOL,TMPDRG
114 D SAVEDRG^PSIVEDRG(.TMPDRG,.DRG)
115 ; Find the corresponding DD for the additive within the order
116 F X=0:0 S X=$O(DRG("AD",X)) Q:'X D
117 . S DDRUG=$P($G(^PS(52.6,+DRG("AD",X),0)),U,2)
118 . S:+DDRUG (DDRUG(DDRUG),PSJAD(DDRUG))=$D(DDRUG(DDRUG))+1
119 ;
120 ; Find the corresponding DD for the solution
121 ;
122 F X=0:0 S X=$O(DRG("SOL",X)) Q:'X D
123 . S DDRUG=$P($G(^PS(52.7,+DRG("SOL",X),0)),U,2)
124 . S:+DDRUG (DDRUG(DDRUG),PSJSOL(DDRUG))=$D(DDRUG(DDRUG))+1
125 ;
126 ; Loop thru each additive to check for DD,DI & DC against the
127 ; order's dispense drugs
128 ;
129 NEW PSJDFN,INTERVEN S INTERVEN=""
130 S PSJDFN=DFN ;DFN will be killed when call ^PSOORDRG
131 F PSIVX=0:0 S PSIVX=$O(PSJAD(PSIVX)) Q:'PSIVX D
132 . K DDRUG(PSIVX) D DRGCHK^PSOORDRG(PSJDFN,PSIVX,.DDRUG)
133 . I PSJAD(PSIVX)>1 S ^TMP($J,"DD",1,0)=PSIVX_U_$P($G(^PSDRUG(PSIVX,0)),U)_"^^"_ON_";I"
134 . NEW TYPE F TYPE="DD","DI","DC" D ORDCHK^PSJLIFNI(PSJDFN,TYPE)
135 F PSIVX=0:0 S PSIVX=$O(PSJSOL(PSIVX)) Q:'PSIVX D
136 . K DDRUG(PSIVX) D DRGCHK^PSOORDRG(PSJDFN,PSIVX,.DDRUG)
137 . NEW TYPE F TYPE="DI" D ORDCHK^PSJLIFNI(PSJDFN,TYPE)
138 S DFN=PSJDFN
139 D SAVEDRG^PSIVEDRG(.DRG,.TMPDRG)
140 Q
Note: See TracBrowser for help on using the repository browser.