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

LRMIPSZ1.m

Go to the documentation of this file. 
  1. LRMIPSZ1 ;DALOI/STAFF - MICRO PATIENT REPORT ;Aug 14, 2019@10:00
  1.  ;;5.2;LAB SERVICE;**283,350,520,536**;Sep 27, 1994;Build 18
  1.  ;
  1.  ;
  1. DQ ;tasked from LRTASK from IMMEDIATE INTERIM REPORTING thru LRTP
  1.  ;
  1.  S LRPATLOC=$G(LRLLOC),LRIDT=$G(LRIDT,0),LRSS="MI",LRONETST="",LRONESPC="",LREND=0
  1.  D EN^LRPARAM
  1.  S LRLLT=^LR(LRDFN,"MI",LRIDT,0),LRACC=$P(LRLLT,U,6),LRAD=$E(LRLLT)_$P(LRACC," ",2)_"0000"
  1.  S X=$P(LRACC," "),DIC=68,DIC(0)="M"
  1.  I X'="" D ^DIC S LRAA=+Y,LRAN=+$P(LRACC," ",3)
  1.  ;
  1.  ; ^TMP("LRMI",$J,LRDFN,"MI",LRIDT) will already exist if this is a LEDI result being processed (rtn LRVRMI1)
  1.  I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT)) D
  1.  . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)
  1.  . K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,32)
  1.  ;
  1.  S LRCMNT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,99))
  1.  S LRPG=0
  1.  D EN
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  Q
  1.  ;
  1.  ;
  1. EN ;
  1.  ; from LRMINEW2, LRMIPC, LRMIPLOG, LRMIPSZ, LRMIVER1
  1.  ; ^TMP("LRMI",$J,LRDFN,"MI",LRIDT) will already exist if this is a LEDI result being processed (rtn LRVRMI1)
  1.  I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT)) D  ;
  1.  . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)
  1.  . K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,32)
  1.  ;
  1.  S LRUID=$P($G(^LR(LRDFN,"MI",LRIDT,"ORU")),U)
  1.  I '$D(LRONESPC) S LRONESPC="",DIC="^LAB(61,",DIC("A")="Select SPECIMEN/SOURCE: ANY//",DIC(0)="AEMOQ" D ^DIC S:Y>0 LRONESPC=+Y K DIC("A")
  1.  I '$D(LRONETST) S LRONETST="",DIC="^LAB(60,",DIC(0)="AEOQ",DIC("S")="I $P(^(0),U,4)=""MI"")"_$S('$D(LRLABKY):",""BO""[$P(^(0),U,3)",1:""),D="E" D IX^DIC Q:Y<1  I Y>0 S LRONETST=+Y
  1.  S LRSPEC=$P(LRLLT,U,5) I LRONESPC'="",LRSPEC'=LRONESPC Q
  1.  D RPT
  1.  I '$G(EAMODE) K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)
  1.  K %,A8,A,AB,B,B1,B2,B3,C,IA,LR1PASS,LR2ORMOR,LRABCNT,LRACNT,LRADM,LRADX,LRAFS,LRAMT,LRAX,LRBN,LRBRR,LRBUG,LRCOMTAB,LRCS,LRDCOM,LRDOC,LRDRTM1,LRDRTM2,LREF,LRFLIP,LRFMT,LRGRM,LRHC,LRIFN,LRINT,LRPATLOC,LRMYC,LRNS,LRNUM
  1.  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
  1.  Q
  1.  ;
  1.  ;
  1. RPT ;
  1.  ;
  1.  N LRABORT,LRPGDATA,LRPRNTED,LRDISP
  1.  ;
  1.  ; If called by another process, i.e. interim reports, then don't reset current page number
  1.  S LRPG=$G(LRPG,0)
  1.  ;
  1.  S LRPGDATA("HDR")="D HDR2^LRMIPSU(.LRPRNTED,.LRABORT,.LRPGDATA)"
  1.  S LRPGDATA("BM")=8
  1.  S LRPGDATA("FTR")="D FOOT2^LRMIPSU"
  1.  ; Dont print the footer when console device
  1.  I $E($G(IOST),1,2)="C-" D  ;
  1.  . S LRPGDATA("BM")=0
  1.  . S LRPGDATA("FTR")=""
  1.  S LRPGDATA("PROMPTX")="S X=$$PROMPT^LRMIPSU()"
  1.  S LRPGDATA("ERASE")=1
  1.  S LRPGDATA("PGNUM")=0
  1.  S LRABORT=0
  1.  ;
  1.  S:'$D(LRSB) LRSB=0
  1.  S LRPRINT=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,4)):"",1:1),LRHC=$S($E(IOST,1,2)'="C-":1,1:0),LRFLIP=$S(LRHC:11,1:6)
  1.  ;
  1.  K DIC
  1.  D DT^LRX
  1.  S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
  1.  D PT^LRX
  1.  S:$G(VAIN(3)) DOB=$P(VADM(3),U) S LRPATLOC=$P(LRLLT,U,8)
  1.  S (LRADM,LRADX)=""
  1.  I +$G(LRDPF)=2,'$G(VAERR) S LRADM=$P(VAIN(7),U,2),LRADX=VAIN(9)
  1.  S LRCS=$S($D(^LAB(62,+$P(LRLLT,U,11),0)):$P(^(0),U),1:"")
  1.  S LRTK=$P(LRLLT,U),LRRC=$P(LRLLT,U,10),LRST=$S(LRSPEC:$P(^LAB(61,LRSPEC,0),U),1:"")
  1.  S Y=LRTK D D^LRU S LRTK=Y
  1.  S Y=LRRC D D^LRU S LRRC=Y
  1.  S X=$P(LRLLT,U,7) D DOC^LRX
  1.  ;
  1.  K ^TMP("LR",$J,"T"),LRTSTS
  1.  ;
  1.  S (LRBRR,LRTESTCOMPLE)=0
  1.  F  S LRBRR=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR)) Q:LRBRR<1  D EN1
  1.  I 'LRPRINT,LRONETST Q
  1.  ;
  1.  ;
  1.  D HDR2^LRMIPSU(.LRPRNTED,.LRABORT,.LRPGDATA)
  1.  S LREND=LRABORT
  1.  Q:LRABORT
  1.  ; display audit log
  1.  D BANNER^LRMIAU2(.LRABORT,.LRPGDATA)
  1.  S LREND=LRABORT
  1.  Q:LRABORT
  1.  ;
  1.  I $D(^TMP("LR",$J,"T")) D  Q:LRABORT
  1.  . N J,LRX,LRY,X,Y
  1.  . W !?2,"Test(s) ordered:"
  1.  . S J=0
  1.  . F  S J=$O(^TMP("LR",$J,"T",J)) Q:J=""  D  Q:LRABORT
  1.  . . S X=^TMP("LR",$J,"T",J)
  1.  . . S LRX=$P(X,"^")
  1.  . . I LRTESTCOMPLE S LRX=$$LJ^XLFSTR(LRX,30,".")
  1.  . . W ?19,LRX
  1.  . . I '$P(X,U,2) W ! D NP Q
  1.  . . S Y=$P(X,U,2)
  1.  . . ; LR*5.2*520 and LR*5.2*536
  1.  . . S LRDISP=$P(X,U,3)
  1.  . . D D^LRU S LRY=$S(LRDISP["Not Performed":"canceled: ",1:"completed: ")_Y
  1.  . . I (19+$L(LRX)+$L(LRY))>IOM W !
  1.  . . W ?50,LRY,! D NP
  1.  ;
  1.  K ^TMP("LR",$J,"T"),LRTSTS W:LRHC !
  1.  I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,14)) D  Q:LRABORT  ;
  1.  . D NP Q:LRABORT
  1.  . D ANTI^LRMIPSZ2
  1.  . D NP Q:LRABORT
  1.  ;
  1.  I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,1)) D  Q:LRABORT  ;
  1.  . D NP Q:LRABORT
  1.  . D BACT^LRMIPSZ2 Q:LREND
  1.  . D NP Q:LRABORT
  1.  . D REFS^LRMIPSU Q:LREND
  1.  . D NP Q:LRABORT
  1.  ;
  1.  I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,31)) D  Q:LRABORT  ;
  1.  . D NP Q:LRABORT
  1.  . D STER^LRMIPSZ3
  1.  . D NP Q:LRABORT
  1.  ;
  1.  I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,5)) D  Q:LRABORT  Q:LREND  ;
  1.  . D NP Q:LRABORT
  1.  . D PARA^LRMIPSZ3
  1.  . D NP Q:LRABORT
  1.  . D REFS^LRMIPSU
  1.  . Q:LREND
  1.  . D NP Q:LRABORT
  1.  ;
  1.  I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,16)) D  Q:LREND  Q:LRABORT  ;
  1.  . D NP Q:LRABORT
  1.  . D VIR^LRMIPSZ3
  1.  . D REFS^LRMIPSU Q:LREND  Q:LRABORT  ;
  1.  ;
  1.  I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11)) D  Q:LREND  Q:LRABORT  ;
  1.  . D NP Q:LRABORT
  1.  . D TB^LRMIPSZ4
  1.  . D NP Q:LRABORT
  1.  . D REFS^LRMIPSU
  1.  . D NP Q:LRABORT
  1.  ;
  1.  I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,8)) D  Q:LREND  Q:LRABORT  ;
  1.  . D NP Q:LRABORT
  1.  . D FUNG^LRMIPSZ4
  1.  . D NP Q:LRABORT
  1.  . D REFS^LRMIPSU
  1.  . Q:LREND  Q:LRABORT
  1.  ;
  1.  Q:LRABORT
  1.  ;
  1.  ; Print any performing labs listing
  1.  I $G(LRMODE)'="LDSI" D PPL
  1.  ;
  1.  ; Write last footer if needed
  1.  I 'LRABORT,'$G(LRPGDATA("WFTR")) D  ;
  1.  . I $G(LRPGDATA("FTR"))="" Q
  1.  . I $E($G(IOST),1,2)'="C-" D  ;
  1.  . . N I,BM
  1.  . . S BM=$G(LRPGDATA("BM"))
  1.  . . F I=$Y+1:1:($G(IOSL,60)-BM-1) W !
  1.  . X LRPGDATA("FTR")
  1.  ;
  1.  I 'LRABORT D  ;
  1.  . N PAD,STR,I,II
  1.  . S X="  End of Report  ",PAD="+ ",STR=""
  1.  . S I=IOM-($L(X)*3),I=I/4/$L(PAD)
  1.  . F II=1:1:3 S STR=STR_$$REPEAT^XLFSTR(PAD,I)_X
  1.  . S STR=STR_$$REPEAT^XLFSTR(PAD,I)
  1.  . W !,$$CJ^XLFSTR(STR,IOM)
  1.  . F I=$Y+1:1:($G(IOSL,60)-$G(LRPGDATA("BM"))-1) W !
  1.  . S (LRABORT,LREND)=$$MORE^LRUTIL($$PROMPT^LRMIPSU(),0)
  1.  . ; LRMLTRPT indicates multi report (set in SENDUP^LRMIPLOG)
  1.  . I $G(LRMLTRPT),$E($G(IOST),1,2)="P-",$G(IOF)'="" W @IOF
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. EN1 ;
  1.  ; LR*5.2*520 Set disposition to LRDISP
  1.  S LRTS=+^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR,0),LRTS(1)=$P(^(0),U,5),LRDISP=$P(^(0),U,6)
  1.  Q:'$L($P($G(^LAB(60,LRTS,0)),U,3))
  1.  I '$D(LRLABKY),"BO"'[$P($G(^LAB(60,LRTS,0)),U,3) Q
  1.  ;
  1.  ; Set flag that at least one test is completed
  1.  I LRTS(1) S LRTESTCOMPLE=1
  1.  ;
  1.  S:LRTS=LRONETST LRPRINT=1
  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
  1.  Q
  1.  ;
  1.  ;
  1. NP ;
  1.  ; Convenience method
  1.  ; Some methods in these report routines may be called by a different parent so need to handle this if needed.
  1.  I '$D(LRABORT) S LRABORT=0
  1.  Q:'$D(LRPGDATA)
  1.  D NP^LRUTIL(.LRABORT,.LRPGDATA)
  1.  S LRPG=$G(LRPGDATA("PGNUM"),1)
  1.  ;
  1.  ; backward compatability (for SENDUP^LRMIPLOG)
  1.  S LREND=LRABORT
  1.  Q
  1.  ;
  1.  ;
  1. PPL ; Print any performing laboratories
  1.  ;
  1.  N LRPL,LRI,LRX,LRY
  1.  ;
  1.  D RETLST^LRRPL(.LRPL,LRDFN,"MI",LRIDT,0)
  1.  I $G(LRPL)<1 Q
  1.  ;
  1.  ; Start new page if space on existing page too small to display a significant portion of labs
  1.  S LRY=IOSL-$Y S:LRY<1 LRY=1
  1.  I (LRPL/LRY)>1 D
  1.  . F LRI=$Y+1:1:($G(IOSL,60)-$G(LRPGDATA("BM"))-1) W !
  1.  . D NP
  1.  E  S LRX="=--" W !!,$$REPEAT^XLFSTR(LRX,IOM/$L(LRX))
  1.  ;
  1.  W !,"Performing Laboratory:",!
  1.  S LRI=0
  1.  F  S LRI=$O(LRPL(LRI)) Q:'LRI  D  Q:LRABORT
  1.  . W !,LRPL(LRI)
  1.  . D NP
  1.  . I 'LRABORT,LRPGDATA("NP") W !,"Performing Laboratory (cont'd):",!
  1.  ;
  1.  I 'LRABORT W !
  1.  ;
  1.  Q