- LRGV1 ;DALOI/RWF - PART2 OF INSTRUMENT GROUP VERIFY DATA ;2/8/91 09:29
- ;;5.2;LAB SERVICE;**112,153,269**;Sep 27, 1994
- ;
- STUFF ;from LRGV
- ;
- ; Check if task has been asked to stop.
- I $D(ZTQUEUED),$$S^%ZTLOAD D Q
- . S ZTSTOP=1
- . W !!,"*** Report requested to stop by TaskMan ***"
- . W !,"*** Task #",$G(ZTQUEUED,"UNKNOWN")," stopped at ",$$HTE^XLFDT($H)," ***"
- ;
- N LRQUIT
- ;
- S LRQUIT=0
- ;
- L +^LAH(LRLL,1,LRSQ):1
- I '$T W !,"Unable to obtain lock on sequence #",LRSQ Q
- ;
- ; Skip this sequence number if accession number is for a different area/date
- S LRSQ(0)=^LAH(LRLL,1,LRSQ,0)
- I $P(LRSQ(0),U,3)=LRAA,$P(LRSQ(0),U,4)=LRAD,$P(LRSQ(0),U,5)=LRAN
- I '$T L -^LAH(LRLL,1,LRSQ) Q
- ;
- I '$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),U,2) D
- . W !?5,"Corrupt Accession ",!
- . D NOP
- ;
- S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
- S LRDFN=+X,LRODT=+$P(X,U,4),LRSN=+$P(X,U,5),LRLLOC=$P(X,U,7)
- S:'$L(LRLLOC) LRLLOC=0
- S LRORD=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.1)),"^")
- S X(3)=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
- S LRIDT=$P(X(3),U,5)
- S:'LRIDT LRIDT=9999999-X(3)
- S LRORU3=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
- ;
- K LRSA,LRSB,X
- W " Auto Sequence #",LRSQ
- I '$D(^LRO(68,+LRAA,1,+LRAD,1,+LRAN,0))!'$D(^(3)) D Q
- . W ?40,"Accession NOT found."
- . L -^LAH(LRLL,1,LRSQ)
- ;
- K ^TMP("LR",$J,"TMP")
- D TEST^LRVR1
- ;
- ; Check for more than one sequence relating to this accession
- S LRI=0
- F S LRI=$O(^LAH(LRLL,1,"C",LRAN,LRI)) Q:'LRI D Q:LRQUIT
- . I LRI=LRSQ Q
- . S LRI(0)=$G(^LAH(LRLL,1,LRI,0))
- . I $P(LRI(0),"^",3,5)'=LRAA_"^"_LRAD_"^"_LRAN Q
- . S LRQUIT=1
- . D INFO,NOP
- I LRQUIT Q
- ;
- S LRMETH=$P(^LAH(LRLL,1,LRSQ,0),U,7)
- I $O(^LAH(LRLL,1,LRSQ,1))<1 D Q
- . W ?45,"There's NO Instrument Data "
- . D NOP
- ;
- ; Get patient demographics
- S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX
- S:'$L($G(SEX)) SEX="M"
- S:'$L($G(AGE)) AGE=99
- W ! D DISPLAY^LRGP
- ;
- L +^LR(LRDFN,"CH",LRIDT):1
- I '$T W !,"Unable to obtain lock on LAB DATA file" Q
- ;
- S LR0=$G(^LR(LRDFN,"CH",LRIDT,0))
- I LR0="" W !,"DATA HEADER MISSING " D NOP Q
- ;
- S X=+$P(LR0,U,5),LRSPEC=-1,LRSPNAM="??"
- I X S LRSPNAM=$P(^LAB(61,+X,0),U,1),LRSPEC=X
- W !," Specimen: ",LRSPNAM
- W ?26," Collection date/time: ",$$FMTE^XLFDT($P(LR0,"^"),"1M"),!
- ;
- I LRDPF'=62.3,LRSPEC'=$P(LR0,U,5) D Q
- . W !," << SPECIMEN IS NOT ",LRSPNAM," >> "
- . D NOP
- ;
- S LRVF=+$P(LR0,U,3)
- I LRVF W !,"Some Data Already Verified ",!
- ;
- I '$T,$O(^LR(LRDFN,"CH",LRIDT,1))>1 D Q
- . W !,"Some Unverified Data Already Entered. "
- . D NOP
- ;
- D ^LRGV2
- ;
- L -^LR(LRDFN,"CH",LRIDT)
- L -^LAH(LRLL,1,LRSQ)
- ;
- Q
- ;
- NOP ; unlock from above
- L -^LR(LRDFN,"CH",LRIDT)
- L -^LAH(LRLL,1,LRSQ)
- W !,">> Accession: ",LRAN," NOT VERIFIED <<"
- I $E(IOST,1,2)="C-" W $C(7)
- Q
- ;
- ;
- INFO ;
- N X
- W !,"Sequence #: ",LRSQ
- S X=^LAH(LRLL,1,LRSQ,0)
- ;
- I LRWT="T" D
- . I $P(X,"^") W ?20,"TRAY: ",$P(X,"^")
- . I $P(X,"^",2) W ?33,"CUP: ",$P(X,"^",2)
- ;
- W ?45,"DUPLICATE "
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRGV1 2991 printed Feb 18, 2025@23:40:52 Page 2
- LRGV1 ;DALOI/RWF - PART2 OF INSTRUMENT GROUP VERIFY DATA ;2/8/91 09:29
- +1 ;;5.2;LAB SERVICE;**112,153,269**;Sep 27, 1994
- +2 ;
- STUFF ;from LRGV
- +1 ;
- +2 ; Check if task has been asked to stop.
- +3 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- Begin DoDot:1
- +4 SET ZTSTOP=1
- +5 WRITE !!,"*** Report requested to stop by TaskMan ***"
- +6 WRITE !,"*** Task #",$GET(ZTQUEUED,"UNKNOWN")," stopped at ",$$HTE^XLFDT($HOROLOG)," ***"
- End DoDot:1
- QUIT
- +7 ;
- +8 NEW LRQUIT
- +9 ;
- +10 SET LRQUIT=0
- +11 ;
- +12 LOCK +^LAH(LRLL,1,LRSQ):1
- +13 IF '$TEST
- WRITE !,"Unable to obtain lock on sequence #",LRSQ
- QUIT
- +14 ;
- +15 ; Skip this sequence number if accession number is for a different area/date
- +16 SET LRSQ(0)=^LAH(LRLL,1,LRSQ,0)
- +17 IF $PIECE(LRSQ(0),U,3)=LRAA
- IF $PIECE(LRSQ(0),U,4)=LRAD
- IF $PIECE(LRSQ(0),U,5)=LRAN
- +18 IF '$TEST
- LOCK -^LAH(LRLL,1,LRSQ)
- QUIT
- +19 ;
- +20 IF '$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),U,2)
- Begin DoDot:1
- +21 WRITE !?5,"Corrupt Accession ",!
- +22 DO NOP
- End DoDot:1
- +23 ;
- +24 SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
- +25 SET LRDFN=+X
- SET LRODT=+$PIECE(X,U,4)
- SET LRSN=+$PIECE(X,U,5)
- SET LRLLOC=$PIECE(X,U,7)
- +26 if '$LENGTH(LRLLOC)
- SET LRLLOC=0
- +27 SET LRORD=$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.1)),"^")
- +28 SET X(3)=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
- +29 SET LRIDT=$PIECE(X(3),U,5)
- +30 if 'LRIDT
- SET LRIDT=9999999-X(3)
- +31 SET LRORU3=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
- +32 ;
- +33 KILL LRSA,LRSB,X
- +34 WRITE " Auto Sequence #",LRSQ
- +35 IF '$DATA(^LRO(68,+LRAA,1,+LRAD,1,+LRAN,0))!'$DATA(^(3))
- Begin DoDot:1
- +36 WRITE ?40,"Accession NOT found."
- +37 LOCK -^LAH(LRLL,1,LRSQ)
- End DoDot:1
- QUIT
- +38 ;
- +39 KILL ^TMP("LR",$JOB,"TMP")
- +40 DO TEST^LRVR1
- +41 ;
- +42 ; Check for more than one sequence relating to this accession
- +43 SET LRI=0
- +44 FOR
- SET LRI=$ORDER(^LAH(LRLL,1,"C",LRAN,LRI))
- if 'LRI
- QUIT
- Begin DoDot:1
- +45 IF LRI=LRSQ
- QUIT
- +46 SET LRI(0)=$GET(^LAH(LRLL,1,LRI,0))
- +47 IF $PIECE(LRI(0),"^",3,5)'=LRAA_"^"_LRAD_"^"_LRAN
- QUIT
- +48 SET LRQUIT=1
- +49 DO INFO
- DO NOP
- End DoDot:1
- if LRQUIT
- QUIT
- +50 IF LRQUIT
- QUIT
- +51 ;
- +52 SET LRMETH=$PIECE(^LAH(LRLL,1,LRSQ,0),U,7)
- +53 IF $ORDER(^LAH(LRLL,1,LRSQ,1))<1
- Begin DoDot:1
- +54 WRITE ?45,"There's NO Instrument Data "
- +55 DO NOP
- End DoDot:1
- QUIT
- +56 ;
- +57 ; Get patient demographics
- +58 SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
- SET DFN=$PIECE(^(0),U,3)
- DO PT^LRX
- +59 if '$LENGTH($GET(SEX))
- SET SEX="M"
- +60 if '$LENGTH($GET(AGE))
- SET AGE=99
- +61 WRITE !
- DO DISPLAY^LRGP
- +62 ;
- +63 LOCK +^LR(LRDFN,"CH",LRIDT):1
- +64 IF '$TEST
- WRITE !,"Unable to obtain lock on LAB DATA file"
- QUIT
- +65 ;
- +66 SET LR0=$GET(^LR(LRDFN,"CH",LRIDT,0))
- +67 IF LR0=""
- WRITE !,"DATA HEADER MISSING "
- DO NOP
- QUIT
- +68 ;
- +69 SET X=+$PIECE(LR0,U,5)
- SET LRSPEC=-1
- SET LRSPNAM="??"
- +70 IF X
- SET LRSPNAM=$PIECE(^LAB(61,+X,0),U,1)
- SET LRSPEC=X
- +71 WRITE !," Specimen: ",LRSPNAM
- +72 WRITE ?26," Collection date/time: ",$$FMTE^XLFDT($PIECE(LR0,"^"),"1M"),!
- +73 ;
- +74 IF LRDPF'=62.3
- IF LRSPEC'=$PIECE(LR0,U,5)
- Begin DoDot:1
- +75 WRITE !," << SPECIMEN IS NOT ",LRSPNAM," >> "
- +76 DO NOP
- End DoDot:1
- QUIT
- +77 ;
- +78 SET LRVF=+$PIECE(LR0,U,3)
- +79 IF LRVF
- WRITE !,"Some Data Already Verified ",!
- +80 ;
- +81 IF '$TEST
- IF $ORDER(^LR(LRDFN,"CH",LRIDT,1))>1
- Begin DoDot:1
- +82 WRITE !,"Some Unverified Data Already Entered. "
- +83 DO NOP
- End DoDot:1
- QUIT
- +84 ;
- +85 DO ^LRGV2
- +86 ;
- +87 LOCK -^LR(LRDFN,"CH",LRIDT)
- +88 LOCK -^LAH(LRLL,1,LRSQ)
- +89 ;
- +90 QUIT
- +91 ;
- NOP ; unlock from above
- +1 LOCK -^LR(LRDFN,"CH",LRIDT)
- +2 LOCK -^LAH(LRLL,1,LRSQ)
- +3 WRITE !,">> Accession: ",LRAN," NOT VERIFIED <<"
- +4 IF $EXTRACT(IOST,1,2)="C-"
- WRITE $CHAR(7)
- +5 QUIT
- +6 ;
- +7 ;
- INFO ;
- +1 NEW X
- +2 WRITE !,"Sequence #: ",LRSQ
- +3 SET X=^LAH(LRLL,1,LRSQ,0)
- +4 ;
- +5 IF LRWT="T"
- Begin DoDot:1
- +6 IF $PIECE(X,"^")
- WRITE ?20,"TRAY: ",$PIECE(X,"^")
- +7 IF $PIECE(X,"^",2)
- WRITE ?33,"CUP: ",$PIECE(X,"^",2)
- End DoDot:1
- +8 ;
- +9 WRITE ?45,"DUPLICATE "
- +10 QUIT