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

BLR6249R.m

Go to the documentation of this file. 
  1. BLR6249R ; IHS/MSC/MKK - LA7 MESSAGE QUEUE incoming messages only Report ;   [ February 29, 2012  8:00 AM ]
  1.  ;;5.2;LAB SERVICE;**1031**;Nov 1, 1997
  1.   ;
  1. EEP ; Ersatz EP
  1.  D EEP^BLRGMENU
  1.  Q
  1.  ;
  1. EP ; EP
  1. PEP ; EP
  1.  NEW CNT,IEN,IEN2,IEN3,STR
  1.  NEW BLRVERN,HD1,HEADER,LINES,MAXLINES,PG,QFLG
  1.  NEW INSTR,LRAA,LRAD,LRAN,LRAS,ENTRYDTT,MSGNUM,STATUS,UID
  1.  NEW LRANYAA,LRLL,LRPROF,REFLABIN
  1.  ;
  1.  D INITVARS
  1.  ;
  1.  F  S IEN=$O(^LAHM(62.49,IEN))  Q:IEN<1!(QFLG="Q")  D
  1.  . Q:$P($G(^LAHM(62.49,IEN,0)),"^",2)'="I"   ; Only Incoming messages
  1.  . Q:$P($G(^LAHM(62.49,IEN,0)),"^",3)="X"    ; Only Non-Purgeable messages
  1.  . ;
  1.  . D PRNTLINE
  1.  ;
  1.  W:CNT>0 !,?4,"Number of Non-Purgeable, Incoming messages = ",CNT,!
  1.  ;
  1.  D ^%ZISC
  1.  ;
  1.  I CNT<1 D
  1.  . W $J("",20),$C(13)
  1.  . W !,?9,"No Messages in 62.49",!
  1.  ;
  1.  D PRESSKEY^BLRGMENU(4)
  1.  Q
  1.  ;
  1. INITVARS ; EP - Initialization
  1.  S BLRVERN=$$TRIM^XLFSTR($P($T(+1),";"),"R"," ")
  1.  ;
  1.  S REFLABIN=$$GET1^DIQ(9009029,DUZ(2),3001)
  1.  ;
  1.  S HEADER(1)="LA7 MESSAGE QUEUE (#62.49) File"
  1.  S HEADER(2)=REFLABIN_" Incoming Messages"
  1.  S HEADER(3)=$$CJ^XLFSTR("Non-Purgeable Statuses Only",IOM)
  1.  S HEADER(4)=" "
  1.  ;
  1.  D HEADONE(.HD1)
  1.  ;
  1.  S HEADER(5)="Msg #"
  1.  S $E(HEADER(5),9)="STS"
  1.  S $E(HEADER(5),14)="UID"
  1.  S $E(HEADER(5),26)="Accession"
  1.  S $E(HEADER(5),46)="Entry Date/Time"
  1.  S $E(HEADER(5),67)="Instrument"
  1.  ;
  1.  S IEN=.9999999,(CNT,INCNT,OUTCNT)=0
  1.  S (PG,WOT)=0
  1.  ;
  1.  S QFLG="N"
  1.  ;
  1.  D ^%ZIS
  1.  U IO
  1.  S MAXLINES=IOSL-4
  1.  S LINES=MAXLINES+10
  1.  Q
  1.  ;
  1. HEADONE(HD1) ; EP -- Asks if user wants only 1 header line
  1.  D HEADERDT^BLRGMENU
  1.  ;
  1.  D ^XBFMK
  1.  S DIR("A")="One Header Line ONLY"
  1.  S DIR("B")="NO"
  1.  S DIR(0)="YO"
  1.  D ^DIR
  1.  S HD1=$S(+$G(Y)=1:"YES",1:"NO")
  1.  D ^XBFMK
  1.  D HEADERDT^BLRGMENU
  1.  Q
  1.  ;
  1. PRNTLINE ; EP - Print a line of data
  1.  D BREAKOUT
  1.  ;
  1.  Q:INSTR'=REFLABIN                  ; Only messages for Reference Lab
  1.  ;
  1.  I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HD1)  Q:QFLG="Q"
  1.  ;
  1.  W MSGNUM
  1.  W ?9,STATUS
  1.  W ?13,UID
  1.  W ?25,LRAS
  1.  W ?45,ENTRYDTT
  1.  W ?66,$E(INSTR,1,14)
  1.  W !
  1.  S LINES=LINES+1
  1.  S CNT=CNT+1
  1.  ;
  1.  Q
  1.  ;
  1. BREAKOUT ; EP - "Break Out" variables
  1.  NEW IEN2,STR,X
  1.  ;
  1.  S STR=$G(^LAHM(62.49,IEN,0))
  1.  ;
  1.  S MSGNUM=$P(STR,"^",1)
  1.  S STATUS=$P(STR,"^",3)
  1.  S X=$$UP^XLFSTR($$FMTE^XLFDT($P(STR,"^",5),"5MPZ"))
  1.  S INSTR=$P($P(STR,"^",6),"-")
  1.  S ENTRYDTT=$P(X," ")_$$RJ^XLFSTR($P(X," ",2,3),9)
  1.  ;
  1.  S UID=0,IEN2=.9999999
  1.  F  S IEN2=$O(^LAHM(62.49,IEN,150,IEN2))  Q:IEN2<1!(UID)  D
  1.  . Q:$G(^LAHM(62.49,IEN,150,IEN2,0))'["OBR"
  1.  . ;
  1.  . S UID=$TR($$LJ^XLFSTR(+$RE(+$RE($P($G(^LAHM(62.49,IEN,150,IEN2,0)),"|",3))),10)," ","0")
  1.  ;
  1.  I UID<1 S (UID,LRAS)="" Q
  1.  ;
  1.  S LRAA=+$O(^LRO(68,"C",UID,0))
  1.  S LRAD=+$O(^LRO(68,"C",UID,LRAA,0))
  1.  S LRAN=+$O(^LRO(68,"C",UID,LRAA,LRAD,0))
  1.  ;
  1.  S LRAS=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2))
  1.  ;
  1.  Q
  1.  ;
  1. ONELRASR ; EP - Report on 1 Accession: INCOMING and OUTGOING messages
  1.  NEW BLRVERN,HD1,HEADER,LINES,MAXLINES,PG,QFLG
  1.  NEW CNT,DAYSAGO2,ENTRYDT,CNTINCOM,HEADER,INDEXDT,INSTALLN,INSTLLDT
  1.  NEW INSTR,LABPATCH,LRAS,LRODT,MAX,OBRCNT,OBRSTR,OBRTXN,STATUS,STR,TXN,TXNCNT,TYPE
  1.  ;
  1.  Q:$$ONELRASI()="Q"
  1.  ;
  1.  F  S INDEXDT=$O(^LAHM(62.49,"AD",INDEXDT))  Q:INDEXDT=""!(CNT>MAX)  D
  1.  . F  S TXN=$O(^LAHM(62.49,"AD",INDEXDT,TXN))  Q:TXN=""!(TXN'?.N)!(CNT>MAX)  D
  1.  .. D TXNVARS
  1.  .. F  S OBRTXN=$O(^LAHM(62.49,TXN,150,OBRTXN))  Q:OBRTXN<1!(CNT>MAX)!($L(OBRLRAS)>0)  D
  1.  ... D ONELRASL
  1.  ;
  1.  W:INDEXDT=""!(CNT>MAX) !!,?4,"Number of Transactions:",TXNCNT,!
  1.  W:OBRCNT>0&((INDEXDT="")!(CNT>MAX)) ?9,"Number of TXNs with OBR Segments:",OBRCNT,!!
  1.  Q
  1.  ;
  1. ONELRASI() ; EP - Initialization of variables
  1.  S BLRVERN=$$TRIM^XLFSTR($P($T(+1),";"),"R"," ")
  1.  ;
  1.  W !!
  1.  D ^LRWU4
  1.  S LRAS=$G(^LRO(68,+LRAA,1,+LRAD,1,+LRAN,.2))
  1.  ;
  1.  I $L(LRAS)<1 D  Q 0
  1.  . W !!,?4,"Accession Does not Exist..  Routine Ends."
  1.  . D PRESSKEY^BLRGMENU(9)
  1.  ;
  1.  S HEADER(1)="LA7 Message Queue (#62.49)"
  1.  S HEADER(2)="Accession "_LRAS_" Transactions"
  1.  S HEADER(3)=" "
  1.  S HEADER(4)="Txn"
  1.  S $E(HEADER(4),10)="EntryDt"
  1.  S $E(HEADER(4),20)="Instrument"
  1.  S $E(HEADER(4),35)="Type"
  1.  S $E(HEADER(4),40)="STS"
  1.  S $E(HEADER(4),45)="PID"
  1.  S $E(HEADER(4),55)="DFN"
  1.  S $E(HEADER(4),65)="LogP"
  1.  S $E(HEADER(4),75)="OrdL"
  1.  ;
  1.  S MAXLINES=IOSL-4,LINES=MAXLINES+10,(NOPG,QFLG)="N"
  1.  S INDEXDT=.9999999
  1.  S TXN=0
  1.  K INSTR,OBRLRAS
  1.  S (CNT,CNTINCOM,OBRCNT,TXN,TXNCNT)=0
  1.  S MAX=9999
  1.  Q 1
  1.  ;
  1. TXNVARS ; EP - Setup variables at TXN level
  1.  S TXNCNT=TXNCNT+1
  1.  S STR=$G(^LAHM(62.49,TXN,0))
  1.  S TYPE=$P(STR,"^",2)
  1.  S STATUS=$P(STR,"^",3)
  1.  S ENTRYDT=$P(STR,"^",5)
  1.  S INSTR=$P($P(STR,"^",6),"-",1)
  1.  S CNTINCOM=1+CNTINCOM
  1.  S PID=$P($G(^LAHM(62.49,TXN,150,2,0)),"|",4)
  1.  S OBRLRAS=""
  1.  S OBRTXN=0
  1.  Q
  1.  ;
  1. ONELRASL ; EP - Write a line of data
  1.  S OBRSTR=$G(^LAHM(62.49,TXN,150,OBRTXN,0))
  1.  Q:$P(OBRSTR,"|",1)'="OBR"
  1.  ;
  1.  S OBRCNT=1+$G(OBRCNT)
  1.  S OBRLRAS=$P($P(OBRSTR,"|",17),"^",6)
  1.  S:$L(OBRLRAS)<1 OBRLRAS=$P($P(OBRSTR,"|",20),"^",6)
  1.  Q:OBRLRAS'=LRAS
  1.  ;
  1.  D ONELRASB
  1.  ;
  1.  I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,NOPG)  Q:QFLG="Q"
  1.  ;
  1.  W TXN
  1.  W ?9,$P(ENTRYDT,".")
  1.  W ?19,$E(INSTR,1,13)
  1.  W ?35,TYPE
  1.  W ?40,$E(STATUS,1)
  1.  W ?44,PID
  1.  W ?54,DFN
  1.  W ?64,LOGINP
  1.  W ?74,ORDLOC
  1.  W !
  1.  S CNT=CNT+1
  1.  Q
  1.  ;
  1. ONELRASB ; EP - Break out variables
  1.  S STROBR=OBRSTR
  1.  S:$G(OBRLRAS)=""&($P(OBRSTR,"|",1)="OBR") OBRLRAS=$P($P(OBRSTR,"|",20),"^",6)
  1.  S X=$$GETACCCP^BLRUTIL3(OBRLRAS,.LRAA,.LRAD,.LRAN)
  1.  S STR=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
  1.  S LRDFN=$P(STR,"^")
  1.  S PROV=$P(STR,"^",8)
  1.  S LOGINP=$P(STR,"^",10)
  1.  S ORDLOC=$P(STR,"^",13)
  1.  S DFN=$P($G(^LR(LRDFN,0)),"^",3)
  1.  Q