Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRMIPSZ3

LRMIPSZ3.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Reference for DD global supported by ICR #999
  1. Q
  1. ;
  1. ;
  1. STER ;
  1. ; from LRMIPSZ1
  1. ; also called from RPT^LROR4
  1. N I,LRBLDTMP,LRERR,LRFLAG,LRX,X
  1. S LRBLDTMP=0
  1. I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT)) D
  1. . S LRBLDTMP=1
  1. . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)
  1. . K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,32)
  1. ;
  1. I $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,1),U,7)'="" D Q:LRABORT
  1. . D NP Q:LRABORT
  1. . S LRX=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,1),U,7)
  1. . S LRX(0)=$$EXTERNAL^DILFD(63.05,11.51,"",LRX,"LRERR")
  1. . I $D(LRERR) S LRX(0)=LRX K LRERR
  1. . W !,"STERILITY CONTROL: ",LRX(0)
  1. ;
  1. S LRFLAG=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,31,0))
  1. I LRFLAG W !
  1. S I=0
  1. F S I=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,31,I)) Q:I<1 D Q:LRABORT
  1. . D NP Q:LRABORT
  1. . S LRX=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,31,I,0),"^")
  1. . S LRX(0)=$$EXTERNAL^DILFD(63.292,.01,"",LRX,"LRERR")
  1. . I $D(LRERR) S LRX(0)=LRX K LRERR
  1. . W !,"NUMBER: ",I,?20,"STERILITY RESULTS: ",LRX(0)
  1. I LRFLAG W !
  1. ;
  1. I LRBLDTMP K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)
  1. Q
  1. ;
  1. ;
  1. PARA ;
  1. ; from LRMIPSZ1
  1. ; also called from RPT^LROR4
  1. N LRBLDTMP,LRQUIT
  1. S (LRBLDTMP,LRQUIT)=0
  1. I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT)) D ;
  1. . S LRBLDTMP=1
  1. . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)
  1. . K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,32)
  1. ;
  1. I $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,5),U)="",'$G(LRLABKY) D S:'$D(LRWRDVEW) LRQUIT=1 S:LRSB'=5 LRQUIT=1
  1. . Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,5))
  1. . ;LR*5.2*547: Display informational message if accession/test is currently being edited
  1. . ; and results had previously been verified.
  1. . N LR7SB S LR7SB=5
  1. . D MES^LRMIPSZ2
  1. ;
  1. I LRQUIT D Q
  1. . I LRBLDTMP K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)
  1. ;
  1. S LRTUS=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,5),U,2)
  1. S DZ=$P(^(5),U,3),Y=$P(^(5),U)
  1. D D^LRU
  1. I LRHC W ! D NP Q:LRABORT
  1. W !,"* PARASITOLOGY ",$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => ",Y," TECH CODE: ",DZ
  1. D NP Q:LRABORT
  1. S LRPRE=21 D PRE^LRMIPSU
  1. D NP Q:LRABORT
  1. I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,24)) D ;
  1. . I LRHC W ! D NP Q:LRABORT
  1. . W !,"PARASITOLOGY SMEAR/PREP:"
  1. . D NP Q:LRABORT
  1. . S LRMYC=0
  1. . 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
  1. ;
  1. S LRPAR=0
  1. 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
  1. ;
  1. I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7)) D ;
  1. . W:LRHC ! D NP Q:LRABORT
  1. . W !,"Parasitology Remark(s):"
  1. . D NP Q:LRABORT
  1. . S LRPAR=0
  1. . 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 ;
  1. ;
  1. I LRBLDTMP D ;
  1. . K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)
  1. ;
  1. Q
  1. ;
  1. ;
  1. STG ;
  1. N B
  1. D NP Q:LRABORT
  1. S LRBUG(LRPAR)=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,LRPAR,0)
  1. S S1=6,LRTA=LRPAR
  1. I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,S1,LRTA,1)) D ;
  1. . S B=0
  1. . 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
  1. ;
  1. Q
  1. ;
  1. ;
  1. SET ;
  1. ; File DD/999
  1. S LRSET=$P(^DD(63.35,.01,0),U,3),%=$P($P(";"_LRSET,";"_$P(Y,U)_":",2),";") W:%]"" %
  1. Q
  1. ;
  1. ;
  1. LIST1 ;
  1. N C
  1. D NP Q:LRABORT
  1. W !," Comment: "
  1. S C=0
  1. 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
  1. Q
  1. ;
  1. ;
  1. VIR ;
  1. ; from LRMIPSZ1
  1. ; also called from RPT^LROR4
  1. N LRBLDTMP,LRQUIT
  1. S (LRQUIT,LRBLDTMP)=0
  1. I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT)) D ;
  1. . S LRBLDTMP=1
  1. . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)
  1. . K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,32)
  1. ;
  1. I $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,16),U)="",'$G(LRLABKY) D S:'$D(LRWRDVEW) LRQUIT=1 S:LRSB'=16 LRQUIT=1
  1. . Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,16))
  1. . ;LR*5.2*547: Display informational message if accession/test is currently being edited
  1. . ; and results had previously been verified.
  1. . N LR7SB S LR7SB=16
  1. . D MES^LRMIPSZ2
  1. ;
  1. I LRQUIT D Q
  1. . I LRBLDTMP K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)
  1. ;
  1. S LRTUS=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,16),U,2)
  1. S DZ=$P(^(16),U,3),Y=$P(^(16),U)
  1. D D^LRU
  1. I LRHC W ! D NP Q:LRABORT
  1. W !,"* VIROLOGY ",$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => ",Y," TECH CODE: ",DZ
  1. D NP Q:LRABORT
  1. S LRPRE=20
  1. D PRE^LRMIPSU
  1. S LRPAR=0
  1. F S LRPAR=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,LRPAR)) Q:LRPAR<1 D Q:LRABORT ;
  1. . I LRHC W !
  1. . D NP Q:LRABORT
  1. . W !,"Virus: ",$P(^LAB(61.2,$P(^(LRPAR,0),U),0),U)
  1. . S LRBUG(LRPAR)=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,LRPAR,0)
  1. ;
  1. I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18)) D ;
  1. . W:LRHC !
  1. . D NP Q:LRABORT
  1. . W !,"Virology Remark(s):"
  1. . D NP Q:LRABORT
  1. . S LRPAR=0
  1. . F S LRPAR=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18,LRPAR)) Q:LRPAR<1 W !,?3,^(LRPAR,0) D NP Q:LRABORT ;
  1. ;
  1. I LRBLDTMP D ;
  1. . K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)
  1. Q
  1. ;
  1. ;
  1. NP ;
  1. ; Convenience method
  1. D NP^LRMIPSZ1
  1. Q