LRMIEDZ2 ;SLC/CJS/BA,AVAMC/REG - MICROBIOLOGY EDIT ROUTINE ; 22-Oct-2013 09:22 ; MKK
;;5.2;LAB SERVICE;**1010,1013,1015,1030,1031,1033**;NOV 01, 1997
;
;;VA LR Patche(s): 23,104,242,295
;
;from LRFAST,LRMIEDZ,LRVER
PAT ; EP
S X=LRAN F I=0:0 R:'$D(LRAN) !!,"Accession #: ",X:DTIME Q:X=""!(X[U) D
.S LRANOK=1,LRCAPOK=1 D LRANX^LRMIU4 D:LRANOK PAT1 L:$G(LRANOK) -^LR(LRDFN,"MI",LRIDT)
.K LRTS D:LRCAPOK&(LRANOK)&($P(LRPARAM,U,14)) ^LRCAPV1 K:LRANOK LRAN I 'LRANOK W !,"Enter the accession number" K LRAN
Q
;
PAT1 ; EP
S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRIDT=9999999-^(3),LRCDT=+^(3),LREAL=$P(^(3),U,2),LRI=+$O(^(5,0)),LRSPEC=$S($D(^(LRI,0)):+^(0),1:"")
I '$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)) W !,"No tests associated with this accession" D S LRANOK=0 Q
. Q:$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2))," ")=$P(^LRO(68,LRAA,0),U,11)
. W !,"Verify with accession #: ",$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2))
L +^LR(LRDFN,"MI",LRIDT):1 I '$T W !!?10,"Someone else is editing this accession ",!,$C(7) S LRANOK=0 Q
I $D(^LR(LRDFN,"MI",LRIDT,0)) S (LRBG0,Y(0))=^(0)
I '$D(^LR(LRDFN,"MI",LRIDT,0)) D BB
; S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3),LRUNDO=0 D PT^LRX W !!,?5,PNM," SSN: ",SSN W:LRDPF=2 " LOC: ",$S($L(LRWRD):LRWRD,1:$S($D(^LR(LRDFN,.1)):^(.1),1:"??"))
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3),LRUNDO=0
D PT^LRX W !!,?5,PNM," HRCN: ",HRCN
W:LRDPF=2 " LOC: ",$S($L(LRWRD):LRWRD,1:$S($D(^LR(LRDFN,.1)):^(.1),1:"??"))
; ----- END IHS/OIT/MKK - LR*5.2*1030
I $P(^LR(LRDFN,"MI",LRIDT,0),U,3) W !,"Final report has been verified by microbiology supervisor.",$C(7),!,"If you proceed in editing, this report will need to be reverified."
F I=0:0 W !,?10,"OK" S %=1 D YN^DICN Q:% W !,"Enter 'Y' or 'N':"
I %=2!(%<0) S LRCAPOK=0 Q
I $P(^LR(LRDFN,"MI",LRIDT,0),U,3)!$P(^LR(LRDFN,"MI",LRIDT,0),U,9) S LRUNDO=1 ;W:$P(^(0),U,9) !,"(This is an AMENDED report)",!
F I=0:0 D EC^LRMIEDZ4 Q:$D(LRNPTP) W:N=0 !,"NO TESTS ON WORKLIST" Q:N=0 S LRI=1 Q:N'>1 R !,"Choose: ",LRI:DTIME Q:LRI[U!(LRI="") S LRI=+LRI I LRI>0,LRI'>N,LRI?1N.N Q
I LRI[U!(+LRI'>0) S LRCAPOK=0 Q
S LRTS=LRTS(LRI) D:LRUNDO UNDO^LRMIEDZ
K DR S DA=LRIDT,DA(1)=LRDFN,DIE="^LR(LRDFN,""MI"","
S LRSB=$S(LRTX(LRI)["11.5":1,LRTX(LRI)["23":11,LRTX(LRI)["19":8,LRTX(LRI)["15":5,LRTX(LRI)["34":16,1:"")
S LRFIFO=LRTX(LRI)["FIFO",(LREND,LRSAME)=0 D:'LRFIFO TIME^LRMIEDZ3 I LREND K DR Q
S LRSSC=$P(^LR(LRDFN,"MI",LRIDT,0),U,5)_U_$P(^(0),U,11)
; I LRTX(LRI)'["S DR=""[",LRSB X LRTX(LRI) D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) D:'LREND EC3 K DR D:LRUNDO&$P($G(^LR(LRDFN,"MI",LRIDT,LRSB)),U)'="" VT^LRMIUT1 Q
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
I LRTX(LRI)'["S DR=""[",LRSB D Q
. X LRTX(LRI)
. ; D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) ; IHS/OIT/MKK - LR*5.2*1030 - RPMS Does NOT use Clinical Reminders
. I $$PATCH^BLRUTIL4("PXRM*1.5*12") D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) ; IHS/MSC/MKK - LR*5.2*1031
. D:'LREND EC3
. D:BLRLOG ^BLREVTQ("M","R","MICRO")
. K DR
. D:LRUNDO&$P($G(^LR(LRDFN,"MI",LRIDT,LRSB)),U)'="" VT^LRMIUT1
. D TRIG
; ----- END IHS/OIT/MKK - LR*5.2*1030
S (X,DR)=$P($P(LRTX(LRI),"[",2),"]",1) S:$L(X) X=+$O(^DIE("B",X,0)) I X<1,'$D(^DIE(+X,"DR",2,63.05)) W !,DR," template doesn't exist for Microbiology." K DR Q
S J=1 F S J=+$O(^DIE(X,"DR",J)) Q:J<1 S K=+$O(^DIE(X,"DR",J,0)),DR(J-1,K)=^DIE(X,"DR",J,K)
;
; S DR=DR(1,63.05) D ^DIE,UPDATE^LRPXRM(LRDFN,"MI",LRIDT),EC3 K DR
; S DR=DR(1,63.05) D ^DIE,EC3 K DR ; IHS/OIT/MKK - LR*5.2*1030 - RPMS Does NOT use Clinical Reminders
;
I $$PATCH^BLRUTIL4("PXRM*1.5*12") S DR=DR(1,63.05) D ^DIE,UPDATE^LRPXRM(LRDFN,"MI",LRIDT),EC3 K DR ; IHS/MSC/MKK - LR*5.2*1031
I '$$PATCH^BLRUTIL4("PXRM*1.5*12") S DR=DR(1,63.05) D ^DIE,EC3 K DR ; IHS/MSC/MKK - LR*5.2*1031
Q
;
BB ; EP
I '$D(^LR(LRDFN,"MI",0)) S ^LR(LRDFN,"MI",0)="^63.05DA^"
S ^LR(LRDFN,"MI",0)=$P(^LR(LRDFN,"MI",0),U,1,2)_U_LRIDT_U_(1+$P(^(0),U,4))
S ^LR(LRDFN,"MI",LRIDT,0)=LRCDT_U_LREAL_"^^^"_LRSPEC_U_$P(^LRO(68,LRAA,0),U,11)_" "_$E(LRAD,2,3)_" "_LRAN_"^^UNKNOWN",(LRBG0,Y(0))=^(0)
;
D LABSTOR^BLRRLMUM(LRDFN,"MI",LRIDT) ; IHS/MSC/MKK - LR*5.2*1033 -- Store the HL7 data
;
Q
;
EC3 ; EP
S LRSSCN=$P(^LR(LRDFN,"MI",LRIDT,0),U,5)_U_$P(^(0),U,11) D:LRSSCN'=LRSSC UPDATE K LRSSCN,LRSSC S LRSAME=1 D TIME^LRMIEDZ3 D:'LREND STF^LRMIUT
Q
;
UPDATE ; EP
D CHECK K LRSSCOM,LRSSCOM1,LRSSCA,LRSSCAA,LRSSCAY,LRSSCAN,LRSSCOD,LRSSCON
Q
;
CHECK ; EP
S LRSSCA=$P(^LR(LRDFN,"MI",LRIDT,0),U,6),LRSSCAA=+$O(^LRO(68,"B",$P(LRSSCA," "),0))
S X=$P(LRSSCA," ",2) D ^%DT S LRSSCAY=Y,LRSSCAN=$P(LRSSCA," ",3)
S J=0 F I=0:0 S J=+$O(^LRO(68,LRSSCAA,1,LRSSCAY,1,LRSSCAN,5,J)) Q:J<1 I ^(J,0)=LRSSC S ^(0)=LRSSCN Q
I J<1 Q
S LRSSCOD=$P(^LRO(68,LRSSCAA,1,LRSSCAY,1,LRSSCAN,0),U,4),LRSSCON=^(.1)
S J=0 F I=0:0 S J=+$O(^LRO(69,LRSSCOD,1,J)) Q:J<1 I $D(^(J,.1)),^(.1)=LRSSCON D ORDER Q
Q
;
ORDER ; EP
S $P(^LRO(69,LRSSCOD,1,J,0),U,3)=$P(LRSSCN,U,2)
S K=0 F I=0:0 S K=+$O(^LRO(69,LRSSCOD,1,J,4,K)) Q:K<1 I ^(K,0)=LRSSC S ^(0)=LRSSCN Q
Q
;
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
; Added per Appendix A RPMS E-Sig EnhancementV 5.2 Techinical Manual
TRIG ; EP
I $$ADDON^BLRUTIL("LR*5.2*1013","BLRALAF",DUZ(2)) D ^BLRALAF
; ----- END IHS/OIT/MKK - LR*5.2*1030
LRMIEDZ2 ;SLC/CJS/BA,AVAMC/REG - MICROBIOLOGY EDIT ROUTINE ; 22-Oct-2013 09:22 ; MKK
+1 ;;5.2;LAB SERVICE;**1010,1013,1015,1030,1031,1033**;NOV 01, 1997
+2 ;
+3 ;;VA LR Patche(s): 23,104,242,295
+4 ;
+5 ;from LRFAST,LRMIEDZ,LRVER
PAT ; EP
+1 SET X=LRAN
FOR I=0:0
IF '$DATA(LRAN)
READ !!,"Accession #: ",X:DTIME
IF X=""!(X[U)
QUIT
Begin DoDot:1
+2 SET LRANOK=1
SET LRCAPOK=1
DO LRANX^LRMIU4
IF LRANOK
DO PAT1
IF $GET(LRANOK)
LOCK -^LR(LRDFN,"MI",LRIDT)
+3 KILL LRTS
IF LRCAPOK&(LRANOK)&($PIECE(LRPARAM,U,14))
DO ^LRCAPV1
IF LRANOK
KILL LRAN
IF 'LRANOK
WRITE !,"Enter the accession number"
KILL LRAN
End DoDot:1
+4 QUIT
+5 ;
PAT1 ; EP
+1 SET LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)
SET LRIDT=9999999-^(3)
SET LRCDT=+^(3)
SET LREAL=$PIECE(^(3),U,2)
SET LRI=+$ORDER(^(5,0))
SET LRSPEC=$SELECT($DATA(^(LRI,0)):+^(0),1:"")
+2 IF '$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0))
WRITE !,"No tests associated with this accession"
Begin DoDot:1
+3 IF $PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.2))," ")=$PIECE(^LRO(68,LRAA,0),U,11)
QUIT
+4 WRITE !,"Verify with accession #: ",$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.2))
End DoDot:1
SET LRANOK=0
QUIT
+5 LOCK +^LR(LRDFN,"MI",LRIDT):1
IF '$TEST
WRITE !!?10,"Someone else is editing this accession ",!,$CHAR(7)
SET LRANOK=0
QUIT
+6 IF $DATA(^LR(LRDFN,"MI",LRIDT,0))
SET (LRBG0,Y(0))=^(0)
+7 IF '$DATA(^LR(LRDFN,"MI",LRIDT,0))
DO BB
+8 ; S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3),LRUNDO=0 D PT^LRX W !!,?5,PNM," SSN: ",SSN W:LRDPF=2 " LOC: ",$S($L(LRWRD):LRWRD,1:$S($D(^LR(LRDFN,.1)):^(.1),1:"??"))
+9 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+10 SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
SET DFN=$PIECE(^(0),U,3)
SET LRUNDO=0
+11 DO PT^LRX
WRITE !!,?5,PNM," HRCN: ",HRCN
+12 IF LRDPF=2
WRITE " LOC: ",$SELECT($LENGTH(LRWRD):LRWRD,1:$SELECT($DATA(^LR(LRDFN,.1)):^(.1),1:"??"))
+13 ; ----- END IHS/OIT/MKK - LR*5.2*1030
+14 IF $PIECE(^LR(LRDFN,"MI",LRIDT,0),U,3)
WRITE !,"Final report has been verified by microbiology supervisor.",$CHAR(7),!,"If you proceed in editing, this report will need to be reverified."
+15 FOR I=0:0
WRITE !,?10,"OK"
SET %=1
DO YN^DICN
IF %
QUIT
WRITE !,"Enter 'Y' or 'N':"
+16 IF %=2!(%<0)
SET LRCAPOK=0
QUIT
+17 ;W:$P(^(0),U,9) !,"(This is an AMENDED report)",!
IF $PIECE(^LR(LRDFN,"MI",LRIDT,0),U,3)!$PIECE(^LR(LRDFN,"MI",LRIDT,0),U,9)
SET LRUNDO=1
+18 FOR I=0:0
DO EC^LRMIEDZ4
IF $DATA(LRNPTP)
QUIT
IF N=0
WRITE !,"NO TESTS ON WORKLIST"
IF N=0
QUIT
SET LRI=1
IF N'>1
QUIT
READ !,"Choose: ",LRI:DTIME
IF LRI[U!(LRI="")
QUIT
SET LRI=+LRI
IF LRI>0
IF LRI'>N
IF LRI?1N.N
QUIT
+19 IF LRI[U!(+LRI'>0)
SET LRCAPOK=0
QUIT
+20 SET LRTS=LRTS(LRI)
IF LRUNDO
DO UNDO^LRMIEDZ
+21 KILL DR
SET DA=LRIDT
SET DA(1)=LRDFN
SET DIE="^LR(LRDFN,""MI"","
+22 SET LRSB=$SELECT(LRTX(LRI)["11.5":1,LRTX(LRI)["23":11,LRTX(LRI)["19":8,LRTX(LRI)["15":5,LRTX(LRI)["34":16,1:"")
+23 SET LRFIFO=LRTX(LRI)["FIFO"
SET (LREND,LRSAME)=0
IF 'LRFIFO
DO TIME^LRMIEDZ3
IF LREND
KILL DR
QUIT
+24 SET LRSSC=$PIECE(^LR(LRDFN,"MI",LRIDT,0),U,5)_U_$PIECE(^(0),U,11)
+25 ; I LRTX(LRI)'["S DR=""[",LRSB X LRTX(LRI) D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) D:'LREND EC3 K DR D:LRUNDO&$P($G(^LR(LRDFN,"MI",LRIDT,LRSB)),U)'="" VT^LRMIUT1 Q
+26 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+27 IF LRTX(LRI)'["S DR=""["
IF LRSB
Begin DoDot:1
+28 XECUTE LRTX(LRI)
+29 ; D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) ; IHS/OIT/MKK - LR*5.2*1030 - RPMS Does NOT use Clinical Reminders
+30 ; IHS/MSC/MKK - LR*5.2*1031
IF $$PATCH^BLRUTIL4("PXRM*1.5*12")
DO UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
+31 IF 'LREND
DO EC3
+32 IF BLRLOG
DO ^BLREVTQ("M","R","MICRO")
+33 KILL DR
+34 IF LRUNDO&$PIECE($GET(^LR(LRDFN,"MI",LRIDT,LRSB)),U)'=""
DO VT^LRMIUT1
+35 DO TRIG
End DoDot:1
QUIT
+36 ; ----- END IHS/OIT/MKK - LR*5.2*1030
+37 SET (X,DR)=$PIECE($PIECE(LRTX(LRI),"[",2),"]",1)
IF $LENGTH(X)
SET X=+$ORDER(^DIE("B",X,0))
IF X<1
IF '$DATA(^DIE(+X,"DR",2,63.05))
WRITE !,DR," template doesn't exist for Microbiology."
KILL DR
QUIT
+38 SET J=1
FOR
SET J=+$ORDER(^DIE(X,"DR",J))
IF J<1
QUIT
SET K=+$ORDER(^DIE(X,"DR",J,0))
SET DR(J-1,K)=^DIE(X,"DR",J,K)
+39 ;
+40 ; S DR=DR(1,63.05) D ^DIE,UPDATE^LRPXRM(LRDFN,"MI",LRIDT),EC3 K DR
+41 ; S DR=DR(1,63.05) D ^DIE,EC3 K DR ; IHS/OIT/MKK - LR*5.2*1030 - RPMS Does NOT use Clinical Reminders
+42 ;
+43 ; IHS/MSC/MKK - LR*5.2*1031
IF $$PATCH^BLRUTIL4("PXRM*1.5*12")
SET DR=DR(1,63.05)
DO ^DIE
DO UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
DO EC3
KILL DR
+44 ; IHS/MSC/MKK - LR*5.2*1031
IF '$$PATCH^BLRUTIL4("PXRM*1.5*12")
SET DR=DR(1,63.05)
DO ^DIE
DO EC3
KILL DR
+45 QUIT
+46 ;
BB ; EP
+1 IF '$DATA(^LR(LRDFN,"MI",0))
SET ^LR(LRDFN,"MI",0)="^63.05DA^"
+2 SET ^LR(LRDFN,"MI",0)=$PIECE(^LR(LRDFN,"MI",0),U,1,2)_U_LRIDT_U_(1+$PIECE(^(0),U,4))
+3 SET ^LR(LRDFN,"MI",LRIDT,0)=LRCDT_U_LREAL_"^^^"_LRSPEC_U_$PIECE(^LRO(68,LRAA,0),U,11)_" "_$EXTRACT(LRAD,2,3)_" "_LRAN_"^^UNKNOWN"
SET (LRBG0,Y(0))=^(0)
+4 ;
+5 ; IHS/MSC/MKK - LR*5.2*1033 -- Store the HL7 data
DO LABSTOR^BLRRLMUM(LRDFN,"MI",LRIDT)
+6 ;
+7 QUIT
+8 ;
EC3 ; EP
+1 SET LRSSCN=$PIECE(^LR(LRDFN,"MI",LRIDT,0),U,5)_U_$PIECE(^(0),U,11)
IF LRSSCN'=LRSSC
DO UPDATE
KILL LRSSCN,LRSSC
SET LRSAME=1
DO TIME^LRMIEDZ3
IF 'LREND
DO STF^LRMIUT
+2 QUIT
+3 ;
UPDATE ; EP
+1 DO CHECK
KILL LRSSCOM,LRSSCOM1,LRSSCA,LRSSCAA,LRSSCAY,LRSSCAN,LRSSCOD,LRSSCON
+2 QUIT
+3 ;
CHECK ; EP
+1 SET LRSSCA=$PIECE(^LR(LRDFN,"MI",LRIDT,0),U,6)
SET LRSSCAA=+$ORDER(^LRO(68,"B",$PIECE(LRSSCA," "),0))
+2 SET X=$PIECE(LRSSCA," ",2)
DO ^%DT
SET LRSSCAY=Y
SET LRSSCAN=$PIECE(LRSSCA," ",3)
+3 SET J=0
FOR I=0:0
SET J=+$ORDER(^LRO(68,LRSSCAA,1,LRSSCAY,1,LRSSCAN,5,J))
IF J<1
QUIT
IF ^(J,0)=LRSSC
SET ^(0)=LRSSCN
QUIT
+4 IF J<1
QUIT
+5 SET LRSSCOD=$PIECE(^LRO(68,LRSSCAA,1,LRSSCAY,1,LRSSCAN,0),U,4)
SET LRSSCON=^(.1)
+6 SET J=0
FOR I=0:0
SET J=+$ORDER(^LRO(69,LRSSCOD,1,J))
IF J<1
QUIT
IF $DATA(^(J,.1))
IF ^(.1)=LRSSCON
DO ORDER
QUIT
+7 QUIT
+8 ;
ORDER ; EP
+1 SET $PIECE(^LRO(69,LRSSCOD,1,J,0),U,3)=$PIECE(LRSSCN,U,2)
+2 SET K=0
FOR I=0:0
SET K=+$ORDER(^LRO(69,LRSSCOD,1,J,4,K))
IF K<1
QUIT
IF ^(K,0)=LRSSC
SET ^(0)=LRSSCN
QUIT
+3 QUIT
+4 ;
+5 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+6 ; Added per Appendix A RPMS E-Sig EnhancementV 5.2 Techinical Manual
TRIG ; EP
+1 IF $$ADDON^BLRUTIL("LR*5.2*1013","BLRALAF",DUZ(2))
DO ^BLRALAF
+2 ; ----- END IHS/OIT/MKK - LR*5.2*1030
