FHXDB ; HISC/REL - Verify data base pointers ;5/14/93 15:50
;;5.5;DIETETICS;;Jan 28, 2005
PAT R !!,"Verify Patient data (ALL, INPATIENTS, NONE): ",PAT:DTIME G:'$T!("^"[PAT) KIL S X=PAT D TR^FH S PAT=X I $P("ALL",PAT,1)'="",$P("INPATIENTS",PAT,1)'="",$P("NONE",PAT,1)'="" W *7," Enter A, I or N" G PAT
S PAT=$E(PAT,1)
W ! K IOP,%ZIS S %ZIS("A")="Select LIST Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP I POP G KIL
I $D(IO("Q")) S FHPGM="Q1^FHXDB",FHLST="PAT" D EN2^FH G KIL
U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL
Q1 ; Process verifying pointer structures
W:$E(IOST,1,2)="C-" @IOF W !!,"VERIFICATION OF DIETETIC POINTER STRUCTURES"
W !!,"Verifying file 111 - Diets"
F K=0:0 S K=$O(^FH(111,K)) Q:K<1 S N=$P(^(K,0),"^",5) I N,'$D(^FH(116.2,N,0))#2 W !?5,"Production diet ",N," missing from Diet ",K," - ",$P(^FH(111,K,0),"^",1)
W !!,"Verifying file 112.6 - User Menu"
F K=0:0 S K=$O(^FHUM(K)) Q:K<1 F L=0:0 S L=$O(^FHUM(K,1,L)) Q:L<1 D U0
W !!,"Verifying file 115.2 - Food Preferences"
F K=0:0 S K=$O(^FH(115.2,K)) Q:K<1 D FP
W !!,"Verifying file 115.7 - Dietetic Encounters"
F K=0:0 S K=$O(^FHEN(K)) Q:K<1 D EN
W !!,"Verifying file 116.2 - Production Diets"
F K=0:0 S K=$O(^FH(116.2,K)) Q:K<1 D P0
W !!,"Verifying file 118 - Supplemental Feedings"
F K=0:0 S K=$O(^FH(118,K)) Q:K<1 D:K'=1 S0
W !!,"Verifying file 118.1 - Supplemental Feeding Menu"
F K=0:0 S K=$O(^FH(118.1,K)) Q:K<1 D S1
W !!,"Verifying file 118.2 - Tubefeeding"
F K=0:0 S K=$O(^FH(118.2,K)) Q:K<1 D TF
W !!,"Verifying file 119.6 - Dietetics Ward"
F K=0:0 S K=$O(^FH(119.6,K)) Q:K<1 D W0
G ^FHXDB1
S1 S X=$G(^FH(118.1,K,1))
F L=1:2:23 S N=$P(X,"^",L) I N,'$D(^FH(118,N,0))#2 W !?5,"Supp. Feeding ",N," missing in Menu ",K," - ",$P(^FH(118,K,0),"^",1)
Q
U0 F M=0:0 S M=$O(^FHUM(K,1,L,1,M)) Q:M<1 F N=0:0 S N=$O(^FHUM(K,1,L,1,M,1,N)) Q:N<1 S X=+^(N,0) I '$D(^FHNU(X,0))#2 W !?5,"Nutrient item ",X," missing in User Menu ",K," day ",L," meal ",M," - ",$P(^FHUM(K,0),"^",1)
Q
FP S X=$P($G(^FH(115.2,K,0)),"^",4)
I X,'$D(^FH(114,X,0))#2 W !?5,"Recipe ",X," missing in Food Preference ",K," - ",$P(^FH(115.2,K,0),"^",1)
F L=0:0 S L=$O(^FH(115.2,K,"X",L)) Q:L<1 S N=+^(L,0) I '$D(^FH(114,N,0))#2 W !?5,"Recipe ",N," missing in Excluded Food Preference ",K," - ",$P(^FH(115.2,K,0),"^",1)
Q
EN S X=$P($G(^FHEN(K,0)),"^",4)
I X,'$D(^FH(115.6,X,0))#2 W !?5,"Encounter Type ",X," missing in Dietetic Encounters ",K
Q
W0 S X=^FH(119.6,K,0) F L=5,6 S N=$P(X,"^",L) I N,'$D(^FH(119.72,N,0))#2 W !?5,"Service Point ",N," missing in Ward File ",K," - ",$P(^FH(119.6,K,0),"^",1)
S N=$P(X,"^",9) I N,'$D(^FH(119.74,N,0))#2 W !?5,"Supplemental Fdg. Site ",N," missing in Ward File ",K," - ",$P(^FH(119.6,K,0),"^",1)
S N=$P(X,"^",8) I N,'$D(^FH(119.73,N,0))#2 W !?5,"Communication Office ",N," missing in Ward File ",K," - ",$P(^FH(119.6,K,0),"^",1)
S N=$P(X,"^",15) I N,'$D(^FH(111,N,0))#2 W !?5,"Diet ",N," missing from Ward File ",K," - ",$P(^FH(119.6,K,0),"^",1)
F L=0:0 S L=$O(^FH(119.6,K,"BN",L)) Q:L<1 S N=+^(L,0) I '$D(^FH(118,N,0))#2 W !?5,"Supp. Feeding ",N,"missing in Ward File ",K," - ",$P(^FH(119.6,K,0),"^",1)
Q
P0 F L=0:0 S L=$O(^FH(116.2,K,"R",L)) Q:L<1 S N=+^(L,0) I '$D(^FH(116.2,N,0))#2 W !?5,"Singular Production Diet ",N," missing in Prod. Diet ",K," - ",$P(^FH(116.2,K,0),"^",1)
Q
S0 S X=$P($G(^FH(118,K,0)),"^",7)
I '$D(^FH(114,+X,0))#2 W !?5,"Recipe ",X," missing in Supplemental Feeding ",K," - ",$P(^FH(118,K,0),"^",1)
Q
TF S X=$P($G(^FH(118.2,K,0)),"^",7)
I '$D(^FH(114,+X,0))#2 W !?5,"Recipe ",X," missing in Tubefeeding ",K," - ",$P(^FH(118.2,K,0),"^",1)
Q
KIL G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHXDB 3658 printed Apr 09, 2024@20:56:33 Page 2
FHXDB ; HISC/REL - Verify data base pointers ;5/14/93 15:50
+1 ;;5.5;DIETETICS;;Jan 28, 2005
PAT READ !!,"Verify Patient data (ALL, INPATIENTS, NONE): ",PAT:DTIME
if '$TEST!("^"[PAT)
GOTO KIL
SET X=PAT
DO TR^FH
SET PAT=X
IF $PIECE("ALL",PAT,1)'=""
IF $PIECE("INPATIENTS",PAT,1)'=""
IF $PIECE("NONE",PAT,1)'=""
WRITE *7," Enter A, I or N"
GOTO PAT
+1 SET PAT=$EXTRACT(PAT,1)
+2 WRITE !
KILL IOP,%ZIS
SET %ZIS("A")="Select LIST Printer: "
SET %ZIS="MQ"
DO ^%ZIS
KILL %ZIS,IOP
IF POP
GOTO KIL
+3 IF $DATA(IO("Q"))
SET FHPGM="Q1^FHXDB"
SET FHLST="PAT"
DO EN2^FH
GOTO KIL
+4 USE IO
DO Q1
DO ^%ZISC
KILL %ZIS,IOP
GOTO KIL
Q1 ; Process verifying pointer structures
+1 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
WRITE !!,"VERIFICATION OF DIETETIC POINTER STRUCTURES"
+2 WRITE !!,"Verifying file 111 - Diets"
+3 FOR K=0:0
SET K=$ORDER(^FH(111,K))
if K<1
QUIT
SET N=$PIECE(^(K,0),"^",5)
IF N
IF '$DATA(^FH(116.2,N,0))#2
WRITE !?5,"Production diet ",N," missing from Diet ",K," - ",$PIECE(^FH(111,K,0),"^",1)
+4 WRITE !!,"Verifying file 112.6 - User Menu"
+5 FOR K=0:0
SET K=$ORDER(^FHUM(K))
if K<1
QUIT
FOR L=0:0
SET L=$ORDER(^FHUM(K,1,L))
if L<1
QUIT
DO U0
+6 WRITE !!,"Verifying file 115.2 - Food Preferences"
+7 FOR K=0:0
SET K=$ORDER(^FH(115.2,K))
if K<1
QUIT
DO FP
+8 WRITE !!,"Verifying file 115.7 - Dietetic Encounters"
+9 FOR K=0:0
SET K=$ORDER(^FHEN(K))
if K<1
QUIT
DO EN
+10 WRITE !!,"Verifying file 116.2 - Production Diets"
+11 FOR K=0:0
SET K=$ORDER(^FH(116.2,K))
if K<1
QUIT
DO P0
+12 WRITE !!,"Verifying file 118 - Supplemental Feedings"
+13 FOR K=0:0
SET K=$ORDER(^FH(118,K))
if K<1
QUIT
if K'=1
DO S0
+14 WRITE !!,"Verifying file 118.1 - Supplemental Feeding Menu"
+15 FOR K=0:0
SET K=$ORDER(^FH(118.1,K))
if K<1
QUIT
DO S1
+16 WRITE !!,"Verifying file 118.2 - Tubefeeding"
+17 FOR K=0:0
SET K=$ORDER(^FH(118.2,K))
if K<1
QUIT
DO TF
+18 WRITE !!,"Verifying file 119.6 - Dietetics Ward"
+19 FOR K=0:0
SET K=$ORDER(^FH(119.6,K))
if K<1
QUIT
DO W0
+20 GOTO ^FHXDB1
S1 SET X=$GET(^FH(118.1,K,1))
+1 FOR L=1:2:23
SET N=$PIECE(X,"^",L)
IF N
IF '$DATA(^FH(118,N,0))#2
WRITE !?5,"Supp. Feeding ",N," missing in Menu ",K," - ",$PIECE(^FH(118,K,0),"^",1)
+2 QUIT
U0 FOR M=0:0
SET M=$ORDER(^FHUM(K,1,L,1,M))
if M<1
QUIT
FOR N=0:0
SET N=$ORDER(^FHUM(K,1,L,1,M,1,N))
if N<1
QUIT
SET X=+^(N,0)
IF '$DATA(^FHNU(X,0))#2
WRITE !?5,"Nutrient item ",X," missing in User Menu ",K," day ",L," meal ",M," - ",$PIECE(^FHUM(K,0),"^",1)
+1 QUIT
FP SET X=$PIECE($GET(^FH(115.2,K,0)),"^",4)
+1 IF X
IF '$DATA(^FH(114,X,0))#2
WRITE !?5,"Recipe ",X," missing in Food Preference ",K," - ",$PIECE(^FH(115.2,K,0),"^",1)
+2 FOR L=0:0
SET L=$ORDER(^FH(115.2,K,"X",L))
if L<1
QUIT
SET N=+^(L,0)
IF '$DATA(^FH(114,N,0))#2
WRITE !?5,"Recipe ",N," missing in Excluded Food Preference ",K," - ",$PIECE(^FH(115.2,K,0),"^",1)
+3 QUIT
EN SET X=$PIECE($GET(^FHEN(K,0)),"^",4)
+1 IF X
IF '$DATA(^FH(115.6,X,0))#2
WRITE !?5,"Encounter Type ",X," missing in Dietetic Encounters ",K
+2 QUIT
W0 SET X=^FH(119.6,K,0)
FOR L=5,6
SET N=$PIECE(X,"^",L)
IF N
IF '$DATA(^FH(119.72,N,0))#2
WRITE !?5,"Service Point ",N," missing in Ward File ",K," - ",$PIECE(^FH(119.6,K,0),"^",1)
+1 SET N=$PIECE(X,"^",9)
IF N
IF '$DATA(^FH(119.74,N,0))#2
WRITE !?5,"Supplemental Fdg. Site ",N," missing in Ward File ",K," - ",$PIECE(^FH(119.6,K,0),"^",1)
+2 SET N=$PIECE(X,"^",8)
IF N
IF '$DATA(^FH(119.73,N,0))#2
WRITE !?5,"Communication Office ",N," missing in Ward File ",K," - ",$PIECE(^FH(119.6,K,0),"^",1)
+3 SET N=$PIECE(X,"^",15)
IF N
IF '$DATA(^FH(111,N,0))#2
WRITE !?5,"Diet ",N," missing from Ward File ",K," - ",$PIECE(^FH(119.6,K,0),"^",1)
+4 FOR L=0:0
SET L=$ORDER(^FH(119.6,K,"BN",L))
if L<1
QUIT
SET N=+^(L,0)
IF '$DATA(^FH(118,N,0))#2
WRITE !?5,"Supp. Feeding ",N,"missing in Ward File ",K," - ",$PIECE(^FH(119.6,K,0),"^",1)
+5 QUIT
P0 FOR L=0:0
SET L=$ORDER(^FH(116.2,K,"R",L))
if L<1
QUIT
SET N=+^(L,0)
IF '$DATA(^FH(116.2,N,0))#2
WRITE !?5,"Singular Production Diet ",N," missing in Prod. Diet ",K," - ",$PIECE(^FH(116.2,K,0),"^",1)
+1 QUIT
S0 SET X=$PIECE($GET(^FH(118,K,0)),"^",7)
+1 IF '$DATA(^FH(114,+X,0))#2
WRITE !?5,"Recipe ",X," missing in Supplemental Feeding ",K," - ",$PIECE(^FH(118,K,0),"^",1)
+2 QUIT
TF SET X=$PIECE($GET(^FH(118.2,K,0)),"^",7)
+1 IF '$DATA(^FH(114,+X,0))#2
WRITE !?5,"Recipe ",X," missing in Tubefeeding ",K," - ",$PIECE(^FH(118.2,K,0),"^",1)
+2 QUIT
KIL GOTO KILL^XUSCLEAN
