- LRCKFLAA ;DALOI/RWF/RLM-CHECK LOAD LIST & AUTO INSTRUMENT FILES (CONT);2/5/91 12:32
- ;;5.2T9;LR;**1018**;Nov 17, 2004
- ;;5.2;LAB SERVICE;**272**;Sep 27, 1994
- ; Reference to CHK^DIE supported by IA #2053
- ; Reference to $$FMTE^XLFDT supported by IA #10103
- ; Reference to ^VA(200 supported by IA #10060
- ;
- Q ;Continuation of LRCKFLA
- TRAY ; validation of RUN or TRAY NUMBER subfile data elements (Node 1).
- ; Several multiples are contained within this subfile:
- ; RUN or TRAY NUMBER (multiple #68.21)
- ; SEQUENCE or CUP NUMBER (multiple #68.22)
- ; TESTS (multiple #68.222)
- ; TEST or PANEL NUMBER (multiple #68.225)
- I LRWARN,$D(^LRO(68.2,DA,1,0))[0 D LABEL S @LRTMPGL@(DA,"68.2,2")=">>WARNING<< - Missing nodes at the RUN OR TRAY NUMBER subfile (Multiple #68.21)." Q
- S RUN=0 F S RUN=$O(^LRO(68.2,DA,1,RUN)) Q:RUN<1 I $D(^(RUN,0))#2 S LA1=^(0) D TRAYV
- Q
- TRAYV ;
- I $D(^VA(200,+$P(LA1,U,3),0))[0 D LABEL S @LRTMPGL@(DA,1,RUN,"68.21,3")=">>FATAL<< - Invalid TECH pointer to NEW PERSON file (#200) for entry "_RUN_" at RUN or TRAY NUMBER subfile."
- I $D(^LRO(68,+$P(LA1,U,4),0))[0 D LABEL S @LRTMPGL@(DA,1,RUN,"68.21,4")=">>FATAL<< - Invalid ACCESSION AREA pointer to ACCESSION file (#68) for entry "_RUN_" at RUN or TRAY NUMBER subfile."
- S Z="",X=$P($G(^LRO(68,+$P(LA1,U,4),0)),U) I $L(X) D CHK^DIE(68.21,4,"E",X,.Z) I Z=U D
- . D LABEL S @LRTMPGL@(DA,1,RUN,"68.21,4",1)=">>CRITICAL<< - The value '"_X_"' for field ACCESSION AREA in RUN or TRAY NUMBER subfile is not valid. Only accession areas identified as work areas are valid. Entry: "_RUN
- S SEQ=0 F S SEQ=$O(^LRO(68.2,DA,1,RUN,1,SEQ)) Q:SEQ<1 I $D(^(SEQ,0))#2 S LA1S=^(0) D SEQCUP
- Q
- SEQCUP ; validation for data elements at SEQUENCE or CUP NUMBER, TESTS multiples at the RUN or TRAY NUMBER subfile
- I $D(^LRO(68,+$P(LA1S,U),0))[0 D LABEL D
- . S @LRTMPGL@(DA,1,RUN,SEQ,"68.22,.01")=">>FATAL<< - Invalid ACCESSION AREA pointer to ACCESSION file (#68) found in SEQUENCE or CUP NUMBER multiple of RUN or TRAY NUMBER subfile. Entry: "_RUN_" Subentry: "_SEQ
- S Z="",X=$P($G(^LRO(68,$P(LA1S,U),0)),U) I $L(X) D CHK^DIE(68.22,.01,"E",X,.Z) I Z=U D
- . D LABEL S @LRTMPGL@(DA,1,RUN,SEQ,"68.22,.01",1)=">>CRITICAL<< - The value '"_X_"' for field ACCESSION AREA in SEQUENCE or CUP NUMBER multiple of RUN or TRAY NUMBER subfile is not valid."
- . S @LRTMPGL@(DA,1,RUN,SEQ,"68.22,.01",2)="Only accession area identified as work areas are valid. Entry: "_RUN_" Subentry: "_SEQ
- D CHK^DIE(68.22,3,"E",$P(LA1S,U,4),.Z) I Z=U D LABEL D
- . S @LRTMPGL@(DA,1,RUN,SEQ,"68.22,3")=">>FATAL<< - The value '"_$P(LA1S,U,4)_"' for field PROFILE in SEQUENCE or CUP NUMBER multiple of RUN or TRAY NUMBER subfile is not valid. Entry: "_RUN_" Subentry: "_SEQ
- I $L($P(LA1S,U,5)),$D(^LAB(61,$P(LA1S,U,5),0))[0 D LABEL D
- . S @LRTMPGL@(DA,1,RUN,SEQ,"68.22,4")=">>FATAL<< - Invalid SPECIMEN pointer to TOPOGRAPHY FIELD file (#61) found in SEQUENCE or CUP NUMBER multiple of RUN or TRAY NUMBER subfile. Entry: "_RUN_" Subentry: "_SEQ
- S TST=0 F S TST=$O(^LRO(68.2,DA,1,RUN,1,SEQ,1,TST)) Q:TST<1 I $D(^(TST,0))#2 S LA1T=+^(0) I $D(^LAB(60,LA1T,0))[0 D LABEL D
- . S @LRTMPGL@(DA,1,RUN,SEQ,TST,"68.222,.01")=">>FATAL<< - Invalid TEST pointer to LABORATORY TEST file (#60) found in TESTS multiple within the SEQUENCE or CUP NUMBER multiple of RUN or TRAY NUMBER subfile. Entry: "_RUN_" Subentry: "_SEQ
- Q
- PROFILE ; validation of PROFILE subfile data elements (node 10)
- ; Several multiples are contained within this subfile:
- ; PROFILE (multiple #68.23)
- ; TEST (multiple #68.24)
- ; TRAY # FOR CONTROL (multiple #68.25)
- ; CONTROL (multiple #68.26)
- ; CONTROLS TO BEGIN WORKLIST (multiple #68.28)
- ; CONTROLS TO END WORKLIST (multiple #68.29)
- I LRWARN,$D(^LRO(68.2,DA,10,0))[0 D LABEL S @LRTMPGL@(DA,"68.2,50")=">>WARNING<<- PROFILE subfile NOT defined." Q
- S PROF=0,LRPROF="" F S PROF=$O(^LRO(68.2,DA,10,PROF)) Q:PROF<1 D PROFILV
- Q
- PROFILV ;
- I $D(^LRO(68.2,DA,10,PROF,0))[0 D LABEL S @LRTMPGL@(DA,10,PROF,"68.23,.01")=">>FATAL - Missing PROFILE subfile for entry "_PROF Q
- S:$D(^LRO(68.2,DA,10,PROF,0))#2 LA10="profile: "_^(0)
- I $D(^LRO(68,+$P(LA10,U,2),0))[0 D LABEL S @LRTMPGL@(DA,10,PROF,"68.23,2")=">>FATAL<< - Invalid ACCESSION AREA pointer to the ACCESSION file (#68) at the PROFILE subfile for entry "_PROF
- S X=$P($G(^LRO(68,+$P(LA10,U,2),0)),U),Z="" I $L(X) D CHK^DIE(68.23,2,"E",X,.Z) I Z=U D LABEL D
- . S @LRTMPGL@(DA,10,PROF,"68.23,2",1)=">>CRITICAL<< - The value '"_X_"' for field ACCESSION AREA in PROFILE subfile is not valid. Only accession areas identified as work areas are valid. Entry: "_PROF
- S B=1,I=0 F S I=$O(^LRO(68.2,DA,10,PROF,1,I)) Q:I<1 I $D(^(I,0))#2 D
- . S X=^(0),B=(B&$P(X,U,3)) I $D(^LAB(60,+X,0))[0 D LABEL S @LRTMPGL@(DA,10,PROF,I,"63.24,.01")=">>FATAL<< - Invalid TEST pointer to the LABORATORY TEST file (#60) at the TEST multiple of the PROFILE subfile. Entry: "_PROF_" Subentry: "_I
- I B D LABEL S @LRTMPGL@(DA,10,PROF,1,I,"68.24,2")=">>FATAL<< - At least one test of the panel must NOT be BUILD LABEL ONLY at the TEST multiple of the PROFILE subfile."
- I LRWARN,'$P(LA,U,3) S C1=$O(^LRO(68.2,DA,10,PROF,2,1)) I C1>0 D LABEL S @LRTMPGL@(DA,10,PROF,2,1,"68.23,3")=">>WARNING<< - A sequence/batch should NOT have a control TRAY "_C1_" defined. Entry: "_PROF
- F LR45=4,5 D
- . D SET45
- . S C=0 F S C=$O(^LRO(68.2,DA,10,PROF,LR45,C)) Q:C'>0 I $D(^(C,0))#2 S X=+^(0) D CHKCTR
- Q
- CHKCTR ; validation of data elements at the CONTROLS TO BEGIN WORKLIST, CONTROLS TO END WORKLIST multiples
- I $D(^LAB(62.3,X,0))[0 D LABEL S @LRTMPGL@(DA,10,PROF,LR45,C,LRFIELD)=">>FATAL<< - Invalid CONTROLS TO "_LRLIT_" WORKLIST pointer to LAB CONTROL NAME file (#62.3). Entry: "_PROF_" Subentry: "_C Q
- S (B,J)=0 F S J=$O(^LAB(62.3,X,2,J)) Q:J<1 I $D(^(J,0))#2 S T=+^(0) I $D(^LRO(68.2,DA,10,PROF,1,"B",T)) S B=1
- I 'B D LABEL S @LRTMPGL@(DA,10,PROF,LR45,C,LRFIELD)=">>FATAL<< - CONTROL: "_$P(^LAB(62.3,X,0),U)_" has no tests to accession for this profile for "_LRLIT_" WORKLIST. Entry: "_PROF_" Subentry: "_C
- Q:'LRWARN
- S LREXPDT=+$P(^LAB(62.3,X,0),U,2)
- I 'LREXPDT D LABEL S @LRTMPGL@(DA,10,PROF,LR45,C,LRFIELD)=">>WARNING<< - CONTROL: "_$P(^LAB(62.3,X,0),U)_" does not have an EXPIRATION DATE for "_LRLIT_" WORKLIST. Entry: "_PROF_" Subentry: "_C Q
- I LREXPDT<DT D LABEL S @LRTMPGL@(DA,10,PROF,LR45,C,LRFIELD)=">>WARNING<< - CONTROL: "_$P(^LAB(62.3,X,0),U)_" contains an expired EXPIRATION DATE: "_$$FMTE^XLFDT($P(^LAB(62.3,X,0),U,2),"")_" for "_LRLIT_" WORKLIST. Entry: "_PROF_" Subentry: "_C
- Q
- SUFFIX ; validation of "SUF" node data elements
- Q:'$D(^LRO(68.2,DA,"SUF"))
- S LASUF=^LRO(68.2,DA,"SUF")
- I $D(^LAB(64.2,+LASUF,0))[0 D LABEL S @LRTMPGL@(DA,"68.2,.14")=">>FATAL<< - Invalid WKLD METHOD pointer to WKLD SUFFIX CODES file (#64.2)"
- I $L($P(LASUF,U,7)),$D(^LRO(68,+$P(LASUF,U,7),0))[0 D LABEL S @LRTMPGL@(DA,"68.2,1")=">>FATAL<< - Invalid MAJOR ACCESSION AREA pointer to ACCESSION file (#68)"
- I $L($P(LASUF,U,8)),$D(^LRO(68,+$P(LASUF,U,8),0))[0 D LABEL S @LRTMPGL@(DA,"68.2,1.5")=">>FATAL<< - Invalid LAB SUBSECTION pointer to ACCESSION file (#68)"
- I $L($P(LASUF,U,9)) D
- . I $D(^LRO(68,$P(LASUF,U,9),0))[0 D LABEL S @LRTMPGL@(DA,"68.2,1.7")=">>FATAL<< - Invalid WORK AREA pointer to ACCESSION file (#68)" Q
- . I LRWARN S X=$P(^LRO(68,$P(LASUF,U,9),0),U),Z="" D CHK^DIE(68.2,1.7,"E",X,.Z) D
- . . I Z=U D LABEL S @LRTMPGL@(DA,"68.2,1.7")=">>CRITICAL<< - The value '"_X_"' for field WORK AREA is not valid. Only accession areas identified as work areas are valid."
- Q
- LABEL ;
- I LRDA'=DA S @LRTMPGL@(DA)=$P(LA,U) S LRDA=DA
- I $D(LA10),$P(LA10,U)'=LRPROF S (LRPROF,@LRTMPGL@(DA,10,PROF))=$P(LA10,U)
- Q
- SET45 ;
- ; variable assignment during processing of controls to begin and end
- ; worklist data elements
- S LRFIELD=$S(LR45=4:"68.28,.01",1:"68.29,.01"),LRLIT=$S(LR45=4:"BEGIN",1:"END")
- Q
- LRCKFLAA ;DALOI/RWF/RLM-CHECK LOAD LIST & AUTO INSTRUMENT FILES (CONT);2/5/91 12:32
- +1 ;;5.2T9;LR;**1018**;Nov 17, 2004
- +2 ;;5.2;LAB SERVICE;**272**;Sep 27, 1994
- +3 ; Reference to CHK^DIE supported by IA #2053
- +4 ; Reference to $$FMTE^XLFDT supported by IA #10103
- +5 ; Reference to ^VA(200 supported by IA #10060
- +6 ;
- +7 ;Continuation of LRCKFLA
- QUIT
- TRAY ; validation of RUN or TRAY NUMBER subfile data elements (Node 1).
- +1 ; Several multiples are contained within this subfile:
- +2 ; RUN or TRAY NUMBER (multiple #68.21)
- +3 ; SEQUENCE or CUP NUMBER (multiple #68.22)
- +4 ; TESTS (multiple #68.222)
- +5 ; TEST or PANEL NUMBER (multiple #68.225)
- +6 IF LRWARN
- IF $DATA(^LRO(68.2,DA,1,0))[0
- DO LABEL
- SET @LRTMPGL@(DA,"68.2,2")=">>WARNING<< - Missing nodes at the RUN OR TRAY NUMBER subfile (Multiple #68.21)."
- QUIT
- +7 SET RUN=0
- FOR
- SET RUN=$ORDER(^LRO(68.2,DA,1,RUN))
- IF RUN<1
- QUIT
- IF $DATA(^(RUN,0))#2
- SET LA1=^(0)
- DO TRAYV
- +8 QUIT
- TRAYV ;
- +1 IF $DATA(^VA(200,+$PIECE(LA1,U,3),0))[0
- DO LABEL
- SET @LRTMPGL@(DA,1,RUN,"68.21,3")=">>FATAL<< - Invalid TECH pointer to NEW PERSON file (#200) for entry "_RUN_" at RUN or TRAY NUMBER subfile."
- +2 IF $DATA(^LRO(68,+$PIECE(LA1,U,4),0))[0
- DO LABEL
- SET @LRTMPGL@(DA,1,RUN,"68.21,4")=">>FATAL<< - Invalid ACCESSION AREA pointer to ACCESSION file (#68) for entry "_RUN_" at RUN or TRAY NUMBER subfile."
- +3 SET Z=""
- SET X=$PIECE($GET(^LRO(68,+$PIECE(LA1,U,4),0)),U)
- IF $LENGTH(X)
- DO CHK^DIE(68.21,4,"E",X,.Z)
- IF Z=U
- Begin DoDot:1
- +4 DO LABEL
- SET @LRTMPGL@(DA,1,RUN,"68.21,4",1)=">>CRITICAL<< - The value '"_X_"' for field ACCESSION AREA in RUN or TRAY NUMBER subfile is not valid. Only accession areas identified as work areas are valid. Entry: "_RUN
- End DoDot:1
- +5 SET SEQ=0
- FOR
- SET SEQ=$ORDER(^LRO(68.2,DA,1,RUN,1,SEQ))
- IF SEQ<1
- QUIT
- IF $DATA(^(SEQ,0))#2
- SET LA1S=^(0)
- DO SEQCUP
- +6 QUIT
- SEQCUP ; validation for data elements at SEQUENCE or CUP NUMBER, TESTS multiples at the RUN or TRAY NUMBER subfile
- +1 IF $DATA(^LRO(68,+$PIECE(LA1S,U),0))[0
- DO LABEL
- Begin DoDot:1
- +2 SET @LRTMPGL@(DA,1,RUN,SEQ,"68.22,.01")=">>FATAL<< - Invalid ACCESSION AREA pointer to ACCESSION file (#68) found in SEQUENCE or CUP NUMBER multiple of RUN or TRAY NUMBER subfile. Entry: "_RUN_" Subentry: "_SEQ
- End DoDot:1
- +3 SET Z=""
- SET X=$PIECE($GET(^LRO(68,$PIECE(LA1S,U),0)),U)
- IF $LENGTH(X)
- DO CHK^DIE(68.22,.01,"E",X,.Z)
- IF Z=U
- Begin DoDot:1
- +4 DO LABEL
- SET @LRTMPGL@(DA,1,RUN,SEQ,"68.22,.01",1)=">>CRITICAL<< - The value '"_X_"' for field ACCESSION AREA in SEQUENCE or CUP NUMBER multiple of RUN or TRAY NUMBER subfile is not valid."
- +5 SET @LRTMPGL@(DA,1,RUN,SEQ,"68.22,.01",2)="Only accession area identified as work areas are valid. Entry: "_RUN_" Subentry: "_SEQ
- End DoDot:1
- +6 DO CHK^DIE(68.22,3,"E",$PIECE(LA1S,U,4),.Z)
- IF Z=U
- DO LABEL
- Begin DoDot:1
- +7 SET @LRTMPGL@(DA,1,RUN,SEQ,"68.22,3")=">>FATAL<< - The value '"_$PIECE(LA1S,U,4)_"' for field PROFILE in SEQUENCE or CUP NUMBER multiple of RUN or TRAY NUMBER subfile is not valid. Entry: "_RUN_" Subentry: "_SEQ
- End DoDot:1
- +8 IF $LENGTH($PIECE(LA1S,U,5))
- IF $DATA(^LAB(61,$PIECE(LA1S,U,5),0))[0
- DO LABEL
- Begin DoDot:1
- +9 SET @LRTMPGL@(DA,1,RUN,SEQ,"68.22,4")=">>FATAL<< - Invalid SPECIMEN pointer to TOPOGRAPHY FIELD file (#61) found in SEQUENCE or CUP NUMBER multiple of RUN or TRAY NUMBER subfile. Entry: "_RUN_" Subentry: "_SEQ
- End DoDot:1
- +10 SET TST=0
- FOR
- SET TST=$ORDER(^LRO(68.2,DA,1,RUN,1,SEQ,1,TST))
- IF TST<1
- QUIT
- IF $DATA(^(TST,0))#2
- SET LA1T=+^(0)
- IF $DATA(^LAB(60,LA1T,0))[0
- DO LABEL
- Begin DoDot:1
- +11 SET @LRTMPGL@(DA,1,RUN,SEQ,TST,"68.222,.01")=">>FATAL<< - Invalid TEST pointer to LABORATORY TEST file (#60) found in TESTS multiple within the SEQUENCE or CUP NUMBER multiple of RUN or TRAY NUMBER subfile. Entry: "_RUN_" Subent
- ry: "_SEQ
- End DoDot:1
- +12 QUIT
- PROFILE ; validation of PROFILE subfile data elements (node 10)
- +1 ; Several multiples are contained within this subfile:
- +2 ; PROFILE (multiple #68.23)
- +3 ; TEST (multiple #68.24)
- +4 ; TRAY # FOR CONTROL (multiple #68.25)
- +5 ; CONTROL (multiple #68.26)
- +6 ; CONTROLS TO BEGIN WORKLIST (multiple #68.28)
- +7 ; CONTROLS TO END WORKLIST (multiple #68.29)
- +8 IF LRWARN
- IF $DATA(^LRO(68.2,DA,10,0))[0
- DO LABEL
- SET @LRTMPGL@(DA,"68.2,50")=">>WARNING<<- PROFILE subfile NOT defined."
- QUIT
- +9 SET PROF=0
- SET LRPROF=""
- FOR
- SET PROF=$ORDER(^LRO(68.2,DA,10,PROF))
- IF PROF<1
- QUIT
- DO PROFILV
- +10 QUIT
- PROFILV ;
- +1 IF $DATA(^LRO(68.2,DA,10,PROF,0))[0
- DO LABEL
- SET @LRTMPGL@(DA,10,PROF,"68.23,.01")=">>FATAL - Missing PROFILE subfile for entry "_PROF
- QUIT
- +2 IF $DATA(^LRO(68.2,DA,10,PROF,0))#2
- SET LA10="profile: "_^(0)
- +3 IF $DATA(^LRO(68,+$PIECE(LA10,U,2),0))[0
- DO LABEL
- SET @LRTMPGL@(DA,10,PROF,"68.23,2")=">>FATAL<< - Invalid ACCESSION AREA pointer to the ACCESSION file (#68) at the PROFILE subfile for entry "_PROF
- +4 SET X=$PIECE($GET(^LRO(68,+$PIECE(LA10,U,2),0)),U)
- SET Z=""
- IF $LENGTH(X)
- DO CHK^DIE(68.23,2,"E",X,.Z)
- IF Z=U
- DO LABEL
- Begin DoDot:1
- +5 SET @LRTMPGL@(DA,10,PROF,"68.23,2",1)=">>CRITICAL<< - The value '"_X_"' for field ACCESSION AREA in PROFILE subfile is not valid. Only accession areas identified as work areas are valid. Entry: "_PROF
- End DoDot:1
- +6 SET B=1
- SET I=0
- FOR
- SET I=$ORDER(^LRO(68.2,DA,10,PROF,1,I))
- IF I<1
- QUIT
- IF $DATA(^(I,0))#2
- Begin DoDot:1
- +7 SET X=^(0)
- SET B=(B&$PIECE(X,U,3))
- IF $DATA(^LAB(60,+X,0))[0
- DO LABEL
- SET @LRTMPGL@(DA,10,PROF,I,"63.24,.01")=">>FATAL<< - Invalid TEST pointer to the LABORATORY TEST file (#60) at the TEST multiple of the PROFILE subfile. Entry: "_PROF_" Subentry: "_I
- End DoDot:1
- +8 IF B
- DO LABEL
- SET @LRTMPGL@(DA,10,PROF,1,I,"68.24,2")=">>FATAL<< - At least one test of the panel must NOT be BUILD LABEL ONLY at the TEST multiple of the PROFILE subfile."
- +9 IF LRWARN
- IF '$PIECE(LA,U,3)
- SET C1=$ORDER(^LRO(68.2,DA,10,PROF,2,1))
- IF C1>0
- DO LABEL
- SET @LRTMPGL@(DA,10,PROF,2,1,"68.23,3")=">>WARNING<< - A sequence/batch should NOT have a control TRAY "_C1_" defined. Entry: "_PROF
- +10 FOR LR45=4,5
- Begin DoDot:1
- +11 DO SET45
- +12 SET C=0
- FOR
- SET C=$ORDER(^LRO(68.2,DA,10,PROF,LR45,C))
- IF C'>0
- QUIT
- IF $DATA(^(C,0))#2
- SET X=+^(0)
- DO CHKCTR
- End DoDot:1
- +13 QUIT
- CHKCTR ; validation of data elements at the CONTROLS TO BEGIN WORKLIST, CONTROLS TO END WORKLIST multiples
- +1 IF $DATA(^LAB(62.3,X,0))[0
- DO LABEL
- SET @LRTMPGL@(DA,10,PROF,LR45,C,LRFIELD)=">>FATAL<< - Invalid CONTROLS TO "_LRLIT_" WORKLIST pointer to LAB CONTROL NAME file (#62.3). Entry: "_PROF_" Subentry: "_C
- QUIT
- +2 SET (B,J)=0
- FOR
- SET J=$ORDER(^LAB(62.3,X,2,J))
- IF J<1
- QUIT
- IF $DATA(^(J,0))#2
- SET T=+^(0)
- IF $DATA(^LRO(68.2,DA,10,PROF,1,"B",T))
- SET B=1
- +3 IF 'B
- DO LABEL
- SET @LRTMPGL@(DA,10,PROF,LR45,C,LRFIELD)=">>FATAL<< - CONTROL: "_$PIECE(^LAB(62.3,X,0),U)_" has no tests to accession for this profile for "_LRLIT_" WORKLIST. Entry: "_PROF_" Subentry: "_C
- +4 IF 'LRWARN
- QUIT
- +5 SET LREXPDT=+$PIECE(^LAB(62.3,X,0),U,2)
- +6 IF 'LREXPDT
- DO LABEL
- SET @LRTMPGL@(DA,10,PROF,LR45,C,LRFIELD)=">>WARNING<< - CONTROL: "_$PIECE(^LAB(62.3,X,0),U)_" does not have an EXPIRATION DATE for "_LRLIT_" WORKLIST. Entry: "_PROF_" Subentry: "_C
- QUIT
- +7 IF LREXPDT<DT
- DO LABEL
- SET @LRTMPGL@(DA,10,PROF,LR45,C,LRFIELD)=">>WARNING<< - CONTROL: "_$PIECE(^LAB(62.3,X,0),U)_" contains an expired EXPIRATION DATE: "_$$FMTE^XLFDT($PIECE(^LAB(62.3,X,0),U,2),"")_" for "_LRLIT_" WORKLIST. Entry: "_PROF_" Subentry: "_C
- +8 QUIT
- SUFFIX ; validation of "SUF" node data elements
- +1 IF '$DATA(^LRO(68.2,DA,"SUF"))
- QUIT
- +2 SET LASUF=^LRO(68.2,DA,"SUF")
- +3 IF $DATA(^LAB(64.2,+LASUF,0))[0
- DO LABEL
- SET @LRTMPGL@(DA,"68.2,.14")=">>FATAL<< - Invalid WKLD METHOD pointer to WKLD SUFFIX CODES file (#64.2)"
- +4 IF $LENGTH($PIECE(LASUF,U,7))
- IF $DATA(^LRO(68,+$PIECE(LASUF,U,7),0))[0
- DO LABEL
- SET @LRTMPGL@(DA,"68.2,1")=">>FATAL<< - Invalid MAJOR ACCESSION AREA pointer to ACCESSION file (#68)"
- +5 IF $LENGTH($PIECE(LASUF,U,8))
- IF $DATA(^LRO(68,+$PIECE(LASUF,U,8),0))[0
- DO LABEL
- SET @LRTMPGL@(DA,"68.2,1.5")=">>FATAL<< - Invalid LAB SUBSECTION pointer to ACCESSION file (#68)"
- +6 IF $LENGTH($PIECE(LASUF,U,9))
- Begin DoDot:1
- +7 IF $DATA(^LRO(68,$PIECE(LASUF,U,9),0))[0
- DO LABEL
- SET @LRTMPGL@(DA,"68.2,1.7")=">>FATAL<< - Invalid WORK AREA pointer to ACCESSION file (#68)"
- QUIT
- +8 IF LRWARN
- SET X=$PIECE(^LRO(68,$PIECE(LASUF,U,9),0),U)
- SET Z=""
- DO CHK^DIE(68.2,1.7,"E",X,.Z)
- Begin DoDot:2
- +9 IF Z=U
- DO LABEL
- SET @LRTMPGL@(DA,"68.2,1.7")=">>CRITICAL<< - The value '"_X_"' for field WORK AREA is not valid. Only accession areas identified as work areas are valid."
- End DoDot:2
- End DoDot:1
- +10 QUIT
- LABEL ;
- +1 IF LRDA'=DA
- SET @LRTMPGL@(DA)=$PIECE(LA,U)
- SET LRDA=DA
- +2 IF $DATA(LA10)
- IF $PIECE(LA10,U)'=LRPROF
- SET (LRPROF,@LRTMPGL@(DA,10,PROF))=$PIECE(LA10,U)
- +3 QUIT
- SET45 ;
- +1 ; variable assignment during processing of controls to begin and end
- +2 ; worklist data elements
- +3 SET LRFIELD=$SELECT(LR45=4:"68.28,.01",1:"68.29,.01")
- SET LRLIT=$SELECT(LR45=4:"BEGIN",1:"END")
- +4 QUIT