FHXDB2 ; HISC/REL - Verify patient data base ;11/27/91 13:00
;;5.5;DIETETICS;;Jan 28, 2005
D ALL:PAT="A",INP:PAT="I" W !!,"***** D O N E *****",! Q
ALL W !!,"Verifying Patient data base ^FHPT for ALL Patients & Admissions",!
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
Q
INP W !!,"Verifying Patient data base ^FHPT for Current Inpatients Only",!
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
Q
PAT S ERR=0
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
F K=0:0 S K=$O(^FHPT(FHDFN,"N",K)) Q:K<1 S X=^(K,0) D P1
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
Q
P1 S N=$P(X,"^",19) I N,'$D(^FH(115.4,N,0))#2 W !,$P(^DPT(DFN,0),"^",1)," - missing Nutrition Status ",N
S N=$P(X,"^",20) I N,'$D(^FH(115.3,N,0))#2 W !,$P(^DPT(DFN,0),"^",1)," - missing Nutrition Classification ",N
Q
ADM S ERR=0
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."
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."
F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"DI",K)) Q:K<1 S X=^(K,0) D DI
F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"SF",K)) Q:K<1 S X=^(K,0) D SF
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
F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"SP",K)) Q:K<1 S N=+$P(^(K,0),"^",2) D SP
F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"DR",K)) Q:K<1 S N=+$P(^(K,0),"^",2) D DR
Q
HDR Q:ERR W !,$P(^DPT(DFN,0),"^",1),?40,"Admission: ",ADM S ERR=1 Q
DI 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
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
Q
SF 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
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
Q
TF I '$D(^FH(118.2,N,0))#2 D HDR W !?5,"Tubefeeding Product ",N," missing from Tubefeeding Order ",K
Q
SP I '$D(^FH(118.3,N,0))#2 D HDR W !?5,"Standing Order Item ",N," missing from Standing Order # ",K
Q
DR I '$D(^FH(119.5,N,0))#2 D HDR W !?5,"Diet Consult ",N," missing from Consult Order # ",K
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHXDB2 2710 printed Sep 23, 2025@19:31:42 Page 2
FHXDB2 ; HISC/REL - Verify patient data base ;11/27/91 13:00
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 if PAT="A"
DO ALL
if PAT="I"
DO INP
WRITE !!,"***** D O N E *****",!
QUIT
ALL WRITE !!,"Verifying Patient data base ^FHPT for ALL Patients & Admissions",!
+1 FOR FHDFN=0:0
SET FHDFN=$ORDER(^FHPT(FHDFN))
if FHDFN<1
QUIT
DO PATNAME^FHOMUTL
if DFN=""
QUIT
DO PAT
FOR ADM=0:0
SET ADM=$ORDER(^FHPT(FHDFN,"A",ADM))
if ADM<1
QUIT
DO ADM
+2 QUIT
INP WRITE !!,"Verifying Patient data base ^FHPT for Current Inpatients Only",!
+1 SET WRD=""
FOR M=0:0
SET WRD=$ORDER(^DPT("CN",WRD))
if WRD=""
QUIT
FOR DFN=0:0
SET DFN=$ORDER(^DPT("CN",WRD,DFN))
if DFN<1
QUIT
SET FHZ115="P"_DFN
DO CHECK^FHOMDPA
if FHDFN=""
QUIT
DO PAT
SET ADM=^DPT("CN",WRD,DFN)
if ADM<1
QUIT
DO ADM
+2 QUIT
PAT SET ERR=0
+1 FOR K=0:0
SET K=$ORDER(^FHPT(FHDFN,"P",K))
if K<1
QUIT
SET X=+^(K,0)
IF '$DATA(^FH(115.2,X,0))#2
WRITE !,$PIECE(^DPT(DFN,0),"^",1)," - missing Food Preference ",X
+2 FOR K=0:0
SET K=$ORDER(^FHPT(FHDFN,"N",K))
if K<1
QUIT
SET X=^(K,0)
DO P1
+3 FOR K=0:0
SET K=$ORDER(^FHPT(FHDFN,"S",K))
if K<1
QUIT
SET X=$PIECE(^(K,0),"^",2)
IF X
IF '$DATA(^FH(115.4,X,0))#2
WRITE !,$PIECE(^DPT(DFN,0),"^",1)," - missing Nutrition Status ",X
+4 QUIT
P1 SET N=$PIECE(X,"^",19)
IF N
IF '$DATA(^FH(115.4,N,0))#2
WRITE !,$PIECE(^DPT(DFN,0),"^",1)," - missing Nutrition Status ",N
+1 SET N=$PIECE(X,"^",20)
IF N
IF '$DATA(^FH(115.3,N,0))#2
WRITE !,$PIECE(^DPT(DFN,0),"^",1)," - missing Nutrition Classification ",N
+2 QUIT
ADM SET ERR=0
+1 SET N=$PIECE(^FHPT(FHDFN,"A",ADM,0),"^",10)
IF N
IF '$DATA(^FH(119.4,N,0))#2
DO HDR
WRITE !?5,"Isolation ",N," missing."
+2 SET N=$PIECE(^FHPT(FHDFN,"A",ADM,0),"^",8)
IF N
IF '$DATA(^FH(119.6,N,0))#2
DO HDR
WRITE !?5,"Dietetic Ward ",N," missing."
+3 FOR K=0:0
SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"DI",K))
if K<1
QUIT
SET X=^(K,0)
DO DI
+4 FOR K=0:0
SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"SF",K))
if K<1
QUIT
SET X=^(K,0)
DO SF
+5 FOR K=0:0
SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"TF",K))
if K<1
QUIT
FOR L=0:0
SET L=$ORDER(^FHPT(FHDFN,"A",ADM,"TF",K,"P",L))
if L<1
QUIT
SET N=+^(L,0)
DO TF
+6 FOR K=0:0
SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"SP",K))
if K<1
QUIT
SET N=+$PIECE(^(K,0),"^",2)
DO SP
+7 FOR K=0:0
SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"DR",K))
if K<1
QUIT
SET N=+$PIECE(^(K,0),"^",2)
DO DR
+8 QUIT
HDR if ERR
QUIT
WRITE !,$PIECE(^DPT(DFN,0),"^",1),?40,"Admission: ",ADM
SET ERR=1
QUIT
DI FOR L=2:1:6
SET N=$PIECE(X,"^",L)
IF N
IF '$DATA(^FH(111,N,0))#2
DO HDR
WRITE !?5,"Diet ",N," missing in Diet Order ",K
+1 SET N=$PIECE(X,"^",13)
IF N
IF '$DATA(^FH(116.2,N,0))#2
DO HDR
WRITE !?5,"Prod. Diet ",N," missing in Diet Order ",K
+2 QUIT
SF FOR L=5:2:27
SET N=$PIECE(X,"^",L)
IF N
IF '$DATA(^FH(118,N,0))#2
DO HDR
WRITE !?5,"Supp. Feeding Item ",N," missing from SF Order ",K
+1 SET N=$PIECE(X,"^",4)
IF N
IF '$DATA(^FH(118.1,N,0))#2
DO HDR
WRITE !?5,"Supp. Feeding Menu ",N," missing from SF Order ",K
+2 QUIT
TF IF '$DATA(^FH(118.2,N,0))#2
DO HDR
WRITE !?5,"Tubefeeding Product ",N," missing from Tubefeeding Order ",K
+1 QUIT
SP IF '$DATA(^FH(118.3,N,0))#2
DO HDR
WRITE !?5,"Standing Order Item ",N," missing from Standing Order # ",K
+1 QUIT
DR IF '$DATA(^FH(119.5,N,0))#2
DO HDR
WRITE !?5,"Diet Consult ",N," missing from Consult Order # ",K
+1 QUIT
