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