- 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 Dec 13, 2024@02:17:15 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