- LRSTUF2 ;SLC/CJS/DALOI/FHS - MASS DATA ENTRY INTO FILE 63.04 ;JUL 06, 2010 3:14 PM
- ;;5.2;LAB SERVICE;**121,153,263,347,1027**;NOV 01, 1997
- LRSTUFF W !,"Acc #: ",LRAN I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))!'$D(^(3)) W !," not set up." Q
- S LRNOP=1,I=0 F S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<1 I $D(^(I,0)),LRTESTSV=+^(0) S LRNOP=0
- I LRNOP W " doesn't have the test required." Q
- ; S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRODT=$P(^(0),U,4),LRSN=$P(^(0),U,5),LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W ?15,PNM,?45,SSN
- S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRODT=$P(^(0),U,4),LRSN=$P(^(0),U,5),LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W ?15,PNM,?45,HRCN ;IHS/ANMC/CLS 08/18/96
- Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) S LRIDT=$P(^(3),U,5),LRMETH="(BD)"_DUZ_"/"_DUZ(2) I LRDPF'=62.3 S LRLLOC=$P(^(0),U,7) S:'$L(LRLLOC) LRLLOC="UNKNOWN" W ?65,LRLLOC
- L +^LR(LRDFN,"CH",LRIDT):5 I '$T W !!,"Someone else is editing this entry ",!,$C(7) Q
- I $P(^LR(LRDFN,LRSS,LRIDT,0),U,3),("pending"'[$S($D(^(LRFLD)):$P(^(LRFLD),U,1),1:"pending")) W !?25,"VERIFIED DATA, CAN'T CHANGE" L -^LR(LRDFN,"CH",LRIDT) Q
- I $P(^LR(LRDFN,LRSS,LRIDT,0),U,3) W ?45,"Some Data Already Verified "
- I '$T,$O(^LR(LRDFN,LRSS,LRIDT,1))>1 W ?45,"Some Unverified Data Already Entered. " L -^LR(LRDFN,"CH",LRIDT) Q
- S I=0 F S I=$O(^TMP("LR",$J,"VTO",I)) Q:I<1 S ^TMP("LR",$J,"VTO",I,"P")=I_U_$$NLT^LRVER1(I)
- W ! S DIE="^LR("_LRDFN_",""CH"",",DA=LRIDT D ^DIE I LRA'=1,$D(Y) W !,"Do you wish to stop" S %=1 D YN^DICN I %=1 S LREND=1 L -^LR(LRDFN,"CH",LRIDT) Q
- I $L($G(LRVX)) S X=LRVX,LRFLG="",LRSPEC=+$P(^LR(LRDFN,LRSS,LRIDT,0),U,5),LRTS=LRTESTSV D
- . K LRSB S LRSB=LRFLD
- . D V25^LRVER5,RANGE^LRVER5
- STOR I $D(^LR(LRDFN,LRSS,LRIDT,LRFLD))#2,$L($P(^(LRFLD),U)),$L(X) D
- . N LRX,LRXX,LRP
- . X:$G(LRDEL)'="" LRDEL
- . S LRXX=X
- . S $P(LRXX,U,2)=LRFLG,$P(LRXX,U,4)=DUZ,$P(LRXX,U,9)=$G(DUZ(2))
- . S $P(LRXX,U,5)=$TR(LRNG,U,"!")
- . K ^TMP("LR",$J,"TMP")
- . S LRP=$O(^LAB(60,"C",LRSS_";"_LRFLD_";1",0))
- . S ^TMP("LR",$J,"TMP",LRFLD)=LRP
- . S LRX=+$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTESTSV,0)),U,9)
- . I LRX,LRP D
- . . S ^TMP("LR",$J,"TMP",LRFLD,"P")=LRX_U_$$NLT^LRVER1(LRX)_"!"_$$RNLT^LRVER1(LRP)
- . . S $P(LRXX,U,3)=$P($G(^TMP("LR",$J,"TMP",LRFLD,"P")),U,2)
- . S ^LR(LRDFN,LRSS,LRIDT,LRFLD)=LRXX
- . I $D(^LR(LRDFN,LRSS,LRIDT,0)),$P(^(0),U,8)'[LRMETH S $P(^(0),U,8)=LRMETH_";"_$P(^(0),U,8)
- I '$D(LRSB(LRFLD)) W ?39,"**NOT STUFFED**",$C(7) L -^LR(LRDFN,"CH",LRIDT) Q
- N LRCORECT S LRCORECT=0
- D VER^LRVER3A,REQ W ?45,"STUFFED"
- I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D LOOK^LRCAPV1
- S ^LRO(68,"AC",LRDFN,LRIDT,LRFLD)=""
- L -^LR(LRDFN,"CH",LRIDT)
- I $P($G(LRORU3),U,3),$O(LRSB(0)) D LRORU3^LRVER3
- Q
- RANGE F R=$P(LRAC,"-",1):1:$P(LRAC,"-",2) S LRAC(R)=""
- Q
- REQ F X=0:0 S X=$O(M(X)) Q:X<1 S I=M(X) D:'$D(^LR(LRDFN,"CH",LRIDT,X)) ROLL
- Q
- ROLL S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,I,0)=I_U_LROUTINE,$P(^(0),U,9)=$P($G(^TMP("LR",$J,"TMP",LRFLD,"P")),U)
- S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",I,I)="",^LR(LRDFN,"CH",LRIDT,X)="pending",$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4)=""
- Q
- LRSTUF2 ;SLC/CJS/DALOI/FHS - MASS DATA ENTRY INTO FILE 63.04 ;JUL 06, 2010 3:14 PM
- +1 ;;5.2;LAB SERVICE;**121,153,263,347,1027**;NOV 01, 1997
- LRSTUFF WRITE !,"Acc #: ",LRAN
- IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))!'$DATA(^(3))
- WRITE !," not set up."
- QUIT
- +1 SET LRNOP=1
- SET I=0
- FOR
- SET I=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I))
- IF I<1
- QUIT
- IF $DATA(^(I,0))
- IF LRTESTSV=+^(0)
- SET LRNOP=0
- +2 IF LRNOP
- WRITE " doesn't have the test required."
- QUIT
- +3 ; S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRODT=$P(^(0),U,4),LRSN=$P(^(0),U,5),LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W ?15,PNM,?45,SSN
- +4 ;IHS/ANMC/CLS 08/18/96
- SET LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)
- SET LRODT=$PIECE(^(0),U,4)
- SET LRSN=$PIECE(^(0),U,5)
- SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
- SET DFN=$PIECE(^(0),U,3)
- DO PT^LRX
- WRITE ?15,PNM,?45,HRCN
- +5 IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
- QUIT
- SET LRIDT=$PIECE(^(3),U,5)
- SET LRMETH="(BD)"_DUZ_"/"_DUZ(2)
- IF LRDPF'=62.3
- SET LRLLOC=$PIECE(^(0),U,7)
- IF '$LENGTH(LRLLOC)
- SET LRLLOC="UNKNOWN"
- WRITE ?65,LRLLOC
- +6 LOCK +^LR(LRDFN,"CH",LRIDT):5
- IF '$TEST
- WRITE !!,"Someone else is editing this entry ",!,$CHAR(7)
- QUIT
- +7 IF $PIECE(^LR(LRDFN,LRSS,LRIDT,0),U,3)
- IF ("pending"'[$SELECT($DATA(^(LRFLD)):$PIECE(^(LRFLD),U,1),1:"pending"))
- WRITE !?25,"VERIFIED DATA, CAN'T CHANGE"
- LOCK -^LR(LRDFN,"CH",LRIDT)
- QUIT
- +8 IF $PIECE(^LR(LRDFN,LRSS,LRIDT,0),U,3)
- WRITE ?45,"Some Data Already Verified "
- +9 IF '$TEST
- IF $ORDER(^LR(LRDFN,LRSS,LRIDT,1))>1
- WRITE ?45,"Some Unverified Data Already Entered. "
- LOCK -^LR(LRDFN,"CH",LRIDT)
- QUIT
- +10 SET I=0
- FOR
- SET I=$ORDER(^TMP("LR",$JOB,"VTO",I))
- IF I<1
- QUIT
- SET ^TMP("LR",$JOB,"VTO",I,"P")=I_U_$$NLT^LRVER1(I)
- +11 WRITE !
- SET DIE="^LR("_LRDFN_",""CH"","
- SET DA=LRIDT
- DO ^DIE
- IF LRA'=1
- IF $DATA(Y)
- WRITE !,"Do you wish to stop"
- SET %=1
- DO YN^DICN
- IF %=1
- SET LREND=1
- LOCK -^LR(LRDFN,"CH",LRIDT)
- QUIT
- +12 IF $LENGTH($GET(LRVX))
- SET X=LRVX
- SET LRFLG=""
- SET LRSPEC=+$PIECE(^LR(LRDFN,LRSS,LRIDT,0),U,5)
- SET LRTS=LRTESTSV
- Begin DoDot:1
- +13 KILL LRSB
- SET LRSB=LRFLD
- +14 DO V25^LRVER5
- DO RANGE^LRVER5
- End DoDot:1
- STOR IF $DATA(^LR(LRDFN,LRSS,LRIDT,LRFLD))#2
- IF $LENGTH($PIECE(^(LRFLD),U))
- IF $LENGTH(X)
- Begin DoDot:1
- +1 NEW LRX,LRXX,LRP
- +2 IF $GET(LRDEL)'=""
- XECUTE LRDEL
- +3 SET LRXX=X
- +4 SET $PIECE(LRXX,U,2)=LRFLG
- SET $PIECE(LRXX,U,4)=DUZ
- SET $PIECE(LRXX,U,9)=$GET(DUZ(2))
- +5 SET $PIECE(LRXX,U,5)=$TRANSLATE(LRNG,U,"!")
- +6 KILL ^TMP("LR",$JOB,"TMP")
- +7 SET LRP=$ORDER(^LAB(60,"C",LRSS_";"_LRFLD_";1",0))
- +8 SET ^TMP("LR",$JOB,"TMP",LRFLD)=LRP
- +9 SET LRX=+$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTESTSV,0)),U,9)
- +10 IF LRX
- IF LRP
- Begin DoDot:2
- +11 SET ^TMP("LR",$JOB,"TMP",LRFLD,"P")=LRX_U_$$NLT^LRVER1(LRX)_"!"_$$RNLT^LRVER1(LRP)
- +12 SET $PIECE(LRXX,U,3)=$PIECE($GET(^TMP("LR",$JOB,"TMP",LRFLD,"P")),U,2)
- End DoDot:2
- +13 SET ^LR(LRDFN,LRSS,LRIDT,LRFLD)=LRXX
- +14 IF $DATA(^LR(LRDFN,LRSS,LRIDT,0))
- IF $PIECE(^(0),U,8)'[LRMETH
- SET $PIECE(^(0),U,8)=LRMETH_";"_$PIECE(^(0),U,8)
- End DoDot:1
- +15 IF '$DATA(LRSB(LRFLD))
- WRITE ?39,"**NOT STUFFED**",$CHAR(7)
- LOCK -^LR(LRDFN,"CH",LRIDT)
- QUIT
- +16 NEW LRCORECT
- SET LRCORECT=0
- +17 DO VER^LRVER3A
- DO REQ
- WRITE ?45,"STUFFED"
- +18 IF $PIECE(LRPARAM,U,14)
- IF $PIECE($GET(^LRO(68,LRAA,0)),U,16)
- DO LOOK^LRCAPV1
- +19 SET ^LRO(68,"AC",LRDFN,LRIDT,LRFLD)=""
- +20 LOCK -^LR(LRDFN,"CH",LRIDT)
- +21 IF $PIECE($GET(LRORU3),U,3)
- IF $ORDER(LRSB(0))
- DO LRORU3^LRVER3
- +22 QUIT
- RANGE FOR R=$PIECE(LRAC,"-",1):1:$PIECE(LRAC,"-",2)
- SET LRAC(R)=""
- +1 QUIT
- REQ FOR X=0:0
- SET X=$ORDER(M(X))
- IF X<1
- QUIT
- SET I=M(X)
- IF '$DATA(^LR(LRDFN,"CH",LRIDT,X))
- DO ROLL
- +1 QUIT
- ROLL SET ^LRO(68,LRAA,1,LRAD,1,LRAN,4,I,0)=I_U_LROUTINE
- SET $PIECE(^(0),U,9)=$PIECE($GET(^TMP("LR",$JOB,"TMP",LRFLD,"P")),U)
- +1 SET ^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",I,I)=""
- SET ^LR(LRDFN,"CH",LRIDT,X)="pending"
- SET $PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4)=""
- +2 QUIT
