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
