LR7OSMZ1 ;DALOI/JMC - Silent Micro rpt Cont. ;Mar 05, 2019@13:04:42
;;5.2;LAB SERVICE;**121,244,350,520,536**;Sep 27, 1994;Build 18
;
EN ; from LRMINEW2, LRMIPC, LRMIPLOG, LR7OSMZ, LRMIVER1
S LRSPEC=$P(LRLLT,U,5)
I LRONESPC'="",LRSPEC'=LRONESPC Q
;
N GIOM
S GIOM=$G(LRGIOM)
I GIOM="" D
. S GIOM=$$GET^XPAR("USR^DIV^PKG","LR MI GUI REPORT RIGHT MARGIN",1,"Q")
. I GIOM="" S GIOM=80
;
D RPT
K %,A8,A,AB,B,B1,B2,B3,C,IA,LR1PASS,LR2ORMOR,LRABCNT,LRACNT,LRAO,LRADM,LRADX,LRAFS,LRAMT,LRAX,LRBN,LRBRR,LRBUG,LRCOMTAB,LRCS,LRDCOM,LRDOC,LRDRTM1,LRDRTM2,LREF,LRFMT,LRGRM,LRIFN,LRINT,LRPATLOC,LRMYC,LRNS,LRNUM
K LRORG,LRPAR,LRPC,LRPRE,LRPRINT,LRQU,LRRC,LRRES,LRSBC1,LRSBC2,LRSET,LRSIC1,LRSIC2,LRSPEC,LRSSD,LRST,LRTA,LRTB,LRTBA,LRTBC,LRTBS,LRTK,LRTS,LRTSTS,LRTUS,LRUS,LRWRD,N
Q
;
;
RPT ;
;
N J,LRTSTS,LRTS,LRTESTCOMPLE,LRX,LRY,LRDISP
;
S:'$D(LRSB) LRSB=0
S LRPRINT=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,4)):"",1:1),LRPATLOC=$P(LRLLT,U,8)
S LRCS=$S($D(^LAB(62,+$P(LRLLT,U,11),0)):$P(^(0),U),1:"")
S LRTK=$P(LRLLT,U),LRRC=$P(LRLLT,U,10),LRST=$S(LRSPEC:$P(^LAB(61,LRSPEC,0),U),1:""),Y=LRTK
D D^LRU
S LRTK=Y,Y=LRRC
D D^LRU
S LRRC=Y,X=$P(LRLLT,U,7)
D DOC^LRX
;
K ^TMP("LR",$J,"T"),LRTSTS
;
S (LRBRR,LRTESTCOMPLE)=0
F S LRBRR=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR)) Q:LRBRR<1 D EN1
I 'LRPRINT,LRONETST Q
S LRPG=0
D HDR^LR7OSMZU
Q:LREND
;
I $D(^TMP("LR",$J,"T")) D
. D LINE^LR7OSUM4,LN
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(2,CCNT,"Test(s) ordered:")
. S J=""
. F S J=$O(^TMP("LR",$J,"T",J)) Q:J="" S X=^(J) D
. . S LRX=$P(X,"^")
. . I LRTESTCOMPLE S LRX=$$LJ^XLFSTR(LRX,30,".")
. . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(19,CCNT,LRX)
. . S:'$D(^TMP("LRT",$J,$P(X,"^"))) ^($P(X,"^"))="MICROBIOLOGY"_"^"_GCNT
. . I '$P(X,U,2) D LN S ^TMP("LRC",$J,GCNT,0)="" Q
. . S Y=$P(X,U,2)
. . ; LR*5.2*520 and LR*5.2*536
. . S LRDISP=$P(X,U,3)
. . D D^LRU S LRY=$S(LRDISP["Not Performed":"canceled: ",1:"completed: ")_Y
. . I (19+$L(LRX)+$L(LRY))>GIOM D LN S ^TMP("LRC",$J,GCNT,0)=""
. . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(50,CCNT,LRY)
. . D LN S ^TMP("LRC",$J,GCNT,0)=""
;
K ^TMP("LR",$J,"T"),LRTSTS
;
I $D(^LR(LRDFN,"MI",LRIDT,14)) D ANTI^LR7OSMZ2,LINE^LR7OSUM4
I $D(^LR(LRDFN,"MI",LRIDT,1)) D BACT^LR7OSMZ2,REFS^LR7OSMZU,LINE^LR7OSUM4
I $D(^LR(LRDFN,"MI",LRIDT,31)) D STER^LR7OSMZ3,LINE^LR7OSUM4
I $D(^LR(LRDFN,"MI",LRIDT,5)) D PARA^LR7OSMZ3,REFS^LR7OSMZU,LINE^LR7OSUM4
I $D(^LR(LRDFN,"MI",LRIDT,16)) D VIR^LR7OSMZ3,REFS^LR7OSMZU,LINE^LR7OSUM4
I $D(^LR(LRDFN,"MI",LRIDT,11)) D TB^LR7OSMZ4,REFS^LR7OSMZU,LINE^LR7OSUM4
I $D(^LR(LRDFN,"MI",LRIDT,8)) D FUNG^LR7OSMZ4,REFS^LR7OSMZU,LINE^LR7OSUM4
;
; List performing labs
D PPL(LRDFN,"MI",LRIDT)
;
Q
;
;
EN1 ;
; LR*5.2*520 Set disposition to LRDISP
S LRTS=+^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR,0),LRTS(1)=$P(^(0),U,5),LRDISP=$P(^(0),U,6)
Q:'$L($P($G(^LAB(60,LRTS,0)),U,3))
I '$D(LRLABKY),"BO"'[$P($G(^LAB(60,LRTS,0)),U,3) Q
;
; Set flag that at least one test is completed
I LRTS(1) S LRTESTCOMPLE=1
;
S:LRTS=LRONETST LRPRINT=1
S LRTSTS=$S($D(^LAB(60,LRTS,0)):$P(^(0),U),1:"deleted test"),^TMP("LR",$J,"T",$S($D(^LAB(60,LRTS,.1)):$P(^(.1),U,6),1:"")_","_LRBRR)=LRTSTS_U_LRTS(1)_U_LRDISP
Q
;
;
LN ;Increment counter
S GCNT=GCNT+1,CCNT=1
Q
;
;
PPL(LRDFN,LRSS,LRIDT) ; Print any performing laboratories
; Call with LRDFN = file #63 IEN
; LRSS = File #63 subscript
; LRIDT = file #63 specimen inverse date/time
;
N LRPL,LRI,LRX
;
D RETLST^LRRPL(.LRPL,LRDFN,LRSS,LRIDT,0)
I $G(LRPL)<1 Q
;
D LN S LRX="=--",^TMP("LRC",$J,GCNT,0)=$$REPEAT^XLFSTR(LRX,GIOM/$L(LRX))
D LN S ^TMP("LRC",$J,GCNT,0)="Performing Laboratory:"
;
S LRI=0
F S LRI=$O(LRPL(LRI)) Q:'LRI D LN S ^TMP("LRC",$J,GCNT,0)=LRPL(LRI)
D LN S ^TMP("LRC",$J,GCNT,0)=""
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OSMZ1 3883 printed Apr 09, 2024@21:23:28 Page 2
LR7OSMZ1 ;DALOI/JMC - Silent Micro rpt Cont. ;Mar 05, 2019@13:04:42
+1 ;;5.2;LAB SERVICE;**121,244,350,520,536**;Sep 27, 1994;Build 18
+2 ;
EN ; from LRMINEW2, LRMIPC, LRMIPLOG, LR7OSMZ, LRMIVER1
+1 SET LRSPEC=$PIECE(LRLLT,U,5)
+2 IF LRONESPC'=""
IF LRSPEC'=LRONESPC
QUIT
+3 ;
+4 NEW GIOM
+5 SET GIOM=$GET(LRGIOM)
+6 IF GIOM=""
Begin DoDot:1
+7 SET GIOM=$$GET^XPAR("USR^DIV^PKG","LR MI GUI REPORT RIGHT MARGIN",1,"Q")
+8 IF GIOM=""
SET GIOM=80
End DoDot:1
+9 ;
+10 DO RPT
+11 KILL %,A8,A,AB,B,B1,B2,B3,C,IA,LR1PASS,LR2ORMOR,LRABCNT,LRACNT,LRAO,LRADM,LRADX,LRAFS,LRAMT,LRAX,LRBN,LRBRR,LRBUG,LRCOMTAB,LRCS,LRDCOM,LRDOC,LRDRTM1,LRDRTM2,LREF,LRFMT,LRGRM,LRIFN,LRINT,LRPATLOC,LRMYC,LRNS,LRNUM
+12 KILL LRORG,LRPAR,LRPC,LRPRE,LRPRINT,LRQU,LRRC,LRRES,LRSBC1,LRSBC2,LRSET,LRSIC1,LRSIC2,LRSPEC,LRSSD,LRST,LRTA,LRTB,LRTBA,LRTBC,LRTBS,LRTK,LRTS,LRTSTS,LRTUS,LRUS,LRWRD,N
+13 QUIT
+14 ;
+15 ;
RPT ;
+1 ;
+2 NEW J,LRTSTS,LRTS,LRTESTCOMPLE,LRX,LRY,LRDISP
+3 ;
+4 if '$DATA(LRSB)
SET LRSB=0
+5 SET LRPRINT=$SELECT($DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4)):"",1:1)
SET LRPATLOC=$PIECE(LRLLT,U,8)
+6 SET LRCS=$SELECT($DATA(^LAB(62,+$PIECE(LRLLT,U,11),0)):$PIECE(^(0),U),1:"")
+7 SET LRTK=$PIECE(LRLLT,U)
SET LRRC=$PIECE(LRLLT,U,10)
SET LRST=$SELECT(LRSPEC:$PIECE(^LAB(61,LRSPEC,0),U),1:"")
SET Y=LRTK
+8 DO D^LRU
+9 SET LRTK=Y
SET Y=LRRC
+10 DO D^LRU
+11 SET LRRC=Y
SET X=$PIECE(LRLLT,U,7)
+12 DO DOC^LRX
+13 ;
+14 KILL ^TMP("LR",$JOB,"T"),LRTSTS
+15 ;
+16 SET (LRBRR,LRTESTCOMPLE)=0
+17 FOR
SET LRBRR=+$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR))
if LRBRR<1
QUIT
DO EN1
+18 IF 'LRPRINT
IF LRONETST
QUIT
+19 SET LRPG=0
+20 DO HDR^LR7OSMZU
+21 if LREND
QUIT
+22 ;
+23 IF $DATA(^TMP("LR",$JOB,"T"))
Begin DoDot:1
+24 DO LINE^LR7OSUM4
DO LN
+25 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(2,CCNT,"Test(s) ordered:")
+26 SET J=""
+27 FOR
SET J=$ORDER(^TMP("LR",$JOB,"T",J))
if J=""
QUIT
SET X=^(J)
Begin DoDot:2
+28 SET LRX=$PIECE(X,"^")
+29 IF LRTESTCOMPLE
SET LRX=$$LJ^XLFSTR(LRX,30,".")
+30 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(19,CCNT,LRX)
+31 if '$DATA(^TMP("LRT",$JOB,$PIECE(X,"^")))
SET ^($PIECE(X,"^"))="MICROBIOLOGY"_"^"_GCNT
+32 IF '$PIECE(X,U,2)
DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=""
QUIT
+33 SET Y=$PIECE(X,U,2)
+34 ; LR*5.2*520 and LR*5.2*536
+35 SET LRDISP=$PIECE(X,U,3)
+36 DO D^LRU
SET LRY=$SELECT(LRDISP["Not Performed":"canceled: ",1:"completed: ")_Y
+37 IF (19+$LENGTH(LRX)+$LENGTH(LRY))>GIOM
DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=""
+38 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(50,CCNT,LRY)
+39 DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=""
End DoDot:2
End DoDot:1
+40 ;
+41 KILL ^TMP("LR",$JOB,"T"),LRTSTS
+42 ;
+43 IF $DATA(^LR(LRDFN,"MI",LRIDT,14))
DO ANTI^LR7OSMZ2
DO LINE^LR7OSUM4
+44 IF $DATA(^LR(LRDFN,"MI",LRIDT,1))
DO BACT^LR7OSMZ2
DO REFS^LR7OSMZU
DO LINE^LR7OSUM4
+45 IF $DATA(^LR(LRDFN,"MI",LRIDT,31))
DO STER^LR7OSMZ3
DO LINE^LR7OSUM4
+46 IF $DATA(^LR(LRDFN,"MI",LRIDT,5))
DO PARA^LR7OSMZ3
DO REFS^LR7OSMZU
DO LINE^LR7OSUM4
+47 IF $DATA(^LR(LRDFN,"MI",LRIDT,16))
DO VIR^LR7OSMZ3
DO REFS^LR7OSMZU
DO LINE^LR7OSUM4
+48 IF $DATA(^LR(LRDFN,"MI",LRIDT,11))
DO TB^LR7OSMZ4
DO REFS^LR7OSMZU
DO LINE^LR7OSUM4
+49 IF $DATA(^LR(LRDFN,"MI",LRIDT,8))
DO FUNG^LR7OSMZ4
DO REFS^LR7OSMZU
DO LINE^LR7OSUM4
+50 ;
+51 ; List performing labs
+52 DO PPL(LRDFN,"MI",LRIDT)
+53 ;
+54 QUIT
+55 ;
+56 ;
EN1 ;
+1 ; LR*5.2*520 Set disposition to LRDISP
+2 SET LRTS=+^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR,0)
SET LRTS(1)=$PIECE(^(0),U,5)
SET LRDISP=$PIECE(^(0),U,6)
+3 if '$LENGTH($PIECE($GET(^LAB(60,LRTS,0)),U,3))
QUIT
+4 IF '$DATA(LRLABKY)
IF "BO"'[$PIECE($GET(^LAB(60,LRTS,0)),U,3)
QUIT
+5 ;
+6 ; Set flag that at least one test is completed
+7 IF LRTS(1)
SET LRTESTCOMPLE=1
+8 ;
+9 if LRTS=LRONETST
SET LRPRINT=1
+10 SET LRTSTS=$SELECT($DATA(^LAB(60,LRTS,0)):$PIECE(^(0),U),1:"deleted test")
SET ^TMP("LR",$JOB,"T",$SELECT($DATA(^LAB(60,LRTS,.1)):$PIECE(^(.1),U,6),1:"")_","_LRBRR)=LRTSTS_U_LRTS(1)_U_LRDISP
+11 QUIT
+12 ;
+13 ;
LN ;Increment counter
+1 SET GCNT=GCNT+1
SET CCNT=1
+2 QUIT
+3 ;
+4 ;
PPL(LRDFN,LRSS,LRIDT) ; Print any performing laboratories
+1 ; Call with LRDFN = file #63 IEN
+2 ; LRSS = File #63 subscript
+3 ; LRIDT = file #63 specimen inverse date/time
+4 ;
+5 NEW LRPL,LRI,LRX
+6 ;
+7 DO RETLST^LRRPL(.LRPL,LRDFN,LRSS,LRIDT,0)
+8 IF $GET(LRPL)<1
QUIT
+9 ;
+10 DO LN
SET LRX="=--"
SET ^TMP("LRC",$JOB,GCNT,0)=$$REPEAT^XLFSTR(LRX,GIOM/$LENGTH(LRX))
+11 DO LN
SET ^TMP("LRC",$JOB,GCNT,0)="Performing Laboratory:"
+12 ;
+13 SET LRI=0
+14 FOR
SET LRI=$ORDER(LRPL(LRI))
if 'LRI
QUIT
DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=LRPL(LRI)
+15 DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=""
+16 ;
+17 QUIT
