source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJLIACT.m@ 724

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

revised back to 6/30/08 version

File size: 5.9 KB
Line 
1PSJLIACT ;BIR/MV-IV ACTION ;28 Jul 98 / 8:50 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**15,47,62,58,82,97,80,110,111**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA 2191.
5 ; Reference to MAIN^TIUEDIT is supported by DBIA 2410.
6 ;
7DC ; Discontinue order
8 D HOLDHDR^PSJOE
9 S PSJCOM=+$S(PSJORD["V":$P($G(^PS(55,DFN,"IV",+PSJORD,.2)),"^",8),1:$P($G(^PS(53.1,+PSJORD,.2)),"^",8))
10 I PSJCOM W !!,"This order is part of a complex order. If you discontinue this order the",!,"following orders will be discontinued too (unless the stop date has already",!,"been reached)." D CMPLX^PSJCOM1(PSGP,PSJCOM,PSJORD)
11 I PSJCOM F W !!,"Do you want to discontinue this order" S %=1 D YN^DICN Q:% D ENCOM^PSGOEM
12 I PSJCOM,%'=1 S VALMBK="" Q
13 I PSJORD["V" D DC^PSIVORA,EN^PSJLIORD(DFN,ON) Q
14 D:PSJORD["P" DISCONT^PSIVORC
15 S VALMBCK="Q"
16 Q
17ACEDIT ; Display LM screen and AC and EDit actions
18 ;K PSIVFN1 ; if not set display the second screen when finish.
19 D EN^PSJLIVMD
20 S VALMBCK=$S($G(PSIVACEP):"Q",1:"R")
21 Q
22AEEXIT ; Call for EXIT CODE in PSJ LM IV AC/EDIT
23 D:ON["V" GT55^PSIVORFB
24 I ON["P" D GT531^PSIVORFA(DFN,ON) D:P("OT")'="I" GTDATA^PSJLIFN
25 D EN^PSJLIVMD
26 K PSIVENO
27 Q
28EDIT ; Edit order
29 K PSIVFN1 NEW PSIVNBD
30 I $D(PSGACT),PSGACT'["E" W !,"This order may not be edited." D PAUSE^VALM1 Q
31 D EDIT1
32 ;Q:$D(PSIVNBD)
33 Q:$D(PSIVNBD)!($G(PSIVCOPY)&'$G(PSIVENO))
34 D EN^PSJLIVMD
35 S VALMBCK=$S($G(PSIVFN1):"Q",1:"R")
36 Q
37EDIT1 ;
38 ;Ensure P() is defined
39 I $D(P)<10 S XQORQUIT=1,P("PON")="",PSIVNBD=1 D Q
40 .W !,"WARNING: An error has occurred. Changes will not be saved"
41 .D PAUSE^VALM1
42 .S VALMBCK="Q"
43 I "ANP"'[P(17) W !,"You cannot edit an inactive order" D PAUSE^VALM1 Q
44 S:$G(ON55)="" ON55=$G(PSJORD)
45 D HOLDHDR^PSJOE
46 ;* Edit a new back door order
47 ;;I ($G(ON55)["V"&($G(P(21))="")) D Q
48 I ($G(ON55)["V"&($G(P("21FLG"))="")) D Q
49 . D GSTRING^PSIVORE1,GTFLDS^PSIVORFE
50 . I $G(ON55)["V",'$G(DONE) D OK^PSIVORE
51 . S VALMBCK="Q",PSIVNBD=1
52 ;* Edit an active order
53 I $G(ON55)["V" NEW PSJEDIT1 D E^PSIVOPT1 D Q
54 . I $G(PSJIVBD) K PSJIVBD D EN^PSJLIORD(DFN,ON)
55 I $G(ON55)["P" D EDIT^PSIVORC ;Edit incomplete order.
56 Q
57ACCEPT ; Accept order
58 D HOLDHDR^PSJOE
59 ;Accept IV from back door.
60 I $G(PSJIVBD) K PSJIVBD D OK^PSIVORE S VALMBCK="Q" Q
61 I ON["V" D ACCEPT^PSIVOPT1 Q
62 S PSIVFN1=1
63 D COMPLTE^PSIVORC1
64 S VALMBCK="Q"
65 Q
66R ; Renewal
67 S PSJREN=1
68 D HOLDHDR^PSJOE
69 NEW PSIVAC S PSIVAC="PR" K PSGFDX
70 D R^PSIVOPT
71 D EN^PSJLIORD(DFN,ON)
72 K PSJREN
73 Q
74H ; Hold
75 NEW TEX S TEX="Active order ***"
76 D HOLDHDR^PSJOE
77 D H^PSIVOPT(DFN,ON,P(17),P(3))
78 D:P(17)="A" PAUSE^VALM1
79 D EN^PSJLIORD(DFN,ON)
80 Q
81L ; Activity Log
82 NEW PSIVLAB,PSIVLOG,PSJHIS S (PSIVLAB,PSIVLOG)=1
83 D EN^PSIVVW1
84 D EN^PSJLIVMD
85 S VALMBCK="R"
86 Q
87O ; On Call
88 NEW TEX S TEX="Active order ***"
89 D HOLDHDR^PSJOE
90 D O^PSIVOPT(DFN,ON,P(17),P(3))
91 D:P(17)="A" PAUSE^VALM1
92 D EN^PSJLIORD(DFN,ON)
93 Q
94VF ; Make the order active
95 NEW PSIVCHG S PSIVCHG=0
96 I ON["V" S ON55=ON D VF1("V","ORDER VERIFIED BY ",1) Q
97 D ACTIVE^PSIVORC2
98 Q
99VF1(PSIVREA,PSIVAL,PSIVLOG) ;
100 ;Update 4 node and set activity log.
101 ;PSIVREA: the reason use by LOG^PSIVORAL
102 ;PSIVAL : the description reason
103 ;PSIVLOG: Log an activity if = 1
104 I '+$G(OD)!($L($G(OD))>16) K OD
105 D:+PSJSYSU=3 ^PSIVORE1
106 NEW DIE,DA,DR,PSJX,XX,PSIVACT,PSJRQND
107 S PSIVACT=1
108 S PSJX=$G(^PS(55,DFN,"IV",+ON55,4)),XX=""
109 I $P(PSJX,U)="" S XX=";143////0"
110 I $P(PSJX,U,4)="" S XX=XX_U_";142////0"
111 D NOW^%DTC
112 S DIE="^PS(55,"_DFN_",""IV"",",DA=+ON55,DA(1)=DFN
113 I +PSJSYSU=3 S DR="140////"_DUZ_";141////"_$E(%,1,12)_";142////1"_$P(XX,U)
114 I +PSJSYSU=1 S DR="16////"_DUZ_";17////"_$E(%,1,12)_";143////1"_$P(XX,U,2)
115 I $G(P("PRY"))="D" S DR=DR_";.22////"_+P("IVRM")
116 D ^DIE
117 ; If pending IV renew is edited during finish, go back and DE the original active order left in RENEWED status
118 S PREREN=$S(ON55["V":$G(@(DIE_"+ON55,2)")),1:""),PREREN=$P(PREREN,"^",5) I PREREN D K PREREN
119 . I PREREN["P" S PREREN=$G(@("^PS(53.1,+PREREN,0)")),PREREN=$P(PREREN,"^",25)
120 . I PREREN["V" N PRERENOD S PRERENOD=$G(@("^PS(55,DFN,""IV"",+PREREN,0)")) I $P(PRERENOD,"^",17)="R",($G(P("RES"))="E") D
121 .. S DIE="^PS(55,"_DFN_",""IV"",",DA=+PREREN,DA(1)=DFN
122 .. S DR="100////D;.03////"_PSGDT S ORIGSTOP=$P($G(@("^PS(55,DFN,""IV"",+PREREN,2)")),"^",3) I ORIGSTOP S DR=DR_";116////"_ORIGSTOP
123 .. D ^DIE D EN1^PSJHL2(DFN,"SC",PREREN)
124 K DR,DIE,DA
125 ;I ((+PSJSYSU=3)&($G(PSJPRI)="D"))!((+PSJSYSU=3)&($G(P("PRY"))="D")) D
126 I (+PSJSYSU=3)&($G(P("PRY"))="D") D
127 .N DIR W ! S DIR(0)="S^Y:Yes;N:No",DIR("A")="Do you want to enter a Progress Note",DIR("B")="No" D ^DIR
128 .Q:Y="N"
129 .D MAIN^TIUEDIT(3,.TIUDA,DFN,"","","","",1)
130 Q:'$G(PSIVLOG)
131 I $G(P("PACT"))]"",+$P(P("PACT"),U,2),+$P(P("PACT"),U,3) D
132 . NEW DIC,DA,X,Y,XX,DO D NAME^PSJBCMA1($P(P("PACT"),U,2),.XX)
133 . S DIC(0)="L",DA(1)=DFN,DA(2)=+ON55,X=1
134 . S DIC="^PS(55,"_DA(1)_",""IV"","_DA(2)_",""A"","
135 . S DIC("DR")=".02////F;.03////"_XX_";.04////"_$P($G(^PS(53.3,+$P(P("PACT"),U,3),0)),U)_";.05////"_$P(P("PACT"),U)_";.06////"_$P(P("PACT"),U,2)
136 . D FILE^DICN
137 NEW PSIVALCK
138 S PSIVREA="V",PSIVALT=""
139 S PSIVAL=PSIVAL_$S(+PSJSYSU=3:"PHARMACIST",1:"NURSE")
140 D LOG^PSIVORAL K PSIVAL,PSIVREA,PSIVLN
141 I $G(PSJORD)["P" S PSIVREA="V",PSIVALT="",PSGRDTX=$G(^PS(53.1,+PSJORD,2.5)) D
142 . I $G(PSGRDTX) S PSIVAL="Requested Start Date: "_$$ENDTC^PSGMI($$DATE2^PSJUTL2($P(PSGRDTX,U))) D LOG^PSIVORAL
143 . I $P(PSGRDTX,U,3) S PSIVREA="V",PSIVALT="" S PSIVAL="Requested Stop Date: "_$$ENDTC^PSGMI($$DATE2^PSJUTL2($P(PSGRDTX,U,3))) D LOG^PSIVORAL
144 N DUR I $G(PSJORD) S DUR=$$GETDUR^PSJLIVMD(DFN,+PSJORD,$S(PSJORD["P":"P",1:"IV"),1) I DUR]"" D
145 . K DR S DIE="^PS(55,"_DFN_",""IV"",",DA=+ON55,DA(1)=DFN
146 . S DR=$S($G(IVLIMIT):"152////"_DUR,1:"151////"_DUR) K IVLIMIT
147 . D ^DIE
148 D EN1^PSJHL2(DFN,"SC",ON55)
149 D:+PSJSYSU=1 EN1^PSJHL2(DFN,"ZV",ON55)
150 D GT55^PSIVORFB S OLDON=$P($G(^PS(55,DFN,"IV",+ON55,2)),"^",5),P("OLDON")=OLDON
151 N PSJPRIO,PSJSCH,NODE0,NODEP2 S NODE0=$G(^PS(55,DFN,"IV",+ON55,0)),NODEP2=$G(^PS(55,DFN,"IV",+ON55,.2))
152 S PSJPRIO=$P(NODEP2,"^",4),PSJSCH=$P(NODE0,"^",9)
153 I (",S,A,")[(","_$G(PSJPRIO)_",")!($G(PSJSCH)="NOW")!($G(PSJSCH)["STAT") D NOTIFY^PSJHL4(ON55,DFN,$G(PSJPRIO),$G(PSJSCH))
154 Q
Note: See TracBrowser for help on using the repository browser.