| [613] | 1 | LRCKF64 ;DALOI/KML/RLM-CHECK WKLD CODE FILE FOR DISCREPANCIES ;2/22/87
|
|---|
| 2 | ;;5.2;LAB SERVICE;**272**;Sep 27, 1994
|
|---|
| 3 | ; Reference to ^%ZISC supported by IA #10089
|
|---|
| 4 | ; Reference to CHK^DIE supported by IA #2053
|
|---|
| 5 | ; Reference to ^DD(63.04 supported by IA #999
|
|---|
| 6 | ;
|
|---|
| 7 | S ZTRTN="DQ^LRCKF64",LRCKF="LRCKF64",LRJOB=$J,(LREND,LRWARN)=0
|
|---|
| 8 | D LOG^LRCKF Q:LREND
|
|---|
| 9 | DQ U IO S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 10 | K ^TMP(LRCKF)
|
|---|
| 11 | D ENT,PRT^LRCKF(LRCKF,LRJOB)
|
|---|
| 12 | W !! W:$E(IOST,1,2)="P-" @IOF D ^%ZISC
|
|---|
| 13 | Q
|
|---|
| 14 | ENT ;from LRCKF
|
|---|
| 15 | U IO S LRFL=$P(^LAM(0),U),LRDA=0
|
|---|
| 16 | S LRTMPGL="^TMP(LRCKF,LRJOB,LRFL)",@LRTMPGL=LRFL_" file (#64)"
|
|---|
| 17 | W !!,"Validating "_LRFL_" File (#64)"
|
|---|
| 18 | S DA=0 F S DA=$O(^LAM(DA)) Q:DA<1 D VAL64
|
|---|
| 19 | Q
|
|---|
| 20 | VAL64 ; validate data elements in the WKLD CODE file
|
|---|
| 21 | I $D(^LAM(DA,0))[0 S @LRTMPGL@(DA)=">>FATAL<< - Missing zero node for entry: "_DA Q
|
|---|
| 22 | S LA=^LAM(DA,0)
|
|---|
| 23 | S Z="" D CHK^DIE(64,.01,"E",$P(LA,U),.Z) I Z=U D LABEL S @LRTMPGL@(DA,"64,.01")=">>FATAL<< - The value '"_$P(LA,U)_"' for field PROCEDURE is not valid."
|
|---|
| 24 | I '$L($P(LA,U,2)) D LABEL S @LRTMPGL@(DA,"64,1")=">>FATAL<< - WKLD CODE field (#1) does not contain a value."
|
|---|
| 25 | I $L($P(LA,U,2)) D
|
|---|
| 26 | . S X=$P(LA,U,2) I $A(X)=45!($L(X)>12)!($L(X)<10)!(X'?5N1"."4.5N) D LABEL S @LRTMPGL(DA,"64.1")=">>FATAL<< - WKLD CODE is not valid (field #1)." Q
|
|---|
| 27 | . S X=$O(^LAM("E",$P(LA,U,2),DA)) I X]"" D LABEL S @LRTMPGL@(DA,"64,1")=">>CRITICAL<< - Multiple WKLD CODE cross-references ('E' x-ref) exist for '"_$P(LA,U,2)_"' (field #1)."
|
|---|
| 28 | I $D(^LAB(64.22,+$P(LA,U,7),0))[0 D LABEL S @LRTMPGL@(DA,"64,6")=">>FATAL<< - Invalid UNIT FOR COUNT pointer to WKLD ITEM FOR COUNT file (#64.22)."
|
|---|
| 29 | I $L($P(LA,U,14)),$D(^LAB(64.3,$P(LA,U,14),0))[0 D LABEL S @LRTMPGL@(DA,"64,12")=">>FATAL<< - Invalid MANUFACTURER pointer to WKLD INSTRUMENT MANUFACTURER file (#64.3)."
|
|---|
| 30 | I $D(^LAB(64.21,+$P(LA,U,15),0))[0 D LABEL S @LRTMPGL@(DA,"64,13")=">>FATAL<< - Invalid WKLD CODE LAB SECTION pointer to WKLD CODE LAB SECT file (#64.21)."
|
|---|
| 31 | S LA6=$G(^LAM(DA,6)) I $L($P(LA6,U)),$D(^LRO(68,$P(LA6,U),0))[0 D LABEL S @LRTMPGL@(DA,6,"64,21")=">>FATAL<< - Invalid LOCAL ACC AREA pointer to ACCESSION file (#68)."
|
|---|
| 32 | ; S CODE=0 F S CODE=$O(^LAM(DA,4,CODE)) Q:CODE<1 I $D(^(CODE,0))#2 S LA4=^(0) D CODEV ; this code will become active at a later date
|
|---|
| 33 | S SPEC=0 F S SPEC=$O(^LAM(DA,5,SPEC)) Q:SPEC<1 I $D(^(SPEC,0))#2 S LA5=^(0) D SPECV
|
|---|
| 34 | S NAME=0 F S NAME=$O(^LAM(DA,7,NAME)) Q:NAME<1 I $D(^(NAME,0))#2 S LA7=$P(^(0),U) D ASSOCV
|
|---|
| 35 | Q
|
|---|
| 36 | CODEV ; validation of CODE subfile data elements (multiple 64.018)
|
|---|
| 37 | ; code to be developed as soon as specifications are determined
|
|---|
| 38 | ; TYPE field (#64.018,5) of file 64 will, at some point in time, have
|
|---|
| 39 | ; its DATA TYPE changed from SET OF CODES to a POINTER (according to
|
|---|
| 40 | ; F. Stalling). Once this occurs, then validation of the data element
|
|---|
| 41 | ; in the data file will need to be incorporated into program code.
|
|---|
| 42 | Q
|
|---|
| 43 | SPECV ; validation of SPECIMEN subfile data elements (multiple 64.01)
|
|---|
| 44 | I $L($P(LA5,U)),$D(^LAB(61,$P(LA5,U),0))[0 D LABEL S @LRTMPGL@(DA,5,SPEC,"64.01,.01")=">>FATAL<< - Invalid SPECIMEN pointer to TOPOGRAPHY FIELD file (#61) found at SPECIMEN subfile. Entry: "_SPEC
|
|---|
| 45 | S TIME=0 F S TIME=$O(^LAM(DA,5,SPEC,1,TIME)) Q:TIME<1 I $D(^(TIME,0))#2 S LA5T=^(0) D TIMEV
|
|---|
| 46 | Q
|
|---|
| 47 | TIMEV ; validation of data elements within the TIME ASPECT multiple of the SPECIMEN subfile
|
|---|
| 48 | I $L($P(LA5T,U)),$D(^LAB(64.061,$P(LA5T,U),0))[0 D LABEL D
|
|---|
| 49 | . S @LRTMPGL@(DA,5,SPEC,TIME,"64.02,.01")=">>FATAL<< - Invalid TIME ASPECT pointer to LAB ELECTRONIC CODES file (#64.061) found at TIME ASPECT multiple of the SPECIMEN subfile. Entry: "_SPEC_" Subentry: "_TIME
|
|---|
| 50 | I $L($P(LA5T,U,2)),$D(^LAB(64.061,$P(LA5T,U,2),0))[0 D LABEL D
|
|---|
| 51 | . S @LRTMPGL@(DA,5,SPEC,TIME,"64.02,1")=">>FATAL<< - Invalid UNITS pointer to LAB ELECTRONICS CODES file (#64.061) found at TIME ASPECT multiple of the SPECIMEN subfile. Entry: "_SPEC_" Subentry: "_TIME
|
|---|
| 52 | I $L($P(LA5T,U,3)),$D(^DD(63.04,$P(LA5T,U,3),0))[0 D LABEL S @LRTMPGL@(DA,5,SPEC,TIME,"64.02,2")=">>FATAL<< - Invalid DATA LOCATION found at TIME ASPECT multiple of the SPECIMEN subfile. Entry: "_SPEC_" Subentry: "_TIME
|
|---|
| 53 | I $L($P(LA5T,U,4)),$D(^LAB(60,$P(LA5T,U,4),0))[0 D LABEL D
|
|---|
| 54 | . S @LRTMPGL@(DA,5,SPEC,TIME,"64.02,3")=">>FATAL<< - Invalid TEST pointer to LABORATORY TEST file (#60) found at TIME ASPECT multiple of the SPECIMEN subfile. Entry: "_SPEC_" Subentry: "_TIME
|
|---|
| 55 | Q
|
|---|
| 56 | ASSOCV ; validation of data elements at the ASSOCIATED NAME subfile
|
|---|
| 57 | S X=U_$P(LA7,";",2)_$P(LA7,";")_",0)"
|
|---|
| 58 | I $D(@X)[0 D LABEL S @LRTMPGL@(DA,7,NAME,"64.023,.01")=">>FATAL<< - Invalid VARIABLE POINTER field found at ASSOCIATED NAME subfile for entry "_NAME
|
|---|
| 59 | I LRWARN,$D(^LAM("AE",$P(LA7,";",2),$P(LA7,";"),DA))[0 D LABEL S @LRTMPGL@(DA,7,NAME,"64.023,.01",1)=">>WARNING<< - ASSOCIATED NAME cross-reference does not exist for entry "_NAME
|
|---|
| 60 | Q
|
|---|
| 61 | LABEL ;
|
|---|
| 62 | I LRDA'=DA S @LRTMPGL@(DA)=$P(LA,U) S LRDA=DA
|
|---|
| 63 | Q
|
|---|
