LRMISTF1 ;SLC/CJS/BA/DALOI/FHS - MASS DATA ENTRY INTO FILE 63.05 ;2/25/03 22:24
;;5.2;LAB SERVICE;**1010,1013,1015,1030,1031**;NOV 01, 1997
;
;;VA LR Patche(s): 121,128,202,263,264,295
;
; Reference to ^DPT( Supported by Reference #10035
; Reference to ^ORD(100.99 Supported by Reference #2414
; Reference to YN^DICN Supported by Reference #10009
; Reference to ^DIE Supported by Reference #10018
; Reference to $$NOW^XLFDT Supported by Reference #10103
; Reference to $$CJ^XLFSTR Supported by Reference #10104
;from LRMISTF
ASK F I=0:0 D GET Q:LREND=99 D:'LREND ACC S:LREND LREND=0 D MORE Q:LREND K LRAUTO
Q
GET S X1="",LREND=0 I LRMODE<3 D
. F R !,"What do you want entered?: ",X1:DTIME Q:'$T!(X1[U)!(X1="") D I $L(X1),$E(X1)'="?" S LREND=0 Q
. . I $S(X1[":":1,X1[";":1,1:0) S X1="?" D INFO Q
. . S X=X1 S:X[";" X="?" D @$S($G(H9)=11.57:"PN^LRNUM",$G(H9)=24:"AFS^LRNUM",1:"^LRMIXPD") S:'$D(X) X1="?" Q:X1'="?" D INFO
I X1[U S LREND=99 Q
S:LRMODE<3 LRSTUFF=X1 W !,"I will ",$S(LRMODE=1:"automatically stuff ",1:"prompt "),LRMF W:$D(LRSTUFF) !,"with ",LRSTUFF
F W !," ...OK" S %=1 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o"
I %'=1 S LREND=1 Q
I LRPF="P" S DR="S:$S($D(^LR(LRDFN,""MI"",LRIDT,"_LRSB_")):$P(^("_LRSB_"),U,2),1:"""")=""F"" Y="_$S(LRSB=1:11.55,LRSB=5:15.5,LRSB=8:19.5,LRSB=11:25.5,LRSB=16:35)_";"
I LRPF="F" S DR=""
S DR=DR_$S(LRSB=1:"11.5///"_LRPF_";11.55",LRSB=5:"15///"_LRPF_";15.5",LRSB=8:"19///"_LRPF_";19.5",LRSB=11:"23///"_LRPF_";25.5",1:"34///"_LRPF_";35")
S DR=DR_"////"_DUZ_";"_H9_$S(LRMODE=1:"///"_LRSTUFF,LRMODE=2:"//"_LRSTUFF,1:"")
; F W !,"Verify all work automatically" S %=1 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o"
;----- BEGIN IHS/OIT/MKK - LR*5.2*1030
F I=0:0 W !,"Verify all work automatically" S %=2 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o"
;----- END IHS/OIT/MKK - LR*5.2*1030
I %=-1 S LREND=1 Q
I %=1 S DR=DR_";"_$S(LRSB=1:11,LRSB=5:14,LRSB=8:18,LRSB=11:22,1:33)_"///T",LRAUTO=""
; S LRCO=0 F W !,"Designate the individual test as complete" S %=2 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o"
;----- BEGIN IHS/OIT/MKK - LR*5.2*1030
S LRCO=0 F I=0:0 W !,"Designate the individual test as complete" S %=1 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o"
;----- END IHS/OIT/MKK - LR*5.2*1030
S:%=1 LRCO=1 S:%=-1 LREND=1
Q
INFO W !,$$CJ^XLFSTR("What you enter will go through the input transform to be stored in the.",IOM)
W !,$$CJ^XLFSTR("Result field of the test",IOM)
W !,$$CJ^XLFSTR("The punctuations of ';' or ':' are not allowed in Batch Data Entry.",IOM),!
Q
ACC K LRSTUFF,DIC W !,"Enter the accessions you wish to edit." D LRAN^LRMIUT
I +$O(LRAN(0))>0 W !,"Editing the following:" S (J,LRAN)=0 F S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1 W !,LRAN S J=J+1 I J#(IOSL-2)=0 R !,"Press return to continue or '^' to escape ",X:DTIME I X[U S LREND=1 Q
Q:LREND
F W !,"Everything OK" S %=2 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o"
Q:%'=1
S LRAN=0 F S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1 D STUFF Q:LREND
Q
STUFF I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))!'$D(^(3)) W !,"Acc: ",LRAN," not set up." Q
I $P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4) W !,"Acc: ",LRAN," has been previously verified by a microbiology supervisor." Q
S LRNOP=1,J=0 F S J=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,J)) Q:J<1 I LRTEST=+^(J,0) S LRNOP=$P(^(0),U,5) Q
I LRNOP=1 W !,"Acc: ",LRAN," doesn't have the test required." Q
I LRNOP>1 W !,"Acc: ",LRAN," has been completed for the selected test." Q
I H9=11.57!(H9=11.58) S LROK=0 D @$S(H9=11.57:"UR",1:"SPUT") I 'LROK W !,"Acc: ",LRAN," doesn't have the specimen required." Q
W !,"Acc: ",LRAN S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRLLOC=$P(^(0),U,7),LRODT=$S($P(^(0),U,4):$P(^(0),U,4),1:$P(^(0),U,3)),LRSN=$P(^(0),U,5)
; S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W ?15,PNM,?45,SSN I LRDPF=2,$D(^DPT(DFN,.1)) W ?65,^(.1)
;----- BEGIN IHS/OIT/MKK - LR*5.2*1030
S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W ?15,PNM,?45,HRCN I LRDPF=2,$D(^DPT(DFN,.1)) W ?65,^(.1)
;----- END IHS/OIT/MKK - LR*5.2*1030
I LRDPF=2,DFN,$P($G(^ORD(100.99,1,"CONV")),"^")=0 D EN^LR7OV2(DFN_";DPT(",1)
; W ! S LRCDT=+^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRIDT=+$P(^(3),U,5),DIE="^LR("_LRDFN_",""MI"",",DA=LRIDT D ^DIE,UPDATE^LRPXRM(LRDFN,"MI",LRIDT) I $D(Y) S LREND=1 Q
; W ! S LRCDT=+^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRIDT=+$P(^(3),U,5),DIE="^LR("_LRDFN_",""MI"",",DA=LRIDT D ^DIE I $D(Y) S LREND=1 Q ; IHS/OIT/MKK - LR*5.2*1030 - RPMS Does NOT use Clinical Reminders
I '$$PATCH^BLRUTIL4("PXRM*1.5*12") W ! S LRCDT=+^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRIDT=+$P(^(3),U,5),DIE="^LR("_LRDFN_",""MI"",",DA=LRIDT D ^DIE I $D(Y) S LREND=1 Q ; IHS/MSC/MKK - LR*5.2*1031
I $$PATCH^BLRUTIL4("PXRM*1.5*12") W ! S LRCDT=+^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRIDT=+$P(^(3),U,5),DIE="^LR("_LRDFN_",""MI"",",DA=LRIDT D ^DIE,UPDATE^LRPXRM(LRDFN,"MI",LRIDT) I $D(Y) S LREND=1 Q ; IHS/MSC/MKK - LR*5.2*1031
;----- BEGIN IHS/OIT/MKK - LR*5.2*1030
D:BLRLOG ^BLREVTQ("M","R","MICRO",,LRAA_","_LRAD_","_LRAN)
;----- END IHS/OIT/MKK - LR*5.2*1030
I LRCO S X=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST,0),U,5) K:X ^LRO(68,LRAA,1,LRAD,1,"AD",$P(X,"."),LRAN),^LRO(68,LRAA,1,LRAD,1,"AC",X,LRAN)
I LRCO D
. S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST,0),U,4)=DUZ,$P(^(0),U,8)=$G(LRCDEF)
. S Y=$$NOW^XLFDT
. S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST,0),U,5)=Y
. S ^LRO(68,LRAA,1,LRAD,1,"AD",$P(Y,"."),LRAN)="",^LRO(68,LRAA,1,LRAD,1,"AC",Y,LRAN)=""
. I $$VER^LR7OU1<3 N I S I=LRTEST D V^LROR ;OE/RR 2.5
. N CORRECT S:$G(LRCORECT) CORRECT=1 D NEW^LR7OB1(LRODT,LRSN,"RE")
; I $D(LRAUTO) D STF^LRMIUT
;----- BEGIN IHS/OIT/MKK - LR*5.2*1030
; Added per Appendix A of RPMS E-Sig Enhancement V 5.2 technical manual
I $$ADDON^BLRUTIL("LR*5.2*1013","BLRALAF",DUZ(2)) D ^BLRALAF
D STF^LRMIUT ; Not verified always appears on VT
;----- END IHS/OIT/MKK - LR*5.2*1030
Q
MORE S LREND=1 F W !,"Do you wish to make a new entry for the ",LRMF," field" S %=2 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o"
I %=1 S LREND=0
Q
UR S J=0 F S J=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,J)) Q:J<1 I LRURINE=+^(J,0) S LROK=1 Q
Q
SPUT S J=0 F S J=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,J)) Q:J<1 I 360=+^(J,0) S LROK=1 Q
Q
LRMISTF1 ;SLC/CJS/BA/DALOI/FHS - MASS DATA ENTRY INTO FILE 63.05 ;2/25/03 22:24
+1 ;;5.2;LAB SERVICE;**1010,1013,1015,1030,1031**;NOV 01, 1997
+2 ;
+3 ;;VA LR Patche(s): 121,128,202,263,264,295
+4 ;
+5 ; Reference to ^DPT( Supported by Reference #10035
+6 ; Reference to ^ORD(100.99 Supported by Reference #2414
+7 ; Reference to YN^DICN Supported by Reference #10009
+8 ; Reference to ^DIE Supported by Reference #10018
+9 ; Reference to $$NOW^XLFDT Supported by Reference #10103
+10 ; Reference to $$CJ^XLFSTR Supported by Reference #10104
+11 ;from LRMISTF
ASK FOR I=0:0
DO GET
IF LREND=99
QUIT
IF 'LREND
DO ACC
IF LREND
SET LREND=0
DO MORE
IF LREND
QUIT
KILL LRAUTO
+1 QUIT
GET SET X1=""
SET LREND=0
IF LRMODE<3
Begin DoDot:1
+1 FOR
READ !,"What do you want entered?: ",X1:DTIME
IF '$TEST!(X1[U)!(X1="")
QUIT
Begin DoDot:2
+2 IF $SELECT(X1[":":1,X1[";":1,1:0)
SET X1="?"
DO INFO
QUIT
+3 SET X=X1
IF X[";"
SET X="?"
DO @$SELECT($GET">GET(H9)=11.57:"PN^LRNUM",$GET">GET(H9)=24:"AFS^LRNUM",1:"^LRMIXPD")
IF '$DATA(X)
SET X1="?"
IF X1'="?"
QUIT
DO INFO
End DoDot:2
IF $LENGTH(X1)
IF $EXTRACT(X1)'="?"
SET LREND=0
QUIT
End DoDot:1
+4 IF X1[U
SET LREND=99
QUIT
+5 IF LRMODE<3
SET LRSTUFF=X1
WRITE !,"I will ",$SELECT(LRMODE=1:"automatically stuff ",1:"prompt "),LRMF
IF $DATA(LRSTUFF)
WRITE !,"with ",LRSTUFF
+6 FOR
WRITE !," ...OK"
SET %=1
DO YN^DICN
IF %
QUIT
WRITE !,"Answer 'Y'es or 'N'o"
+7 IF %'=1
SET LREND=1
QUIT
+8 IF LRPF="P"
SET DR="S:$S($D(^LR(LRDFN,""MI"",LRIDT,"_LRSB_")):$P(^("_LRSB_"),U,2),1:"""")=""F"" Y="_$SELECT(LRSB=1:11.55,LRSB=5:15.5,LRSB=8:19.5,LRSB=11:25.5,LRSB=16:35)_";"
+9 IF LRPF="F"
SET DR=""
+10 SET DR=DR_$SELECT(LRSB=1:"11.5///"_LRPF_";11.55",LRSB=5:"15///"_LRPF_";15.5",LRSB=8:"19///"_LRPF_";19.5",LRSB=11:"23///"_LRPF_";25.5",1:"34///"_LRPF_";35")
+11 SET DR=DR_"////"_DUZ_";"_H9_$SELECT(LRMODE=1:"///"_LRSTUFF,LRMODE=2:"//"_LRSTUFF,1:"")
+12 ; F W !,"Verify all work automatically" S %=1 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o"
+13 ;----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+14 FOR I=0:0
WRITE !,"Verify all work automatically"
SET %=2
DO YN^DICN
IF %
QUIT
WRITE !,"Answer 'Y'es or 'N'o"
+15 ;----- END IHS/OIT/MKK - LR*5.2*1030
+16 IF %=-1
SET LREND=1
QUIT
+17 IF %=1
SET DR=DR_";"_$SELECT(LRSB=1:11,LRSB=5:14,LRSB=8:18,LRSB=11:22,1:33)_"///T"
SET LRAUTO=""
+18 ; S LRCO=0 F W !,"Designate the individual test as complete" S %=2 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o"
+19 ;----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+20 SET LRCO=0
FOR I=0:0
WRITE !,"Designate the individual test as complete"
SET %=1
DO YN^DICN
IF %
QUIT
WRITE !,"Answer 'Y'es or 'N'o"
+21 ;----- END IHS/OIT/MKK - LR*5.2*1030
+22 IF %=1
SET LRCO=1
IF %=-1
SET LREND=1
+23 QUIT
INFO WRITE !,$$CJ^XLFSTR("What you enter will go through the input transform to be stored in the.",IOM)
+1 WRITE !,$$CJ^XLFSTR("Result field of the test",IOM)
+2 WRITE !,$$CJ^XLFSTR("The punctuations of ';' or ':' are not allowed in Batch Data Entry.",IOM),!
+3 QUIT
ACC KILL LRSTUFF,DIC
WRITE !,"Enter the accessions you wish to edit."
DO LRAN^LRMIUT
+1 IF +$ORDER(LRAN(0))>0
WRITE !,"Editing the following:"
SET (J,LRAN)=0
FOR
SET LRAN=+$ORDER(LRAN(LRAN))
IF LRAN<1
QUIT
WRITE !,LRAN
SET J=J+1
IF J#(IOSL-2)=0
READ !,"Press return to continue or '^' to escape ",X:DTIME
IF X[U
SET LREND=1
QUIT
+2 IF LREND
QUIT
+3 FOR
WRITE !,"Everything OK"
SET %=2
DO YN^DICN
IF %
QUIT
WRITE !,"Answer 'Y'es or 'N'o"
+4 IF %'=1
QUIT
+5 SET LRAN=0
FOR
SET LRAN=+$ORDER(LRAN(LRAN))
IF LRAN<1
QUIT
DO STUFF
IF LREND
QUIT
+6 QUIT
STUFF IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))!'$DATA(^(3))
WRITE !,"Acc: ",LRAN," not set up."
QUIT
+1 IF $PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4)
WRITE !,"Acc: ",LRAN," has been previously verified by a microbiology supervisor."
QUIT
+2 SET LRNOP=1
SET J=0
FOR
SET J=+$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,J))
IF J<1
QUIT
IF LRTEST=+^(J,0)
SET LRNOP=$PIECE(^(0),U,5)
QUIT
+3 IF LRNOP=1
WRITE !,"Acc: ",LRAN," doesn't have the test required."
QUIT
+4 IF LRNOP>1
WRITE !,"Acc: ",LRAN," has been completed for the selected test."
QUIT
+5 IF H9=11.57!(H9=11.58)
SET LROK=0
DO @$SELECT(H9=11.57:"UR",1:"SPUT")
IF 'LROK
WRITE !,"Acc: ",LRAN," doesn't have the specimen required."
QUIT
+6 WRITE !,"Acc: ",LRAN
SET LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)
SET LRLLOC=$PIECE(^(0),U,7)
SET LRODT=$SELECT($PIECE(^(0),U,4):$PIECE(^(0),U,4),1:$PIECE(^(0),U,3))
SET LRSN=$PIECE(^(0),U,5)
+7 ; S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W ?15,PNM,?45,SSN I LRDPF=2,$D(^DPT(DFN,.1)) W ?65,^(.1)
+8 ;----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+9 SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
SET DFN=$PIECE(^(0),U,3)
DO PT^LRX
WRITE ?15,PNM,?45,HRCN
IF LRDPF=2
IF $DATA(^DPT(DFN,.1))
WRITE ?65,^(.1)
+10 ;----- END IHS/OIT/MKK - LR*5.2*1030
+11 IF LRDPF=2
IF DFN
IF $PIECE($GET(^ORD(100.99,1,"CONV")),"^")=0
DO EN^LR7OV2(DFN_";DPT(",1)
+12 ; W ! S LRCDT=+^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRIDT=+$P(^(3),U,5),DIE="^LR("_LRDFN_",""MI"",",DA=LRIDT D ^DIE,UPDATE^LRPXRM(LRDFN,"MI",LRIDT) I $D(Y) S LREND=1 Q
+13 ; W ! S LRCDT=+^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRIDT=+$P(^(3),U,5),DIE="^LR("_LRDFN_",""MI"",",DA=LRIDT D ^DIE I $D(Y) S LREND=1 Q ; IHS/OIT/MKK - LR*5.2*1030 - RPMS Does NOT use Clinical Reminders
+14 ; IHS/MSC/MKK - LR*5.2*1031
IF '$$PATCH^BLRUTIL4("PXRM*1.5*12")
WRITE !
SET LRCDT=+^LRO(68,LRAA,1,LRAD,1,LRAN,3)
SET LRIDT=+$PIECE(^(3),U,5)
SET DIE="^LR("_LRDFN_",""MI"","
SET DA=LRIDT
DO ^DIE
IF $DATA(Y)
SET LREND=1
QUIT
+15 ; IHS/MSC/MKK - LR*5.2*1031
IF $$PATCH^BLRUTIL4("PXRM*1.5*12")
WRITE !
SET LRCDT=+^LRO(68,LRAA,1,LRAD,1,LRAN,3)
SET LRIDT=+$PIECE(^(3),U,5)
SET DIE="^LR("_LRDFN_",""MI"","
SET DA=LRIDT
DO ^DIE
DO UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
IF $DATA(Y)
SET LREND=1
QUIT
+16 ;----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+17 IF BLRLOG
DO ^BLREVTQ("M","R","MICRO",,LRAA_","_LRAD_","_LRAN)
+18 ;----- END IHS/OIT/MKK - LR*5.2*1030
+19 IF LRCO
SET X=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST,0),U,5)
IF X
KILL ^LRO(68,LRAA,1,LRAD,1,"AD",$PIECE(X,"."),LRAN),^LRO(68,LRAA,1,LRAD,1,"AC",X,LRAN)
+20 IF LRCO
Begin DoDot:1
+21 SET $PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST,0),U,4)=DUZ
SET $PIECE(^(0),U,8)=$GET(LRCDEF)
+22 SET Y=$$NOW^XLFDT
+23 SET $PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST,0),U,5)=Y
+24 SET ^LRO(68,LRAA,1,LRAD,1,"AD",$PIECE(Y,"."),LRAN)=""
SET ^LRO(68,LRAA,1,LRAD,1,"AC",Y,LRAN)=""
+25 ;OE/RR 2.5
IF $$VER^LR7OU1<3
NEW I
SET I=LRTEST
DO V^LROR
+26 NEW CORRECT
IF $GET(LRCORECT)
SET CORRECT=1
DO NEW^LR7OB1(LRODT,LRSN,"RE")
End DoDot:1
+27 ; I $D(LRAUTO) D STF^LRMIUT
+28 ;----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+29 ; Added per Appendix A of RPMS E-Sig Enhancement V 5.2 technical manual
+30 IF $$ADDON^BLRUTIL("LR*5.2*1013","BLRALAF",DUZ(2))
DO ^BLRALAF
+31 ; Not verified always appears on VT
DO STF^LRMIUT
+32 ;----- END IHS/OIT/MKK - LR*5.2*1030
+33 QUIT
MORE SET LREND=1
FOR
WRITE !,"Do you wish to make a new entry for the ",LRMF," field"
SET %=2
DO YN^DICN
IF %
QUIT
WRITE !,"Answer 'Y'es or 'N'o"
+1 IF %=1
SET LREND=0
+2 QUIT
UR SET J=0
FOR
SET J=+$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,5,J))
IF J<1
QUIT
IF LRURINE=+^(J,0)
SET LROK=1
QUIT
+1 QUIT
SPUT SET J=0
FOR
SET J=+$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,5,J))
IF J<1
QUIT
IF 360=+^(J,0)
SET LROK=1
QUIT
+1 QUIT
