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

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

initial load of FOIAVistA 6/30/08 version
File size: 9.1 KB
Line 
1PSGOEV ;BIR/CML3-VERIFY (MAKE ACTIVE) ORDERS ;4/8/99 08:16
2 ;;5.0; INPATIENT MEDICATIONS ;**5,7,15,28,33,50,64,58,77,78,80,110,111,133,171**;16 DEC 97
3 ;
4 ; Reference to ^ORD(101 supported by DBIA #872.
5 ; Reference to ^PS(50.7 supported by DBIA #2180.
6 ; Reference to ^PS(55 supported by DBIA #2191.
7 ; Reference to ^PSSLOCK supported by DBIA #2789.
8 ; Reference to MAIN^TIUEDIT is supported by DBIA #2410.
9 ;
10EN(PSGORD) ;
11ENSF ; This entry point is used by Speed finish only.
12 ; Send SN update to CPRS if auto-verify off and from Order Set entry
13 S:'$D(PSGOEAV) PSGOEAV=$P($G(PSJSYSP0),"^",9)&$G(PSJSYSU)
14 I $D(PSGOES),'PSGOEAV,PSGORD["P",$P($G(^PS(53.1,+PSGORD,0)),"^",21)']"" D ORSET^PSGOETO1
15 D FULL^VALM1 I 'PSJSYSU W $C(7),$C(7),!!," THIS FUNCTION NOT AVAILABLE TO WARD STAFF." Q
16 S CHK=0 I PSGORD["P" S X=$P($G(^PS(53.1,+PSGORD,0)),"^",19) I X,$D(^PS(55,PSGP,5,$P(^(0),"^",19))) S CHK=+PSGORD,PSGORD=X_"U" L -^PS(53.1,CHK) L +^PS(55,PSGP,5,+PSGORD):1 E W !!,"Another terminal is editing this order." G DONE
17 I +PSJSYSU=3 D DDCHK G:CHK DONE
18 I PSGORD["P" D CHK($G(^PS(53.1,+PSGORD,0)),$G(^(.2)),$G(^(2)))
19 I $G(PSGSCH)]"" D
20 .N X,Y,PSGS0Y,PSGS0XT,PSGOES S PSGOES=1 S X=PSGSCH D ENOS^PSGS0 I $G(X)="" S CHK=4
21 I $G(CHK) Q:$D(PSJSPEED) D EN^VALM("PSJU LM ACCEPT") G:'$G(PSJACEPT) DONE ;G VFY
22 I PSGORD["U" G:'$D(^PS(55,PSGP,5,+PSGORD,4)) VFY I +PSJSYSU=3,$P(^(4),"^",3) W $C(7),!!,"THIS ORDER HAS ALREADY BEEN VERIFIED BY A PHARMACIST." S PSGACT=$P(PSGACT,"V")_$P(PSGACT,"V",2) G DONE
23 I PSGORD["U" I +PSJSYSU=1,+^PS(55,PSGP,5,+PSGORD,4) W $C(7),!!,"THIS ORDER HAS ALREADY BEEN VERIFIED BY A NURSE." S PSGACT=$P(PSGACT,"V")_$P(PSGACT,"V",2) G DONE
24 ;
25VFY ; change status, move to 55, and change label record
26 I PSGORD["P" S PSJCOM=+$P($G(^PS(53.1,+PSGORD,.2)),"^",8) I PSJCOM D VFY^PSJCOM Q
27 NEW PSJDOSE,PSJDSFLG
28 D DOSECHK^PSJDOSE
29 I +$G(PSJDSFLG) D SETVAR^PSJDOSE W !!,PSJDOSE("WARN"),!,PSJDOSE("WARN1") I '$$CONT() W !,"...order was not verified..." D PAUSE^VALM1 D Q:'$G(PSJACEPT)
30 . S PSGOEEF(109)=1
31 . S PSJACEPT=0
32 . ;D EN^VALM("PSJU LM ACCEPT")
33 D DDCHK G:CHK DONE
34 I $G(PSGSCH)]"",((",P,R,")'[(","_PSGST_",")) D I CHK G DONE
35 .N SWD,SDW,XABB,X,QX S X=$G(PSGSCH) D DW^PSGS0 Q:($G(X)="") I $G(PSGS0XT)="" S PSGS0XT="D"
36 .I $G(PSGS0XT)="D",$G(PSGAT)="" S CHK=1 W !!,"This is a 'DAY OF WEEK' schedule and MUST have admin times.",! D PAUSE^VALM1
37 I $G(PSGSCH)]"" D I CHK G DONE
38 .N X,Y,PSGS0XT,PSGS0Y,PSGOES S PSGOES=2,X=PSGSCH D ENOS^PSGS0 I $G(X)="" S CHK=4
39 W !,"...a few moments, please..."
40 I PSGORD["P" D
41 . N PND0,PSGORDR,PSJPRIO,PSJSCHED S PND0=^PS(53.1,+PSGORD,0) I $P(PND0,U,24)="R" S PSGORDR=$P(PND0,U,25) D Q
42 .. N OEORD,OOEORD,FILE55,FILE55N0 S FILE55="^PS(55,"_DFN_$S($P(PND0,U,4)="U":",5,",1:",""IV"","),FILE55N0=FILE55_+PSGORDR_",0)"
43 .. S OEORD=$P(PND0,U,21) I PSGORDR S OOEORD=$P(@FILE55N0,"^",21) I OEORD'=OOEORD D EXPOE^PSGOER(DFN,PSGORD,+$$LASTREN^PSJLMPRI(DFN,PSGORD))
44 .. S PSGORDP=PSGORD,DIE="^PS(53.1,",DA=+PSGORD,DR="28////A;104////@" W "." D ^DIE
45 .. D START^PSGOTR(PSGORD,+PSGORDR) I OEORD D
46 ... K DA,DR,DIE S DA(1)=DFN,DA=+PSGORDR,DIE=FILE55,DR=$S(DIE["IV":110,1:66)_"////"_+OEORD D ^DIE S DIE=FILE55_+PSGORDR_",0)",$P(@DIE,U,21)=OEORD
47 ... D EN1^PSJHL2(DFN,"SC",PSGORDR),EN^PSGPEN(PSGORDR),UNL^PSSLOCK(PSGP,PSGORDR)
48 . S PSGORDP=PSGORD ;Used in ACTLOG to update activity log in 55
49 . D REQDT^PSJLIVMD(PSGORD)
50 . S DIE="^PS(53.1,",DA=+PSGORD,DR="28////A" W "." D ^DIE,^PSGOT
51 . S PSJPRIO=$S(PSGORD["P":$P($G(^PS(53.1,+PSGORD,.2)),"^",4),PSGORD["U":$P($G(^PS(55,DFN,5,+PSGORD,.2)),"^",4),1:$P($G(^PS(55,PSJHLDFN,"IV",+PSGORD,.2)),"^",4))
52 . S PSJSCHED=$S(PSGORD["P":$P($G(^PS(53.1,+PSGORD,2)),"^"),PSGORD["U":$P($G(^PS(55,DFN,5,+PSGORD,2)),"^"),1:$P($G(^PS(55,PSJHLDFN,"IV",+PSGORD,0)),"^",15))
53 . I (",S,A,")[(","_$G(PSJPRIO)_",")!($G(PSJSCHED)="NOW")!($G(PSJSCHED)["STAT") D NOTIFY^PSJHL4(PSGORD,DFN,$G(PSJPRIO),$G(PSJSCHED))
54 S DA=+PSGORD,DA(1)=PSGP,PSGAL("C")=PSJSYSU*10+22000 D ^PSGAL5 W "." S VND4=$G(^PS(55,PSGP,5,DA,4))
55 I $G(PSGRDTX) D NEWUDAL^PSGAL5(PSGP,PSGORD,6090,"Requested Start Date",+$G(PSGRDTX))
56 I $P($G(PSGRDTX),U,3) D NEWUDAL^PSGAL5(PSGP,PSGORD,6090,"Requested Stop Date",+$P($G(PSGRDTX),U,3))
57 N DUR,DURON S DURON=$S($G(PSGORD):$G(PSGORD),1:"") I DURON D
58 . S DUR=$S($P($G(PSGRDTX),U,2)]"":$P($G(PSGRDTX),U,2),1:$$GETDUR^PSJLIVMD(PSGP,+DURON,$S($G(DURON)["P":"P",1:5),1),1:"")
59 I $G(DUR)]"" S $P(^PS(55,PSGP,5,+PSGORD,2.5),"^",2)=DUR
60 D:$D(PSGORDP) ACTLOG(PSGORDP,PSGP,PSGORD)
61 K PSGRSD,PSGRFD,PSGALFN
62 NEW X S X=0 I $G(PSGONF),(+$G(PSGODDD(1))'<+$G(PSGONF)) S X=1
63 I +PSJSYSU=3,PSGORD'["O",$S(X:0,'$P(VND4,"^",9):1,1:$P(VND4,"^",15)) D EN^PSGPEN(+PSGORD)
64 S $P(VND4,"^",+PSJSYSU=1+9)=1 S:'$P(VND4,U,+PSJSYSU=3+9) $P(VND4,U,+PSJSYSU=3+9)=+$P(VND4,U,+PSJSYSU=3+9)
65 ;S $P(VND4,"^",+PSJSYSU=1+9)=1,$P(VND4,U,+PSJSYSU=3+9)=0
66 I PSJSYSL>1 S $P(^PS(55,PSGP,5,+PSGORD,7),U)=PSGDT S:$P(^(7),U,2)="" $P(^(7),U,2)="N"_$S($P(^PS(55,PSGP,5,+PSGORD,0),"^",24)="E":"E",1:"") S PSGTOL=2,PSGUOW=DUZ,PSGTOO=1,DA=+PSGORD D ENL^PSGVDS
67 S:$P(VND4,"^",15)&'$P(VND4,"^",16) $P(VND4,"^",15)="" S:$P(VND4,"^",18)&'$P(VND4,"^",19) $P(VND4,"^",18)="" S:$P(VND4,"^",22)&'$P(VND4,"^",23) $P(VND4,"^",22)="" S $P(VND4,"^",PSJSYSU,PSJSYSU+1)=DUZ_"^"_PSGDT,^PS(55,PSGP,5,+PSGORD,4)=VND4
68 I '$P(VND4,U,9) S ^PS(55,"APV",PSGP,+PSGORD)=""
69 I '$P(VND4,U,10) S ^PS(55,"ANV",PSGP,+PSGORD)=""
70 I $P(VND4,U,9) K ^PS(55,"APV",PSGP,+PSGORD)
71 I $P(VND4,U,10) K ^PS(55,"ANV",PSGP,+PSGORD)
72 W:'$D(PSJSPEED) ! W !,"ORDER VERIFIED.",!
73 I '$D(PSJSPEED) K DIR S DIR(0)="E" D ^DIR K DIR
74 S:+PSJSYSU=3 ^PS(55,"AUE",PSGP,+PSGORD)="" S PSGACT="C"_$S('$D(^PS(55,PSGP,5,+PSGORD,4)):"E",$P(^(4),"^",16):"",1:"E")_"RS",PSGCANFL=2
75 S VALMBCK="Q" D EN1^PSJHL2(PSGP,$S(+PSJSYSU=3:"SC",+PSJSYSU=1:"SC",1:"XX"),+PSGORD_"U") ; allow status change to be sent for pharmacists & nurses
76 D:+PSJSYSU=1 EN1^PSJHL2(PSGP,"ZV",+PSGORD_"U")
77DONE ;
78 W:CHK !!,"...order NOT verified..."
79 I '$D(PSJSPEED),'CHK,+PSJSYSU=3,$G(PSJPRI)="D" D
80 .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
81 .Q:Y="N"
82 .D MAIN^TIUEDIT(3,.TIUDA,PSGP,"","","","",1)
83 S VALMBCK="Q" K CHK,DA,DIE,F,DP,DR,ND,PSGAL,PSGODA,PSJDOSE,PSJVAR,VND4,X Q
84 ;
85LBL ;
86 Q
87 ;
88CHK(ND,DRG,ND2) ; checks for data in required fields
89 ; Input: ND - ^(PS(53.1,PSGORD,0)
90 ; DRG - ^(.2)
91 ; ND2 - ^(2)
92 S CHK="" I DRG,$D(^PS(50.7,+DRG,0))
93 E S CHK=1
94 I ND="" S CHK=CHK_23
95 E S CHK=CHK_$S($P(ND,"^",3):"",1:2)_$S($P(ND,"^",7)]"":"",1:3)
96 ;The naked reference on the line below refers to the variable ND which is ^PS(53.1,PSGORD,0).
97 I ND2="" S CHK=CHK_$S('$D(^(0)):4,$P(^(0),"^",7)="OC":"",1:4)_56
98 E S CHK=CHK_$S($P(ND2,"^")]"":"",ND="":4,$P(ND,"^",7)="OC":"",1:4)_$S($P(ND2,"^",2):"",1:5)_$S($P(ND2,"^",4):"",1:6)
99 I $$CHECK^PSGOE8(PSJSYSP),$P(DRG,U,2)="" S CHK=CHK_8
100 K PSGDFLG,PSGPFLG S PSGDI=0
101 S:'$$DDOK^PSGOE2("^PS(53.45,"_PSJSYSP_",2,",+DRG) CHK=CHK_7,(PSGDFLG,PSGDI)=1
102 S:'$$OIOK^PSGOE2(+DRG) PSGPFLG=1
103 I 'CHK,$G(PSGSCH)]"" D
104 .N X,Y,PSGS0Y,PSGS0XT,PSGOES S PSGOES=2,X=PSGSCH D ENOS^PSGS0 I $G(X)="" S CHK=4
105 Q:'CHK
106 W $C(7)
107 ;
108CHKM ;
109 D FULL^VALM1
110 ; changed to remove ^DD ref
111 W !!,"THE FOLLOWING ",$S($L(CHK)>1:"ARE",1:"IS")," EITHER INVALID OR MISSING FROM THIS ORDER:" F X=1:1:7 W:CHK[X !?5,$P("ORDERABLE ITEM^MED ROUTE^SCHEDULE TYPE^SCHEDULE^START DATE/TIME^STOP DATE/TIME^DISPENSE DRUG","^",X)
112 I CHK=7 W !,"Orders with no dispense drugs or multiple dispense drugs",!,"require dosage ordered"
113 W:CHK]"" !!,$S($L(CHK)>1:"THESE FIELDS ARE",1:"THIS FIELD IS")," NECESSARY FOR VERIFICATION."
114 N DIR S DIR(0)="E" D ^DIR I $D(DUOUT)!$D(DTOUT) S CHK=1 Q
115 Q
116 ;
117CONT() ;
118 NEW DIR,DIRUT,Y
119 W ! K DIR,DIRUT
120 S DIR(0)="Y",DIR("A")="Would you like to continue verifying the order",DIR("B")="Yes"
121 D ^DIR
122 Q Y
123 ;
124DDCHK ; dispense drug check
125 S DRGF="^PS("_$S(PSGORD["P":"53.1,"_+PSGORD,1:"55,"_PSGP_",5,"_+PSGORD)_",",CHK=$S('$O(@(DRGF_"1,0)")):7,1:0)
126 S PSGPD=$G(@(DRGF_".2)"))
127 S CHK=$S('$$DDOK^PSGOE2(DRGF_"1,",PSGPD):7,1:0)
128 Q:CHK=0
129 W $C(7),!!,"This order must have at least one valid, active dispense drug to be verified."
130 ;
131DDEDIT ;
132 ;*** Remove all dispense drug for this order
133 K @(DRGF_"1)")
134 ; The naked reference below refers to the indirect full reference in DRGF_"1,"_Q_")", which is either ^PS(53.1,+PSGORD,Q) or ^PS(55,DFN,5,+PSGORD,Q)
135 K ^PS(53.45,PSJSYSP,2) S (X,Q)=0 F S Q=$O(@(DRGF_"1,"_Q_")")) Q:'Q S Y=$G(^(Q,0)),X=Q S ^PS(53.45,PSJSYSP,2,Q,0)=Y I Y S ^PS(53.45,PSJSYSP,2,"B",+Y,Q)=""
136 I X S ^PS(53.45,PSJSYSP,2,0)="^53.4502P^"_X_"^"_X
137 D ENDRG^PSGOEF1(PSGPD,X)
138 I 'CHK S %X="^PS(53.45,"_PSJSYSP_",2,",%Y=DRGF_"1," D %XY^%RCR S $P(@(DRGF_"1,0)"),"^",2)=$S(DRGF[53.1:"53.11P",1:"55.07P")
139 K DRG,DRGF Q
140 ;
141AESCREEN() ;
142 ; Output: 0 - Required fields missing and DON'T allow accept
143 ; 1 - Required fields found.
144 Q:'$G(CHK) 1
145 S Y=$P($G(^ORD(101,+$G(^ORD(101,DA(1),10,DA,0)),0)),U) I Y="" Q 0
146 I Y="PSJU LM ACCEPT EDIT" Q 1
147 Q 0
148ACTLOG(PSGORDP,DFN,PSGORD) ;Store 53.1 activity log in local array to be moved to 55
149 ;PSGORDP: IEN from 53.1
150 ;PSGORD : IEN from 55
151 NEW PSGX,PSGXDA,PSGAL531,Q,QQ
152 F PSGX=0:0 S PSGX=$O(^PS(53.1,+PSGORDP,"A",PSGX)) Q:'PSGX D
153 . S PSGAL531=$G(^PS(53.1,+PSGORDP,"A",PSGX,0))
154 . S QQ=$G(^PS(55,DFN,5,+PSGORD,9,0)) S:QQ="" QQ="^55.09D" F Q=$P(QQ,U,3)+1:1 I '$D(^(Q)) S $P(QQ,U,3,4)=Q_U_Q,^(0)=QQ,PSGXDA=Q Q
155 . S ^PS(55,DFN,5,+PSGORD,9,PSGXDA,0)=PSGAL531
156 Q
Note: See TracBrowser for help on using the repository browser.