source: FOIAVistA/trunk/r/DIETETICS-FH/FHXDB2.m@ 1119

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

initial load of FOIAVistA 6/30/08 version

File size: 2.6 KB
Line 
1FHXDB2 ; HISC/REL - Verify patient data base ;11/27/91 13:00
2 ;;5.5;DIETETICS;;Jan 28, 2005
3 D ALL:PAT="A",INP:PAT="I" W !!,"***** D O N E *****",! Q
4ALL W !!,"Verifying Patient data base ^FHPT for ALL Patients & Admissions",!
5 F FHDFN=0:0 S FHDFN=$O(^FHPT(FHDFN)) Q:FHDFN<1 D PATNAME^FHOMUTL Q:DFN="" D PAT F ADM=0:0 S ADM=$O(^FHPT(FHDFN,"A",ADM)) Q:ADM<1 D ADM
6 Q
7INP W !!,"Verifying Patient data base ^FHPT for Current Inpatients Only",!
8 S WRD="" F M=0:0 S WRD=$O(^DPT("CN",WRD)) Q:WRD="" F DFN=0:0 S DFN=$O(^DPT("CN",WRD,DFN)) Q:DFN<1 S FHZ115="P"_DFN D CHECK^FHOMDPA Q:FHDFN="" D PAT S ADM=^DPT("CN",WRD,DFN) Q:ADM<1 D ADM
9 Q
10PAT S ERR=0
11 F K=0:0 S K=$O(^FHPT(FHDFN,"P",K)) Q:K<1 S X=+^(K,0) I '$D(^FH(115.2,X,0))#2 W !,$P(^DPT(DFN,0),"^",1)," - missing Food Preference ",X
12 F K=0:0 S K=$O(^FHPT(FHDFN,"N",K)) Q:K<1 S X=^(K,0) D P1
13 F K=0:0 S K=$O(^FHPT(FHDFN,"S",K)) Q:K<1 S X=$P(^(K,0),"^",2) I X,'$D(^FH(115.4,X,0))#2 W !,$P(^DPT(DFN,0),"^",1)," - missing Nutrition Status ",X
14 Q
15P1 S N=$P(X,"^",19) I N,'$D(^FH(115.4,N,0))#2 W !,$P(^DPT(DFN,0),"^",1)," - missing Nutrition Status ",N
16 S N=$P(X,"^",20) I N,'$D(^FH(115.3,N,0))#2 W !,$P(^DPT(DFN,0),"^",1)," - missing Nutrition Classification ",N
17 Q
18ADM S ERR=0
19 S N=$P(^FHPT(FHDFN,"A",ADM,0),"^",10) I N,'$D(^FH(119.4,N,0))#2 D HDR W !?5,"Isolation ",N," missing."
20 S N=$P(^FHPT(FHDFN,"A",ADM,0),"^",8) I N,'$D(^FH(119.6,N,0))#2 D HDR W !?5,"Dietetic Ward ",N," missing."
21 F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"DI",K)) Q:K<1 S X=^(K,0) D DI
22 F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"SF",K)) Q:K<1 S X=^(K,0) D SF
23 F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"TF",K)) Q:K<1 F L=0:0 S L=$O(^FHPT(FHDFN,"A",ADM,"TF",K,"P",L)) Q:L<1 S N=+^(L,0) D TF
24 F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"SP",K)) Q:K<1 S N=+$P(^(K,0),"^",2) D SP
25 F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"DR",K)) Q:K<1 S N=+$P(^(K,0),"^",2) D DR
26 Q
27HDR Q:ERR W !,$P(^DPT(DFN,0),"^",1),?40,"Admission: ",ADM S ERR=1 Q
28DI F L=2:1:6 S N=$P(X,"^",L) I N,'$D(^FH(111,N,0))#2 D HDR W !?5,"Diet ",N," missing in Diet Order ",K
29 S N=$P(X,"^",13) I N,'$D(^FH(116.2,N,0))#2 D HDR W !?5,"Prod. Diet ",N," missing in Diet Order ",K
30 Q
31SF F L=5:2:27 S N=$P(X,"^",L) I N,'$D(^FH(118,N,0))#2 D HDR W !?5,"Supp. Feeding Item ",N," missing from SF Order ",K
32 S N=$P(X,"^",4) I N,'$D(^FH(118.1,N,0))#2 D HDR W !?5,"Supp. Feeding Menu ",N," missing from SF Order ",K
33 Q
34TF I '$D(^FH(118.2,N,0))#2 D HDR W !?5,"Tubefeeding Product ",N," missing from Tubefeeding Order ",K
35 Q
36SP I '$D(^FH(118.3,N,0))#2 D HDR W !?5,"Standing Order Item ",N," missing from Standing Order # ",K
37 Q
38DR I '$D(^FH(119.5,N,0))#2 D HDR W !?5,"Diet Consult ",N," missing from Consult Order # ",K
39 Q
Note: See TracBrowser for help on using the repository browser.