source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHWDIS.m@ 1800

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1FHWDIS ; HISC/REL - Close out on discharge ;10/10/00 14:55
2 ;;5.5;DIETETICS;;Jan 28, 2005
3 ; Updated for outpatient meals FHDFN/DFN
4 S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
5 D NOW^%DTC S FHNOW=%,FHA0=$G(^FHPT(FHDFN,"A",ADM,0)),FHWF=$S($D(^ORD(101)):1,1:0) Q:FHA0="" Q:$P(FHA0,"^",14)
6 S $P(^FHPT(FHDFN,"A",ADM,0),"^",14)=FHNOW
7 S FHWRD=$P(FHA0,"^",8),FHRMB=$P(FHA0,"^",9) I FHWRD K ^FHPT("AW",FHWRD,FHDFN) S $P(^FHPT(FHDFN,"A",ADM,0),"^",8,9)="^"
8 S EVT="L^D^^"_FHWRD_"~"_FHRMB D ^FHORX
9 ; Close out Additional Orders
10 F FHDR=0:0 S FHDR=$O(^FHPT("AOO",FHDFN,ADM,FHDR)) Q:FHDR<1 D AOO
11 ; Close out Consults
12 F FHDR=0:0 S FHDR=$O(^FHPT(FHDFN,"A",ADM,"DR",FHDR)) Q:FHDR<1 S Y=^(FHDR,0) D CON
13 ; Close out standing orders
14 F FHDR=0:0 S FHDR=$O(^FHPT(FHDFN,"A",ADM,"SP",FHDR)) Q:FHDR<1 S Y=^(FHDR,0) D SP
15 ; Cancel tubefeeding
16 S K=$P(FHA0,"^",4) I K D TF
17 ; Cancel future early/late trays
18 F FHDR=FHNOW:0 S FHDR=$O(^FHPT(FHDFN,"A",ADM,"EL",FHDR)) Q:FHDR<1 D EL
19 ; Cancel supplemental feeding
20 S K=$P(FHA0,"^",7) I K D SF
21 ; Cancel isolation/precaution
22 S K=$P(FHA0,"^",10) I K D IS
23 ; Cancel diet/ place on no order
24 D DO
25 I $D(^DPT(DFN,.1)) D WRD^FHWADM
26 ; Delete Diet related Food Restrictions
27 F FHFP=0:0 S FHFP=$O(^FHPT(FHDFN,"P",FHFP)) Q:FHFP<1 S FHFP1=$G(^(FHFP,0)) I $P(FHFP1,"^",4)="Y" D FP
28KIL K %,%H,%I,%Y,EDT,A1,FHDR,K,FILL,FHNOW,FHO,FHA0,FHFP,FHFP1,FHORD,FHORN,FHPV,FHRMB,FHWRD,FHX,VAL,WKD,X,Y Q
29AOO Q:$P(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0),"^",5)="X"
30 S $P(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0),"^",5,7)="X^"_FHNOW_"^"_DUZ
31 K ^FHPT("AOO",FHDFN,ADM,FHDR)
32 S FHORN=$P(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0),"^",8) Q:'FHORN
33 Q:'$D(^OR(100,+FHORN))
34 S FILL="A"_";"_ADM-";"_FHDR_$P(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0),"^",3)
35 D SEND
36 Q
37CON Q:$P(Y,"^",8)'="A" S $P(^FHPT(FHDFN,"A",ADM,"DR",FHDR,0),"^",8,11)="X^"_FHNOW_"^"_DUZ_"^"
38 S K=$P(Y,"^",5)
39 K:K ^FHPT("ADRU",K,FHDFN,ADM,FHDR) Q
40SP Q:$P(Y,"^",6) S $P(^FHPT(FHDFN,"A",ADM,"SP",FHDR,0),"^",6,7)=FHNOW_"^"_DUZ
41 K ^FHPT("ASP",FHDFN,ADM,FHDR) Q
42TF S $P(^FHPT(FHDFN,"A",ADM,0),"^",4)="" K ^FHPT("ADTF",FHDFN,ADM)
43 S $P(^FHPT(FHDFN,"A",ADM,"TF",K,0),"^",11,12)=FHNOW_"^"_DUZ
44 S FHX=$G(^FHPT(FHDFN,"A",ADM,"TF",K,0))
45 S FHORN=$P(FHX,"^",14) Q:'FHORN
46 Q:'$D(^OR(100,+FHORN))
47 S FILL="T"_";"_ADM_";"_K_";"_$P(FHX,"^",6)_";"_$P(FHX,"^",7)_";"_$P(FHX,"^",5)_";"
48 D SEND
49 Q
50EL S FHORN=$P(^FHPT(FHDFN,"A",ADM,"EL",FHDR,0),"^",7)
51 I FHORN D EL1
52 K ^FHPT(FHDFN,"A",ADM,"EL",FHDR),^FHPT("ADLT",FHDR,FHDFN,ADM)
53 S %=$P($G(^FHPT(FHDFN,"A",ADM,"EL",0)),"^",4)-1 S:%'<0 $P(^(0),"^",4)=% Q
54EL1 S EDT=FHDR,WKD="" D WKD^FHWOR31
55 S FHX=$G(^FHPT(FHDFN,"A",ADM,"EL",FHDR,0))
56 Q:'$D(^OR(100,+FHORN))
57 S FILL="E"_";"_ADM_";;"_FHDR_";"_FHDR_";"_WKD_";"_$P(FHX,"^",2)_";"_$P(FHX,"^",3)_";"_$P(FHX,"^",4)
58 D SEND Q
59SF S $P(^FHPT(FHDFN,"A",ADM,0),"^",7)=""
60 S $P(^FHPT(FHDFN,"A",ADM,"SF",K,0),"^",32,33)=FHNOW_"^"_DUZ Q
61IS S $P(^FHPT(FHDFN,"A",ADM,0),"^",10)="" K ^FHPT("AIS",FHDFN,ADM)
62 S FHORN=$P(FHA0,"^",13) Q:'FHORN
63 Q:'$D(^OR(100,+FHORN))
64 S FILL="I"_";"_ADM_";"_K D SEND
65 Q
66DO F A1=FHNOW:0 S A1=$O(^FHPT(FHDFN,"A",ADM,"AC",A1)) Q:A1="" K ^FHPT(FHDFN,"A",ADM,"AC",A1)
67 F FHDR=0:0 S FHDR=$O(^FHPT(FHDFN,"A",ADM,"DI",FHDR)) Q:FHDR<1 D D1
68 S FHA0=$P(FHA0,"^",2) Q:'FHA0 S FHA0=$P($G(^FHPT(FHDFN,"A",ADM,"DI",FHA0,0)),"^",7) Q:FHA0="X"
69 D ORD^FHORD7 S ^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)=FHORD_"^^^^^^X^^"_FHNOW_"^^"_DUZ_"^"_FHNOW
70 S ^FHPT(FHDFN,"A",ADM,"AC",FHNOW,0)=FHNOW_"^"_FHORD
71 S $P(^FHPT(FHDFN,"A",ADM,0),"^",2,3)=FHORD_"^" Q
72D1 ; Get all filler fields for Diet
73 S FHORN=$P($G(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0)),"^",14,15)
74 I +FHORN>0,$P(FHORN,"^",2)>2 S FHORN=+FHORN,$P(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0),"^",15)=1 D D2
75 Q
76D2 S FHX=$G(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0))
77 Q:$P(FHX,"^",7)="P"!($P(FHX,"^",7)="X")
78 S FHO=$P(FHX,"^",2,6),VAL="" D VAL^FHWORP(FHO,.VAL) Q:VAL=""
79 Q:'$D(^OR(100,+FHORN))
80 S FILL=$S($P(FHX,"^",7)="N":"N",1:"D")_";"_ADM_";"_FHDR_";"_$P(FHX,"^",9)_";"_$P(FHX,"^",10)_";"_$P(FHX,"^",7)_";"_$G(^FHPT(FHDFN,"A",ADM,"DI",FHDR,1))_";"_$P(FHX,"^",8)_";;"_VAL
81 D SEND Q
82FP K ^FHPT(FHDFN,"P",FHFP,0),^FHPT(FHDFN,"P","B",+FHFP1,FHFP)
83 S %=$P($G(^FHPT(FHDFN,"P",0)),"^",4)-1 S:%'<0 $P(^(0),"^",4)=% Q
84SEND ; Send MSG to OE/RR
85 D CODE D:$D(MSG) MSG^XQOR("FH EVSEND OR",.MSG) Q
86CODE ; Code Cancel For Discharge
87 K MSG S ACT="OC" D SITE^FH
88 ; code MSH
89 S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
90 ; code PID
91 S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)
92 ; code ORC
93 S DATE=$$FMTHL7^XLFDT(FHNOW),FHPV=DUZ
94 S MSG(3)="ORC|"_ACT_"|"_FHORN_"^OR|"_FILL_"^FH|||||||||"_FHPV_"|||"_DATE_"|Dietetics Canceled Order."
95 K %,ACT,DATE,FILL,SITE Q
Note: See TracBrowser for help on using the repository browser.