1 | FHOMRO2 ;Hines OIFO/RTK CHECK MEAL WINDOW TIMES,FILE OP EVENTS ;2/04/03 14:05
|
---|
2 | ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
|
---|
3 | ;
|
---|
4 | ; IF TIME (NOW) IS PAST MEAL SELECTED WINDOW DISPLAY MSG; SKIP TODAY
|
---|
5 | ; IF TIME (NOW) IS WITHIN THE MEAL WINDOW (SEE FHORD1A) ASK "DO YOU
|
---|
6 | ; WANT TO ORDER A LATE TRAY" IF YES, LET THEM; IF NO SKIP TODAY
|
---|
7 | CHK1 ; Check if meal is past for today
|
---|
8 | S X=FHTODAY D H^%DTC S FHK=$E("XMTWRFS",%Y+1) I FHDAYS'[FHK Q
|
---|
9 | D VARS
|
---|
10 | I FHMEAL="B",FHTIME>$P(FHWIND2,U,2) D MSG Q
|
---|
11 | I FHMEAL="N",FHTIME>$P(FHWIND2,U,4) D MSG Q
|
---|
12 | I FHMEAL="E",FHTIME>$P(FHWIND2,U,6) D MSG Q
|
---|
13 | Q
|
---|
14 | CHK2 ; Check if late tray needs to be ordered
|
---|
15 | S X=FHTODAY D H^%DTC S FHK=$E("XMTWRFS",%Y+1) I FHDAYS'[FHK Q
|
---|
16 | D VARS
|
---|
17 | I FHMEAL="B",FHTIME>$P(FHWIND2,U,1),FHTIME<$P(FHWIND2,U,2) D LATE
|
---|
18 | I FHMEAL="N",FHTIME>$P(FHWIND2,U,3),FHTIME<$P(FHWIND2,U,4) D LATE
|
---|
19 | I FHMEAL="E",FHTIME>$P(FHWIND2,U,5),FHTIME<$P(FHWIND2,U,6) D LATE
|
---|
20 | Q
|
---|
21 | VARS ;
|
---|
22 | S FHWIND1=$G(^FH(119.73,FHCOMM,1)),FHWIND2=$G(^FH(119.73,FHCOMM,2))
|
---|
23 | D NOW^%DTC S FHTIME=$E($P(%,".",2),1,4)
|
---|
24 | S MLTX=$S(FHMEAL="B":"breakfast",FHMEAL="N":"noon",1:"evening"),SKIP=0
|
---|
25 | Q
|
---|
26 | SMGM ;entry point for Special/Guest meals
|
---|
27 | S FHWIND1=$G(^FH(119.73,FHCOMM,1)),FHWIND2=$G(^FH(119.73,FHCOMM,2))
|
---|
28 | D NOW^%DTC S FHTIME=$E($P(%,".",2),1,4)
|
---|
29 | S MLTX=$S(FHMEAL="B":"breakfast",FHMEAL="N":"noon",1:"evening"),SKIP=0
|
---|
30 | I FHMEAL="B",FHTIME>$P(FHWIND2,U,2) D MSG Q
|
---|
31 | I FHMEAL="N",FHTIME>$P(FHWIND2,U,4) D MSG Q
|
---|
32 | I FHMEAL="E",FHTIME>$P(FHWIND2,U,6) D MSG Q
|
---|
33 | I FHMEAL="B",FHTIME>$P(FHWIND2,U,1),FHTIME<$P(FHWIND2,U,2) D LATE
|
---|
34 | I FHMEAL="N",FHTIME>$P(FHWIND2,U,3),FHTIME<$P(FHWIND2,U,4) D LATE
|
---|
35 | I FHMEAL="E",FHTIME>$P(FHWIND2,U,5),FHTIME<$P(FHWIND2,U,6) D LATE
|
---|
36 | Q
|
---|
37 | MSG ;
|
---|
38 | W !!,"The ",MLTX," window has passed for today! Not ordered for today."
|
---|
39 | D SKIP Q
|
---|
40 | LATE ;
|
---|
41 | I $G(FHGML)=1 Q
|
---|
42 | W !,"You have missed the ",MLTX," cut-off."
|
---|
43 | K DIR S DIR("A")="Do you wish to order a LATE TRAY for today? (Y/N): "
|
---|
44 | S DIR(0)="YA",DIR("B")="Y" D ^DIR
|
---|
45 | I $D(DIRUT) D SKIP Q
|
---|
46 | S FHLATE=Y I FHLATE'=1 D SKIP Q
|
---|
47 | S FHLTFLG=1
|
---|
48 | Q
|
---|
49 | SKIP ;
|
---|
50 | S SKIP=1,X1=STDT,X2=1 D C^%DTC S STDT=X ;add (skip) a day to Start Date
|
---|
51 | Q
|
---|
52 | ;
|
---|
53 | ; Entry points for filing Outpatient Dietetic Events
|
---|
54 | SETSM ; Set specific variables for SM Events then call SETORX
|
---|
55 | S FHDIET=$P(FHZN,U,4),FHLOC=$P(FHZN,U,3),FHMEAL=$P(FHZN,U,9)
|
---|
56 | D SETORX Q
|
---|
57 | SETGM ; Set specific variables for GM Events then call SETORX
|
---|
58 | S FHDIET=$P(FHZN,U,6),FHLOC=$P(FHZN,U,5),FHMEAL=$P(FHZN,U,3)
|
---|
59 | D SETORX Q
|
---|
60 | SETAET ; Set specific variables for RM AO, E/L, TF Events then do SETORX
|
---|
61 | S FHZN=$G(^FHPT(FHDFN,"OP",+FHRNUM,0)),FHDIET=$P(FHZN,U,2)
|
---|
62 | S FHLOC=$P(FHZN,U,3),FHMEAL=$P(FHZN,U,4)
|
---|
63 | I $G(FHC) S FHOPDT=$P(FHLIST(FHC),U,2) D SETORX Q
|
---|
64 | S FHOPDT=FHRMDT
|
---|
65 | SETORX ; Set variables for RM Events and call FHORX
|
---|
66 | I $G(FHOPDT)'="" S FHOPDT=$P($$FMTE^XLFDT(FHOPDT,"P"),",",1)
|
---|
67 | K FHTXT S (FHDDISP,FHLDSP)=""
|
---|
68 | I FHDIET'="" S FHDDISP=$P($G(^FH(111,FHDIET,0)),U,1)
|
---|
69 | I FHLOC'="" S FHLDSP=$P($G(^FH(119.6,FHLOC,0)),U,1)
|
---|
70 | S FHMLDSP=$S(FHMEAL="B":"Breakfast",FHMEAL="N":"Noon",1:"Evening")
|
---|
71 | S FHFROMD=$O(ODAYS("")),FHFROMD=$P($$FMTE^XLFDT(FHFROMD,"P"),",",1)
|
---|
72 | S FHTOD=$O(ODAYS(""),-1),FHTOD=$P($$FMTE^XLFDT(FHTOD,"P"),",",1)
|
---|
73 | S FHOPTY2="Outpatient "_$S(FHOPTY="R":"Recurring Meal",FHOPTY="S":"Special Meal",FHOPTY="G":"Guest Meal",FHOPTY="I":"Isolation/Precaution",FHOPTY="A":"Add. Order",FHOPTY="E":"E/L Tray",1:"TF")
|
---|
74 | S FHACT2=$S(FHACT="O":": ",1:" cancelled: ") I FHOPTY="S" S FHACT2=$S(FHSTAT="A":" authorized: ",FHSTAT="D":" denied: ",1:FHACT2)
|
---|
75 | S FHTXT=FHOPTY2_FHACT2_FHDDISP_", "_FHLDSP_", "_FHMLDSP
|
---|
76 | I FHOPTY="R",FHACT="O" D DAYS S FHTXT=FHTXT_", "_FHDAZ_", "_FHFROMD_"-"_FHTOD D OPFILE^FHORX Q
|
---|
77 | S FHTXT=FHTXT_", "_$G(FHOPDT) I $G(FHAET)'="" S FHTXT=FHTXT_", "_FHAET
|
---|
78 | I FHOPTY="I" S FHTXT=$P(FHTXT,":",1)_": "_FHIP
|
---|
79 | D OPFILE^FHORX Q
|
---|
80 | DAYS ; External display of Days
|
---|
81 | S FHDAZ="" F A=1:1:7 S B=$E(FHDAYS,A) Q:B="" S FHDAZ=FHDAZ_$S(B="M":"Mon",B="T":"Tue",B="W":"Wed",B="R":"Thu",B="F":"Fri",B="S":"Sat",1:"Sun")_"/"
|
---|
82 | S FHDAZ=$E(FHDAZ,1,$L(FHDAZ)-1)
|
---|
83 | Q
|
---|
84 | SOSFFP ;Add diet (pattern) associated SO's, SF's, FP's for outpatients
|
---|
85 | S FHDPT=FHDPATT F ZZZ=1:1:4 I $L(FHDPT,"^")<5 S FHDPT=FHDPT_"^"
|
---|
86 | S FHSTADT="",FHDPIEN=$O(^FH(111.1,"AB",FHDPT,0)) I FHDPIEN="" Q
|
---|
87 | F FHOPB=FHNOW:0 S FHOPB=$O(^FHPT(FHDFN,"OP","B",FHOPB)) Q:FHOPB'>0 D
|
---|
88 | .I FHSTADT="" S DTP=FHOPB D DTP^FH S FHSTADT=DTP
|
---|
89 | .F FHOPN=0:0 S FHOPN=$O(^FHPT(FHDFN,"OP","B",FHOPB,FHOPN)) Q:FHOPN'>0 D
|
---|
90 | ..S FHZN=$G(^FHPT(FHDFN,"OP",FHOPN,0)) I $P(FHZN,U,15)="C" Q
|
---|
91 | ..I $P(FHZN,U,2)'=$P(FHDPT,U,1),$P(FHZN,U,7,11)'=FHDPT Q ;check dietpat
|
---|
92 | ..D NOW^%DTC S FHNNN=%,FHYES="Y"
|
---|
93 | ..D SOSET,SFSET,FPSET Q
|
---|
94 | Q
|
---|
95 | SOSET ;Diet related SO's
|
---|
96 | F FHMLSO="BS","NS","ES" D
|
---|
97 | .F FHSO=0:0 S FHSO=$O(^FH(111.1,FHDPIEN,FHMLSO,FHSO)) Q:FHSO'>0 D
|
---|
98 | ..S FHQ=0,FHSOZN=$G(^FH(111.1,FHDPIEN,FHMLSO,FHSO,0))
|
---|
99 | ..S FHSIEN=$P(FHSOZN,U,1),FHSQTY=$P(FHSOZN,U,2),FHMLZ=$P(FHZN,U,4)
|
---|
100 | ..F FHX=0:0 S FHX=$O(^FHPT(FHDFN,"OP",FHOPN,"SP",FHX)) Q:FHX'>0 D
|
---|
101 | ...I $P($G(^FHPT(FHDFN,"OP",FHOPN,"SP",FHX,0)),U,2)=FHSIEN,$P($G(^FHPT(FHDFN,"OP",FHOPN,"SP",FHX,0)),U,9)="Y" S FHQ=1
|
---|
102 | ..I FHQ=1 Q
|
---|
103 | ..I $P(FHZN,U,4)'=$E(FHMLSO,1) Q ;check for meal
|
---|
104 | ..K DIC,DO S DA(2)=FHDFN,DA(1)=FHOPN
|
---|
105 | ..S DIC="^FHPT("_DA(2)_",""OP"","_DA(1)_",""SP"","
|
---|
106 | ..S DIC(0)="L",DIC("P")=$P(^DD(115.016,26,0),U,2)
|
---|
107 | ..S X=$P($G(^FHPT(FHDFN,"OP",FHOPN,"SP",0)),U,3)+1
|
---|
108 | ..D FILE^DICN I Y=-1 Q
|
---|
109 | ..K DIE S DA(2)=FHDFN,DA(1)=FHOPN,(DA,FHI)=+Y
|
---|
110 | ..S DIE="^FHPT("_DA(2)_",""OP"","_DA(1)_",""SP"","
|
---|
111 | ..S DR="1////^S X=FHSIEN;2////^S X=FHMLZ;3////^S X=FHNNN;4////^S X=DUZ;7////^S X=FHSQTY;8////^S X=FHYES"
|
---|
112 | ..D ^DIE
|
---|
113 | ..S FHSOO(FHI,FHSIEN)=FHSQTY,FHCNSOF=1
|
---|
114 | Q
|
---|
115 | SFSET ;Diet related SF's
|
---|
116 | S FHSF=$P($G(^FH(111.1,FHDPIEN,0)),U,8) I FHSF="" Q
|
---|
117 | L +^FHPT(FHDFN,"OP",FHOPN,"SF",0)
|
---|
118 | I '$D(^FHPT(FHDFN,"OP",FHOPN,"SF",0)) S ^FHPT(FHDFN,"OP",FHOPN,"SF",0)="^115.1627^^"
|
---|
119 | S FHX=^FHPT(FHDFN,"OP",FHOPN,"SF",0),FHN3=+$P(FHX,"^",3),FHNO=FHN3+1
|
---|
120 | I $P($G(^FHPT(FHDFN,"OP",FHOPN,"SF",FHN3,0)),U,5,28)=$P($G(^FH(118.1,FHSF,1)),U,1,24) Q ;don't add duplicate
|
---|
121 | S ^FHPT(FHDFN,"OP",FHOPN,"SF",0)=$P(FHX,U,1,2)_"^"_FHNO_"^"_($P(FHX,"^",4)+1)
|
---|
122 | L -^FHPT(FHDFN,"OP",FHOPN,"SF",0)
|
---|
123 | S FHPNO=$G(^FH(118.1,+FHSF,1)) Q:FHPNO=""
|
---|
124 | S FHPNN="^"_FHNNN_"^"_DUZ_"^"_FHSF_"^"_FHPNO
|
---|
125 | S ^FHPT(FHDFN,"OP",FHOPN,"SF",FHNO,0)=FHNO_"^"_$P(FHPNN,"^",2,99)
|
---|
126 | I FHN3,$D(^FHPT(FHDFN,"OP",FHOPN,"SF",FHN3,0)),'$P(^FHPT(FHDFN,"OP",FHOPN,"SF",FHN3,0),U,32) D
|
---|
127 | .S $P(^FHPT(FHDFN,"OP",FHOPN,"SF",FHN3,0),"^",32,33)=FHNNN_"^"_DUZ
|
---|
128 | S:FHNO $P(^FHPT(FHDFN,"OP",FHOPN,"SF",FHNO,0),"^",30,31)=FHNNN_"^"_DUZ
|
---|
129 | S:FHNO $P(^FHPT(FHDFN,"OP",FHOPN,"SF",FHNO,0),"^",34)="Y"
|
---|
130 | S FHADSFF=1,FHSFMEN=$P($G(^FH(118.1,+FHSF,0)),U,1)
|
---|
131 | Q
|
---|
132 | FPSET ;Diet related FP's
|
---|
133 | F FHFP=0:0 S FHFP=$O(^FH(111.1,FHDPIEN,"RES",FHFP)) Q:FHFP'>0 D
|
---|
134 | .S DPAT=FHDPIEN D UPD^FHMTK7
|
---|
135 | Q
|
---|
136 | KILL ;kill variables from FHOMRO1
|
---|
137 | K A,AA,AB,CCC,CONT,ENDL,ENDT,FHDFN,FHDAYS,FHDEF,FHDIET,FHDIETS
|
---|
138 | K FHDIETX1,FHDIETX2,FHDIETX3,FHDIETX4,FHDIETX5,FHEXST,FHIFLG,FHLOC
|
---|
139 | K FHMPNUM,FHSMYES,FHYIEN,FHZ,FLAG,J,FHMEAL,MLT,ODAYS,SPDIETS,STDT,DFN
|
---|
140 | K FHSO,FHSOO,FHDAT,FHSODAT,NUM,FHSOI,FHSOQ,FHSOCN,FHPRML,FHPRCN
|
---|
141 | K BID,P,LS,LN,SP,NO,DR,DIC,DIR,FHSERV,FHSF1,OCXTSPI,PNN,SKIP,STDTMP
|
---|
142 | K FHZ,FHBID,FHSSN,FHDI,FHDIETX,FHDX,FHRMDT,FHMEAL,FHD0,FHDI,FHCK,FHJ
|
---|
143 | K EX,FHDIETP,FHDNM,FHDPTR,FHDTRLE,FHLIST,FHLOCZN,FHLPT,FHNODE,FHRM,FHI
|
---|
144 | K FHSF10,FHSF2,FHSF8,FHSFDAT,FHSRV,FHSRVPT,FHTZ,FHTZCNT,FHTZSO,FHTZSO2
|
---|
145 | K FHTZSO6,FHTZSO8,FHTZSOCN,FHTZSOL,FHTZSON,FHZDA,FHNNN
|
---|
146 | K FHAGE,FHCOMM,FHCUT,FHD3,FHD4,FHDOB,FHMAX,FHMSG1,FHMSGML,FHNOW,FHOSTDT
|
---|
147 | K FHOUT,FHPCZN,FHPTNM,FHSEX,FHTODAY,FHZ115,FILE,IEN,IEN200,FHODNM
|
---|
148 | K J,K,N1,PID,PREC,FHI,FHACT,FHACT2,FHADSFF,FHALML,FHCNSOF,FHDAZ,FHDDISP
|
---|
149 | K FHDOW,FHDTC,FHDTM,FHDTP,FHDUR,FHFROMD,FHK,FHLDSP,FHLOCN,FHLTFLG
|
---|
150 | K FHMLDSP,FHMPN,FHNMSAV,FHODAYS,FHTYPE,FHWIND1,FHWIND2,FHX,MLTX,N,NOW
|
---|
151 | K FHOENDT,FHOLOC,FHOLOCNM,FHOMEAL,FHOPTY,FHOPTY2,FHORN,FHPREVML,FHRNM
|
---|
152 | K FHRNUM,FHSETFLG,FHSF,FHSFCX,FHSFMEN,FHTDTMP,FHTIME,FHTOD,FHTXT,FHTYP
|
---|
153 | K L,OCXSEG,ORDNUM,ORPC,ORVARY,PAD,PCE,SF,ADM,FH1,FHOTDAY,FILL,M,MEAL
|
---|
154 | Q
|
---|