- 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
- 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
