LRMIPSZ3 ;DALOI/STAFF - MICRO PATIENT REPORT - STERILITY, PARASITES, VIRUS ;Jul 15, 2021@13:13
;;5.2;LAB SERVICE;**350,427,547**;Sep 27, 1994;Build 10
;
; Reference for DD global supported by ICR #999
Q
;
;
STER ;
; from LRMIPSZ1
; also called from RPT^LROR4
N I,LRBLDTMP,LRERR,LRFLAG,LRX,X
S LRBLDTMP=0
I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT)) D
. S LRBLDTMP=1
. M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)
. K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,32)
;
I $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,1),U,7)'="" D Q:LRABORT
. D NP Q:LRABORT
. S LRX=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,1),U,7)
. S LRX(0)=$$EXTERNAL^DILFD(63.05,11.51,"",LRX,"LRERR")
. I $D(LRERR) S LRX(0)=LRX K LRERR
. W !,"STERILITY CONTROL: ",LRX(0)
;
S LRFLAG=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,31,0))
I LRFLAG W !
S I=0
F S I=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,31,I)) Q:I<1 D Q:LRABORT
. D NP Q:LRABORT
. S LRX=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,31,I,0),"^")
. S LRX(0)=$$EXTERNAL^DILFD(63.292,.01,"",LRX,"LRERR")
. I $D(LRERR) S LRX(0)=LRX K LRERR
. W !,"NUMBER: ",I,?20,"STERILITY RESULTS: ",LRX(0)
I LRFLAG W !
;
I LRBLDTMP K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)
Q
;
;
PARA ;
; from LRMIPSZ1
; also called from RPT^LROR4
N LRBLDTMP,LRQUIT
S (LRBLDTMP,LRQUIT)=0
I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT)) D ;
. S LRBLDTMP=1
. M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)
. K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,32)
;
I $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,5),U)="",'$G(LRLABKY) D S:'$D(LRWRDVEW) LRQUIT=1 S:LRSB'=5 LRQUIT=1
. Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,5))
. ;LR*5.2*547: Display informational message if accession/test is currently being edited
. ; and results had previously been verified.
. N LR7SB S LR7SB=5
. D MES^LRMIPSZ2
;
I LRQUIT D Q
. I LRBLDTMP K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)
;
S LRTUS=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,5),U,2)
S DZ=$P(^(5),U,3),Y=$P(^(5),U)
D D^LRU
I LRHC W ! D NP Q:LRABORT
W !,"* PARASITOLOGY ",$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => ",Y," TECH CODE: ",DZ
D NP Q:LRABORT
S LRPRE=21 D PRE^LRMIPSU
D NP Q:LRABORT
I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,24)) D ;
. I LRHC W ! D NP Q:LRABORT
. W !,"PARASITOLOGY SMEAR/PREP:"
. D NP Q:LRABORT
. S LRMYC=0
. F I=0:0 S LRMYC=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,24,LRMYC)) Q:LRMYC<1 W !?5,^(LRMYC,0) D NP Q:LRABORT
;
S LRPAR=0
F S LRPAR=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,LRPAR)) Q:LRPAR<1 Q:LRABORT W:LRHC ! D NP Q:LRABORT Q:'$D(^(LRPAR,0)) W !,"Parasite: ",$E($P(^LAB(61.2,^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,LRPAR,0),0),U),1,25),?30," " D STG D NP Q:LRABORT
;
I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7)) D ;
. W:LRHC ! D NP Q:LRABORT
. W !,"Parasitology Remark(s):"
. D NP Q:LRABORT
. S LRPAR=0
. F S LRPAR=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7,LRPAR)) Q:LRPAR<1 Q:LRABORT W !,?3,^(LRPAR,0) D NP Q:LRABORT ;
;
I LRBLDTMP D ;
. K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)
;
Q
;
;
STG ;
N B
D NP Q:LRABORT
S LRBUG(LRPAR)=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,LRPAR,0)
S S1=6,LRTA=LRPAR
I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,S1,LRTA,1)) D ;
. S B=0
. F S B=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,S1,LRTA,1,B)) Q:B<1 Q:LRABORT S Y=^(B,0),Y1=$P(Y,U,2) W !," Stage: " D SET D NP Q:LRABORT W:$L(Y1) !," Quantity: ",Y1 D LIST1 D NP Q:LRABORT
;
Q
;
;
SET ;
; File DD/999
S LRSET=$P(^DD(63.35,.01,0),U,3),%=$P($P(";"_LRSET,";"_$P(Y,U)_":",2),";") W:%]"" %
Q
;
;
LIST1 ;
N C
D NP Q:LRABORT
W !," Comment: "
S C=0
F S C=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,S1,LRTA,1,B,1,C)) Q:C<1 W ?13,^(C,0),! D NP Q:LRABORT
Q
;
;
VIR ;
; from LRMIPSZ1
; also called from RPT^LROR4
N LRBLDTMP,LRQUIT
S (LRQUIT,LRBLDTMP)=0
I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT)) D ;
. S LRBLDTMP=1
. M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)
. K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,32)
;
I $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,16),U)="",'$G(LRLABKY) D S:'$D(LRWRDVEW) LRQUIT=1 S:LRSB'=16 LRQUIT=1
. Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,16))
. ;LR*5.2*547: Display informational message if accession/test is currently being edited
. ; and results had previously been verified.
. N LR7SB S LR7SB=16
. D MES^LRMIPSZ2
;
I LRQUIT D Q
. I LRBLDTMP K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)
;
S LRTUS=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,16),U,2)
S DZ=$P(^(16),U,3),Y=$P(^(16),U)
D D^LRU
I LRHC W ! D NP Q:LRABORT
W !,"* VIROLOGY ",$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => ",Y," TECH CODE: ",DZ
D NP Q:LRABORT
S LRPRE=20
D PRE^LRMIPSU
S LRPAR=0
F S LRPAR=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,LRPAR)) Q:LRPAR<1 D Q:LRABORT ;
. I LRHC W !
. D NP Q:LRABORT
. W !,"Virus: ",$P(^LAB(61.2,$P(^(LRPAR,0),U),0),U)
. S LRBUG(LRPAR)=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,LRPAR,0)
;
I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18)) D ;
. W:LRHC !
. D NP Q:LRABORT
. W !,"Virology Remark(s):"
. D NP Q:LRABORT
. S LRPAR=0
. F S LRPAR=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18,LRPAR)) Q:LRPAR<1 W !,?3,^(LRPAR,0) D NP Q:LRABORT ;
;
I LRBLDTMP D ;
. K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)
Q
;
;
NP ;
; Convenience method
D NP^LRMIPSZ1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIPSZ3 5348 printed Oct 16, 2024@18:17:59 Page 2
LRMIPSZ3 ;DALOI/STAFF - MICRO PATIENT REPORT - STERILITY, PARASITES, VIRUS ;Jul 15, 2021@13:13
+1 ;;5.2;LAB SERVICE;**350,427,547**;Sep 27, 1994;Build 10
+2 ;
+3 ; Reference for DD global supported by ICR #999
+4 QUIT
+5 ;
+6 ;
STER ;
+1 ; from LRMIPSZ1
+2 ; also called from RPT^LROR4
+3 NEW I,LRBLDTMP,LRERR,LRFLAG,LRX,X
+4 SET LRBLDTMP=0
+5 IF '$DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT))
Begin DoDot:1
+6 SET LRBLDTMP=1
+7 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)
+8 KILL ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,32)
End DoDot:1
+9 ;
+10 IF $PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,1),U,7)'=""
Begin DoDot:1
+11 DO NP
if LRABORT
QUIT
+12 SET LRX=$PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,1),U,7)
+13 SET LRX(0)=$$EXTERNAL^DILFD(63.05,11.51,"",LRX,"LRERR")
+14 IF $DATA(LRERR)
SET LRX(0)=LRX
KILL LRERR
+15 WRITE !,"STERILITY CONTROL: ",LRX(0)
End DoDot:1
if LRABORT
QUIT
+16 ;
+17 SET LRFLAG=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,31,0))
+18 IF LRFLAG
WRITE !
+19 SET I=0
+20 FOR
SET I=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,31,I))
if I<1
QUIT
Begin DoDot:1
+21 DO NP
if LRABORT
QUIT
+22 SET LRX=$PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,31,I,0),"^")
+23 SET LRX(0)=$$EXTERNAL^DILFD(63.292,.01,"",LRX,"LRERR")
+24 IF $DATA(LRERR)
SET LRX(0)=LRX
KILL LRERR
+25 WRITE !,"NUMBER: ",I,?20,"STERILITY RESULTS: ",LRX(0)
End DoDot:1
if LRABORT
QUIT
+26 IF LRFLAG
WRITE !
+27 ;
+28 IF LRBLDTMP
KILL ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT)
+29 QUIT
+30 ;
+31 ;
PARA ;
+1 ; from LRMIPSZ1
+2 ; also called from RPT^LROR4
+3 NEW LRBLDTMP,LRQUIT
+4 SET (LRBLDTMP,LRQUIT)=0
+5 ;
IF '$DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT))
Begin DoDot:1
+6 SET LRBLDTMP=1
+7 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)
+8 KILL ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,32)
End DoDot:1
+9 ;
+10 IF $PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,5),U)=""
IF '$GET(LRLABKY)
Begin DoDot:1
+11 if '$DATA(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,5))
QUIT
+12 ;LR*5.2*547: Display informational message if accession/test is currently being edited
+13 ; and results had previously been verified.
+14 NEW LR7SB
SET LR7SB=5
+15 DO MES^LRMIPSZ2
End DoDot:1
if '$DATA(LRWRDVEW)
SET LRQUIT=1
if LRSB'=5
SET LRQUIT=1
+16 ;
+17 IF LRQUIT
Begin DoDot:1
+18 IF LRBLDTMP
KILL ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT)
End DoDot:1
QUIT
+19 ;
+20 SET LRTUS=$PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,5),U,2)
+21 SET DZ=$PIECE(^(5),U,3)
SET Y=$PIECE(^(5),U)
+22 DO D^LRU
+23 IF LRHC
WRITE !
DO NP
if LRABORT
QUIT
+24 WRITE !,"* PARASITOLOGY ",$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => ",Y," TECH CODE: ",DZ
+25 DO NP
if LRABORT
QUIT
+26 SET LRPRE=21
DO PRE^LRMIPSU
+27 DO NP
if LRABORT
QUIT
+28 ;
IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,24))
Begin DoDot:1
+29 IF LRHC
WRITE !
DO NP
if LRABORT
QUIT
+30 WRITE !,"PARASITOLOGY SMEAR/PREP:"
+31 DO NP
if LRABORT
QUIT
+32 SET LRMYC=0
+33 FOR I=0:0
SET LRMYC=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,24,LRMYC))
if LRMYC<1
QUIT
WRITE !?5,^(LRMYC,0)
DO NP
if LRABORT
QUIT
End DoDot:1
+34 ;
+35 SET LRPAR=0
+36 FOR
SET LRPAR=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,6,LRPAR))
if LRPAR<1
QUIT
if LRABORT
QUIT
if LRHC
WRITE !
DO NP
if LRABORT
QUIT
if '$DATA(^(LRPAR,0))
QUIT
WRITE !,"Parasite: ",$EXTRACT($PIECE(^LAB(61.2,^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,6,LRPAR,0),0),U),1,25),?30," "
DO STG
DO NP
if LRABORT
QUIT
+37 ;
+38 ;
IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,7))
Begin DoDot:1
+39 if LRHC
WRITE !
DO NP
if LRABORT
QUIT
+40 WRITE !,"Parasitology Remark(s):"
+41 DO NP
if LRABORT
QUIT
+42 SET LRPAR=0
+43 ;
FOR
SET LRPAR=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,7,LRPAR))
if LRPAR<1
QUIT
if LRABORT
QUIT
WRITE !,?3,^(LRPAR,0)
DO NP
if LRABORT
QUIT
End DoDot:1
+44 ;
+45 ;
IF LRBLDTMP
Begin DoDot:1
+46 KILL ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT)
End DoDot:1
+47 ;
+48 QUIT
+49 ;
+50 ;
STG ;
+1 NEW B
+2 DO NP
if LRABORT
QUIT
+3 SET LRBUG(LRPAR)=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,6,LRPAR,0)
+4 SET S1=6
SET LRTA=LRPAR
+5 ;
IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,S1,LRTA,1))
Begin DoDot:1
+6 SET B=0
+7 FOR
SET B=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,S1,LRTA,1,B))
if B<1
QUIT
if LRABORT
QUIT
SET Y=^(B,0)
SET Y1=$PIECE(Y,U,2)
WRITE !," Stage: "
DO SET
DO NP
if LRABORT
QUIT
if $LENGTH(Y1)
WRITE !," Quantity: ",Y1
DO LIST1
DO NP
if LRABORT
QUIT
End DoDot:1
+8 ;
+9 QUIT
+10 ;
+11 ;
SET ;
+1 ; File DD/999
+2 SET LRSET=$PIECE(^DD(63.35,.01,0),U,3)
SET %=$PIECE($PIECE(";"_LRSET,";"_$PIECE(Y,U)_":",2),";")
if %]""
WRITE %
+3 QUIT
+4 ;
+5 ;
LIST1 ;
+1 NEW C
+2 DO NP
if LRABORT
QUIT
+3 WRITE !," Comment: "
+4 SET C=0
+5 FOR
SET C=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,S1,LRTA,1,B,1,C))
if C<1
QUIT
WRITE ?13,^(C,0),!
DO NP
if LRABORT
QUIT
+6 QUIT
+7 ;
+8 ;
VIR ;
+1 ; from LRMIPSZ1
+2 ; also called from RPT^LROR4
+3 NEW LRBLDTMP,LRQUIT
+4 SET (LRQUIT,LRBLDTMP)=0
+5 ;
IF '$DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT))
Begin DoDot:1
+6 SET LRBLDTMP=1
+7 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)
+8 KILL ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,32)
End DoDot:1
+9 ;
+10 IF $PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,16),U)=""
IF '$GET(LRLABKY)
Begin DoDot:1
+11 if '$DATA(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,16))
QUIT
+12 ;LR*5.2*547: Display informational message if accession/test is currently being edited
+13 ; and results had previously been verified.
+14 NEW LR7SB
SET LR7SB=16
+15 DO MES^LRMIPSZ2
End DoDot:1
if '$DATA(LRWRDVEW)
SET LRQUIT=1
if LRSB'=16
SET LRQUIT=1
+16 ;
+17 IF LRQUIT
Begin DoDot:1
+18 IF LRBLDTMP
KILL ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT)
End DoDot:1
QUIT
+19 ;
+20 SET LRTUS=$PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,16),U,2)
+21 SET DZ=$PIECE(^(16),U,3)
SET Y=$PIECE(^(16),U)
+22 DO D^LRU
+23 IF LRHC
WRITE !
DO NP
if LRABORT
QUIT
+24 WRITE !,"* VIROLOGY ",$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => ",Y," TECH CODE: ",DZ
+25 DO NP
if LRABORT
QUIT
+26 SET LRPRE=20
+27 DO PRE^LRMIPSU
+28 SET LRPAR=0
+29 ;
FOR
SET LRPAR=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,17,LRPAR))
if LRPAR<1
QUIT
Begin DoDot:1
+30 IF LRHC
WRITE !
+31 DO NP
if LRABORT
QUIT
+32 WRITE !,"Virus: ",$PIECE(^LAB(61.2,$PIECE(^(LRPAR,0),U),0),U)
+33 SET LRBUG(LRPAR)=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,17,LRPAR,0)
End DoDot:1
if LRABORT
QUIT
+34 ;
+35 ;
IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,18))
Begin DoDot:1
+36 if LRHC
WRITE !
+37 DO NP
if LRABORT
QUIT
+38 WRITE !,"Virology Remark(s):"
+39 DO NP
if LRABORT
QUIT
+40 SET LRPAR=0
+41 ;
FOR
SET LRPAR=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,18,LRPAR))
if LRPAR<1
QUIT
WRITE !,?3,^(LRPAR,0)
DO NP
if LRABORT
QUIT
End DoDot:1
+42 ;
+43 ;
IF LRBLDTMP
Begin DoDot:1
+44 KILL ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT)
End DoDot:1
+45 QUIT
+46 ;
+47 ;
NP ;
+1 ; Convenience method
+2 DO NP^LRMIPSZ1
+3 QUIT
