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

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

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