source: FOIAVistA/trunk/r/DIETETICS-FH/FHPST2.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 5.7 KB
Line 
1FHPST2 ;Hines OIFO/RTK POST-INIT TO BACKFILL OM TO FILE #100 ;6/21/05 12:05
2 ;;5.5;DIETETICS;**2**;Jan 28, 2005
3 ;
4 ;Loop thru all existing Recurring & Special Meals and send backdoor
5 ;message to update Orders (#100) file.
6 ;
7 ;Recurring Meals
8 D NOW^%DTC S FHNOW=%,FHTODAY=$E(FHNOW,1,7)
9 F FHXRDT=0:0 S FHXRDT=$O(^FHPT("RM",FHXRDT)) Q:FHXRDT'>0 D
10 .F FHDFN=0:0 S FHDFN=$O(^FHPT("RM",FHXRDT,FHDFN)) Q:FHDFN'>0 D
11 ..F FHRM=0:0 S FHRM=$O(^FHPT("RM",FHXRDT,FHDFN,FHRM)) Q:FHRM'>0 D
12 ...S FHDT=$P($G(^FHPT(FHDFN,"OP",FHRM,0)),"^",1)
13 ...S FHODT=$$FMTHL7^XLFDT(FHDT)
14 ...S FHLOC=$P($G(^FHPT(FHDFN,"OP",FHRM,0)),"^",3)
15 ...S FHMPNUM=$P($G(^FHPT(FHDFN,"OP",FHRM,0)),"^",6)
16 ...I $D(^FHPT(FHDFN,"OP",FHRM,0)) D RM I $P(^FHPT(FHDFN,"OP",FHRM,0),"^",15)="C" S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRM,0)),U,12),FILL="R;"_FHMPNUM_";"_FHDT_";"_FHDT_";;" D MSHCA ;Send backdoor cancel
17 ...I $D(^FHPT(FHDFN,"OP",FHRM,1)) D AO
18 ...I $D(^FHPT(FHDFN,"OP",FHRM,2)) D EL
19 ...I $D(^FHPT(FHDFN,"OP",FHRM,3)) D TF
20 ;
21 ;Special Meals
22 F FHXSDT=0:0 S FHXSDT=$O(^FHPT("SM",FHXSDT)) Q:FHXSDT'>0 D
23 .F FHDFN=0:0 S FHDFN=$O(^FHPT("SM",FHXSDT,FHDFN)) Q:FHDFN'>0 D
24 ..S FHODT=$$FMTHL7^XLFDT(FHXSDT)
25 ..S FHLOC=$P($G(^FHPT(FHDFN,"SM",FHXSDT,0)),"^",3)
26 ..I $D(^FHPT(FHDFN,"SM",FHXSDT,0)) D SM
27 Q
28 ;
29RM ;
30 I $P(^FHPT(FHDFN,"OP",FHRM,0),"^",12)>0 Q ;Backdoor already exists
31 S FHN0=$G(^FHPT(FHDFN,"OP",FHRM,0))
32 K MSG D MSHOM I 'DFN!('FHOLOC) Q
33 S FHMPNUM=$P(FHN0,"^",6),FHCLRK=$P(FHN0,"^",17) D GETSED
34 S (X,FHSTDT)=$P(FHN0,"^",1)
35 S FHMEAL=$P(FHN0,"^",4),FHDIET=$P(FHN0,"^",2),FHDIETX(1)=$P(FHN0,"^",7)
36 S FHDIETX(2)=$P(FHN0,"^",8),FHDIETX(3)=$P(FHN0,"^",9)
37 S FHDIETX(4)=$P(FHN0,"^",10),FHDIETX(5)=$P(FHN0,"^",11)
38 S FHOSTDT=$$FMTHL7^XLFDT(FHSTDT),FHOENDT=$$FMTHL7^XLFDT(FHENDT)
39 S FILL="R;"_FHMPNUM_";"_FHSTDT_";"_FHENDT_";"_FHDAYS_";"_FHMEAL
40 S MSG(4)="ORC|SN||"_FILL_"^FH||||^"_FHDAYS_"^^"_FHOSTDT_"^"_FHOENDT_"|||"_FHCLRK_"|||||"_FHOSTDT
41 I FHDIET'="" S FHODNM=$P($G(^FH(111,FHDIET,0)),U,1),MSG(5)="ODS|D|"_FHMEAL_"|^^^"_FHDIET_"^"_FHODNM_"^99FHD|"
42 I FHDIET="" D
43 .F N=0:0 S N=$O(FHDIETX(N)) Q:N'>0 Q:FHDIETX(N)="" S FHODNM=$P($G(^FH(111,FHDIETX(N),0)),U,1),MSG(N+4)="ODS|D|"_FHMEAL_"|^^^"_FHDIETX(N)_"^"_FHODNM_"^99FHD|"
44 D EVSEND^FHWOR
45 Q
46AO ;
47 I $P(^FHPT(FHDFN,"OP",FHRM,1),"^",4)>0 Q ;Backdoor already exists
48 S FHN1=$G(^FHPT(FHDFN,"OP",FHRM,1))
49 K MSG D MSHOM I 'DFN!('FHOLOC) Q
50 S FILL="A;"_FHRM,FHTEXT=$P(FHN1,"^",1),FHCLRK=$P(FHN1,"^",2)
51 S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"^"_FHODT_"|||"_FHCLRK_"|||||"_FHTODAY
52 S MSG(5)="ODS|D||^^^FH-6^Additional Order^99OTH|"_FHTEXT
53 D EVSEND^FHWOR
54 I $P(^FHPT(FHDFN,"OP",FHRM,1),"^",5)="C" S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRM,1)),U,4),FILL="A;"_FHRM D MSHCA ;Send backdoor cancel
55 Q
56EL ;
57 I $P(^FHPT(FHDFN,"OP",FHRM,2),"^",5)>0 Q ;Backdoor already exists
58 S FHN2=$G(^FHPT(FHDFN,"OP",FHRM,2))
59 K MSG D MSHOM I 'DFN!('FHOLOC) Q
60 S FILL="E;"_FHRM,FHEL="L",FHS=1,FHBAG=$P(FHN2,"^",2)
61 S FHCLRK=$P(FHN2,"^",3)
62 S FHOMELN=FHMEAL_FHEL_FHS,FHOBAG="" I FHBAG="Y" S FHOBAG="bagged"
63 S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"^"_FHODT_"|||"_FHCLRK_"|||||"_FHTODAY
64 S MSG(5)="ODT|LATE|^^^"_FHOMELN_"^^99FHD|"_FHOBAG
65 D EVSEND^FHWOR
66 I $P(^FHPT(FHDFN,"OP",FHRM,2),"^",6)="C" S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRM,2)),U,5),FILL="E;"_FHRM D MSHCA ;Send backdoor cancel
67 Q
68TF ;
69 I $P(^FHPT(FHDFN,"OP",FHRM,3),"^",4)>0 Q ;Backdoor already exists
70 S FHN3=$G(^FHPT(FHDFN,"OP",FHRM,3))
71 K MSG,TUN D MSHOM I 'DFN!('FHOLOC) Q
72 S FHTEXT=$P(FHN3,"^",1),FILL="T;"_FHRM,MNUM=4,TFCOM=FHTEXT
73 S FHCLRK=$P(FHN3,"^",6) D NOW^%DTC S FHNOW=%,SDT=FHDT
74 S MSG(MNUM)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"|||"_FHCLRK_"||"_FHCLRK_"|||"_FHNOW
75 F FHTF=0:0 S FHTF=$O(^FHPT(FHDFN,"OP",FHRM,"TF",FHTF)) Q:FHTF'>0 S TUN(FHTF)=$G(^FHPT(FHDFN,"OP",FHRM,"TF",FHTF,0))
76 F FHTF=0:0 S FHTF=$O(TUN(FHTF)) Q:FHTF<1 S XX=$G(TUN(FHTF)) D TF1^FHWOR5
77 D EVSEND^FHWOR
78 I $P(^FHPT(FHDFN,"OP",FHRM,3),"^",5)="C" S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRM,3)),U,4),FILL="T;"_FHRM D MSHCA ;Send backdoor cancel
79 Q
80SM ;
81 I $P(^FHPT(FHDFN,"SM",FHXSDT,0),"^",12)>0 Q ;Backdoor already exists
82 S FHSN0=$G(^FHPT(FHDFN,"SM",FHXSDT,0))
83 K MSG D MSHOM I 'DFN!('FHOLOC) Q
84 S FILL="S;"_FHXSDT,FHMEAL=$P(FHSN0,"^",9),FHDIET=$P(FHSN0,"^",4)
85 S FHOMEAL=$S(FHMEAL="B":1,FHMEAL="N":3,FHMEAL="E":5,1:"")
86 S FHDIETNM=$P($G(^FH(111,FHDIET,0)),U,1),FHCLRK=$P(FHSN0,"^",5)
87 S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"^"_FHODT_"|||"_FHCLRK_"|||||"_FHNOW
88 S MSG(5)="ODS|S|"_FHOMEAL_"|^^^"_FHDIET_"^"_FHDIETNM_"^99FHD|"
89 D EVSEND^FHWOR
90 S FHSMST=$P(^FHPT(FHDFN,"SM",FHXSDT,0),"^",2)
91 I FHSMST="C"!(FHSMST="D") S FHORN=$P($G(^FHPT(FHDFN,"SM",FHXSDT,0)),U,12),FILL="S;"_FHXSDT D MSHCA ;Send backdoor cancel/deny
92 Q
93MSHOM ;Code MSG for outpatient orders
94 D SITE^FH
95 D PATNAME^FHOMUTL I 'DFN Q
96 S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
97 S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)
98 S FHOLOC=$G(^FH(119.6,FHLOC,"L",1,0)) I 'FHOLOC Q
99 S FHOLOCNM=$P($G(^SC(FHOLOC,0)),U,1)
100 S MSG(3)="PV1||O|"_FHOLOC_"^"_FHOLOCNM_"||||||||||||||||"
101 Q
102MSHCA ;Code Cancel/Discontinue for outpatient orders
103 K MSG S ACT="OC" D SITE^FH S FHCATXT="Dietetics Canceled order."
104 D PATNAME^FHOMUTL I 'DFN Q
105 S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
106 S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)
107 S DATE=$$FMTHL7^XLFDT(FHNOW)
108 S MSG(3)="ORC|"_ACT_"|"_FHORN_"^OR|"_FILL_"^FH|||||||"_DUZ_"||"_DUZ_"|||"_DATE_"|"_FHCATXT
109 D EVSEND^FHWOR
110 Q
111GETSED ;
112 K N1 S (FHDAYS,FHENDT,FHODAYS)=""
113 F FHRZ=0:0 S FHRZ=$O(^FHPT(FHDFN,"OP","C",FHMPNUM,FHRZ)) Q:FHRZ'>0 D
114 .S FHDAT=$P($G(^FHPT(FHDFN,"OP",FHRZ,0)),"^",1),X=FHDAT D DOW^%DTC
115 .S FHV=$S(Y=0:"X",Y=1:"M",Y=2:"T",Y=3:"W",Y=4:"R",Y=5:"F",1:"S")
116 .I FHDAYS'[FHV S FHDAYS=FHDAYS_FHV
117 .Q
118 S FHENDT=FHDAT
119 F N=1:1:7 S FH1=$E(FHDAYS,N) Q:FH1="" S M=$F("MTWRFSX",FH1)-1,N1(M)=""
120 F N=0:0 S N=$O(N1(N)) Q:N'>0 S FHODAYS=FHODAYS_"~QJ"_N
121 S FHODAYS=$E(FHODAYS,2,999)
122 S FHDAYS=FHODAYS Q
Note: See TracBrowser for help on using the repository browser.