source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCKPTR.m@ 1006

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1LRCKPTR ;SLC/RWF - CHECK ^LR & ^DPT CROSS POINTERS ; 8/30/87 17:20 ;
2 ;;5.2;LAB SERVICE;**272,293**;Sep 27, 1994
3 W !,"CHECK OF POINTERS TO/FROM THE ^LR FILE",!!,"Want me to add missing nodes. " S %=2,U="^" D YN^DICN I %<1 W:%=0 !!,"a 'yes' and I will add missing zero nodes that are reported,",!," and missing pointers to ^LR." Q:%<0 G LRCKPTR
4 S LRFIX=(%=1)
5 S DFN=0,%ZIS="Q" D ^%ZIS Q:POP
6 I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^LRCKPTR",ZTSAVE("LRFIX")="",ZTDESC="Integrity Report" D ^%ZTLOAD K ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTSK D ^%ZISC Q
7DQ S:$D(ZTQUEUED) ZTREQ="@" D ENT W !! W:$E(IOST,1,2)="P-" @IOF K LRFIX Q
8ENT ;from LRCKF
9 U IO W ! S:'$D(LRFIX) LRFIX=0
10 F LRF=0:0 S LRF=$O(^DIC("AC","LR",LRF)) Q:LRF'>0 D LRP
11 G LRS
12LRP S U="^",DFN=0,DIC=$S($D(^DIC(LRF,0,"GL")):^("GL"),1:"") I DIC'[U W !,"BAD ENTRY IN APPLICATION GROUP" Q
13 W !,"CHECKING THE ",$P(^DIC(LRF,0),U)," FILE (#",LRF,") POINTERS.",!
14DPT S @("DFN=$O("_DIC_"DFN))") G END:DFN'>0 S @("D=$D("_DIC_"DFN,""LR""))[0") G DPT:D S LR=^("LR")
15 I LR'>0!(+LR'=LR) W !,"Entry: ",DFN," has a invalid LR Pointer: '",LR,"'." G DPT
16 W:'$D(^LR(LR,0)) !,"Entry: ",DFN," Pointer to MISSING node LR: ",LR
17 IF $D(^LR(LR,0))[0 W !,"LR: ",LR," Is missing the zero node." S:LRFIX ^LR(LR,0)=LR_U_LRF_U_DFN W:LRFIX " added" G DPT
18 S X=^LR(LR,0),LRDPF=$P(X,U,2) W:LRDPF'=LRF !,"Entry: ",DFN," points to LR: ",LR," Which doesn't point back to this file.",!?5," ^LR points to file: ",LRDPF
19 W:$P(X,U,3)'=DFN !,"Entry: ",DFN," Points to a entry that points to Entry: ",$P(X,U,3)
20 G DPT
21LRS S LR=0 W !!,"CHECKING THE LAB DATA FILE POINTERS.",!
22LR S LR=$O(^LR(LR)) G END:LR'>0 I $D(^LR(LR,0))[0 W !,"LR: ",LR," Lacks a zero node." G LR
23 S LRDPF=+$P(^LR(LR,0),U,2),DFN=+$P(^(0),U,3),LRGBL=$S(LRDPF=2:"^DPT(",1:$S($D(^DIC(LRDPF,0,"GL")):^("GL"),1:""))_DFN_","
24 I LRDPF<2!(DFN'>0) W !,"LR: ",LR," has a BAD file or entry pointer. File: ",LRDPF," Entry: ",DFN G LR
25 I $D(^DIC(LRDPF,0,"GL"))[0 W !,"LR: ",LR,?11," Points to a BAD file: ",LRDPF G LR
26 I @("$D("_LRGBL_"0))[0") W !,"LR: ",LR,?11," Points to a missing ",$P(^DIC(LRDPF,0),U)," FILE ENTRY, Entry: ",DFN S:LRFIX @(LRGBL_"0)=""LOST,PT."""),@(LRGBL_"""LR"")="_LR) W:LRFIX " added" G LR
27 I @("$D("_LRGBL_"""LR""))[0") W !,"LR: ",LR,?11," Points to file: ",LRDPF," Entry: ",DFN,", that doesn't have a pointer." S:LRFIX @(LRGBL_"""LR"")="_LR) W:LRFIX " added" G LR
28 W:@(LRGBL_"""LR"")")'=LR !,"LR: ",LR,?11," Points to file: ",LRDPF," Entry: ",DFN,", That points to LR: ",^("LR")
29 G LR
30END K LRGBL W !,"ALL DONE",! W:$E(IOST,1,2)="P-" @IOF Q
31 Q
Note: See TracBrowser for help on using the repository browser.