BLRLA7QR ; IHS/MSC/MKK - LA7 MESSAGE QUEUE Reports ; 22-Oct-2013 09:22 ; MKK
;;5.2;LAB SERVICE;**1033**;Nov 1, 1997
;
EEP ; Ersatz EP
D EEP^BLRGMENU
Q
;
EP ; EP
PEP ; EP
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
D SETBLRVS
;
D ADDTMENU^BLRGMENU("INCOMING^BLRLA7QR","Incoming Messages ...")
D ADDTMENU^BLRGMENU("OUTGOING^BLRLA7QR","Outgoing Messages ...")
;
; Main Menu driver
D MENUDRVR^BLRGMENU("LA7 Message Queue (#62.49) File","Reports")
Q
;
SETBLRVS(TWO) ; EP - Set the BLRVERN variable(s)
S BLRVERN=$TR($P($T(+1),";")," ")
S:$D(TWO) BLRVERN2=TWO
Q
;
INCOMING ; EP
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
D SETBLRVS
;
D ADDTMENU^BLRGMENU("INCOMALL^BLRLA7QR","All Transactions")
D ADDTMENU^BLRGMENU("INCSPINA^BLRLA7QR","Specific Instrument Transactions")
;
; Main Menu driver
D MENUDRVR^BLRGMENU("LA7 Message Queue (#62.49) File","Incoming Reports")
Q
;
INCOMALL ; EP - All Incoming Transactions
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
Q:$$ALLINIT("Incoming Messages")="Q"
;
D ATXNLOOP(INDEXDT,"I")
;
D PRESSKEY^BLRGMENU(9)
Q
;
INCSPINA ; EP - Incoming Transactions for a Specific Instrument
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
Q:$$GETINST(.INSTRIEN,.INSTRNM)<1
;
Q:$$SPININIT("Incoming Messages",INSTRNM)="Q"
;
D STXNLOOP(INDEXDT,"I",INSTRNM)
;
D PRESSKEY^BLRGMENU(9)
Q
;
STXNLOOP(INDEXDT,TYPE,INSTR) ; EP - Speicific Instrument messages loop
F S INDEXDT=$O(^LAHM(62.49,"AD",INDEXDT),-1) Q:INDEXDT<1!(QFLG="Q") D
. S TXN="A"
. F S TXN=$O(^LAHM(62.49,"AD",INDEXDT,TXN),-1) Q:TXN<1!(QFLG="Q") D
.. S STR=$G(^LAHM(62.49,TXN,0))
.. S LOOPINST=$P($P(STR,"^",6),"-")
.. Q:$P(STR,"^",2)'=TYPE ; Skip if not wanted message type
.. Q:LOOPINST'=INSTRNM
.. ;
.. D LINEALL
Q
;
OUTGOING ; EP
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
D SETBLRVS
;
D ADDTMENU^BLRGMENU("OUTALL^BLRLA7QR","All Transactions")
D ADDTMENU^BLRGMENU("OUTSPINA^BLRLA7QR","Specific Instrument Transactions")
;
; Main Menu driver
D MENUDRVR^BLRGMENU("LA7 Message Queue (#62.49) File","Outgoing Reports")
Q
;
OUTALL ; EP - All Outgoing Transactions
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
Q:$$ALLINIT("Outgoing Messages")="Q"
;
D ATXNLOOP(INDEXDT,"O")
;
D PRESSKEY^BLRGMENU(9)
Q
;
OUTSPINA ; EP - Outgoing Transactions for a Specific Instrument
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
Q:$$GETINST(.INSTRIEN,.INSTRNM)<1
;
Q:$$SPININIT("Outgoing Messages",INSTRNM)="Q"
;
D STXNLOOP(INDEXDT,"O",INSTRNM)
;
D PRESSKEY^BLRGMENU(9)
Q
;
ALLINIT(TWO) ; EP - Initialization
D SETBLRVS
;
S HEADER(1)="LA7 MESSAGE QUEUE (#62.49) FILE"
S HEADER(2)=TWO
;
D HEADERDT^BLRGMENU
D HEADONE^BLRGMENU(.HDRONE)
;
S HEADER(3)=" "
S HEADER(4)="Txn"
S $E(HEADER(4),10)="Instrument"
S $E(HEADER(4),25)="Entry Dt"
S $E(HEADER(4),35)="STS"
S $E(HEADER(4),40)="Name"
S $E(HEADER(4),65)="UID"
;
S INDEXDT=$$HTFM^XLFDT(+$H+1)
S QFLG="NO"
S MAXLINES=20,LINES=MAXLINES+10
S (CNT,PG)=0
Q "OK"
;
ATXNLOOP(INDEXDT,TYPE) ; EP - ALL messages loop
F S INDEXDT=$O(^LAHM(62.49,"AD",INDEXDT),-1) Q:INDEXDT<1!(QFLG="Q") D
. S TXN="A"
. F S TXN=$O(^LAHM(62.49,"AD",INDEXDT,TXN),-1) Q:TXN<1!(QFLG="Q") D
.. S STR=$G(^LAHM(62.49,TXN,0))
.. Q:$P(STR,"^",2)'=TYPE ; Skip if not wanted message type
.. ;
.. D LINEALL
Q
;
LINEALL ; EP - Line of Data
I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HDRONE) Q:QFLG="Q"
;
D BRKOALL
;
W TXN
W ?9,INSTR
W ?24,$$FMTE^XLFDT(ENTRYDT,"2DZ")
W ?35,STATUS
W ?39,NAME
W ?64,UID
W !
S LINES=LINES+1
S CNT=CNT+1
Q
;
BRKOALL ; EP - Beakout Data
S INSTR=$P($P(STR,"^",6),"-",1),ENTRYDT=$P(STR,"^",5),STATUS=$P(STR,"^",3)
S (NAME,UID)=""
;
S SEG=0
F S SEG=$O(^LAHM(62.49,TXN,150,SEG)) Q:SEG<1!($L(NAME)) D
. S STR=$G(^LAHM(62.49,TXN,150,SEG,0))
. Q:$P(STR,"|")'="PID" ; Skip if not the PID segment
. S NAMESTR=$P(STR,"|",6)
. S NAME=$TR($P(NAMESTR,"^",1,2),"^",",")_" "_$TR($P(NAMESTR,"^",3,4),"^"," ")
. S NAME=$$TRIM^XLFSTR(NAME,"LR"," ") ; Trim leading & trailing blanks
;
S SEG=0
F S SEG=$O(^LAHM(62.49,TXN,150,SEG)) Q:SEG<1!($L(UID)) D
. S STR=$G(^LAHM(62.49,TXN,150,SEG,0))
. Q:$P(STR,"|")'="OBR" ; Skip if not the OBR segment
. S UID=$P($P(STR,"|",3),"^")
Q
;
GETINST(INSTRIEN,INSTRNM) ; EP - Get the Instrument
NEW HEADER
;
S HEADER(1)="Select Auto Instrument"
S HEADER(2)=" "
;
S INSTRIEN=""
F Q:$L(INSTRIEN) D
. D HEADERDT^BLRGMENU
. D ^XBFMK
. S DIR(0)="PO^62.4:E"
. S DIR("A")="Select Instrument"
. D ^DIR
. I +$G(DIRUT) S INSTRIEN=$$BADINPUT("No/Invalid Entry.") Q
. ;
. S INSTRIEN=+$G(Y),INSTRNM=$P(Y,"^",2)
;
Q $S(INSTRIEN="Q":0,1:1)
;
SPININIT(TWO,INITINST) ; EP - Initialization
D SETBLRVS
;
S HEADER(1)="LA7 MESSAGE QUEUE (#62.49) FILE"
S HEADER(2)=TWO
;
D HEADERDT^BLRGMENU
D HEADONE^BLRGMENU(.HDRONE)
;
S HEADER(3)=$$CJ^XLFSTR("Instrument: "_INITINST,IOM)
S HEADER(4)=" "
S HEADER(5)="Txn"
S $E(HEADER(5),10)="Instrument"
S $E(HEADER(5),25)="Entry Dt"
S $E(HEADER(5),35)="STS"
S $E(HEADER(5),40)="Name"
S $E(HEADER(5),65)="UID"
;
S INDEXDT=$$HTFM^XLFDT(+$H+1)
S QFLG="NO"
S MAXLINES=20,LINES=MAXLINES+10
S (CNT,PG)=0
Q "OK"
;
BADINPUT(MSG) ; EP - Bad Input
W !!,?4,MSG
D PRESSKEY^BLRGMENU(9)
Q "Q"
BLRLA7QR ; IHS/MSC/MKK - LA7 MESSAGE QUEUE Reports ; 22-Oct-2013 09:22 ; MKK
+1 ;;5.2;LAB SERVICE;**1033**;Nov 1, 1997
+2 ;
EEP ; Ersatz EP
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
EP ; EP
PEP ; EP
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 DO SETBLRVS
+4 ;
+5 DO ADDTMENU^BLRGMENU("INCOMING^BLRLA7QR","Incoming Messages ...")
+6 DO ADDTMENU^BLRGMENU("OUTGOING^BLRLA7QR","Outgoing Messages ...")
+7 ;
+8 ; Main Menu driver
+9 DO MENUDRVR^BLRGMENU("LA7 Message Queue (#62.49) File","Reports")
+10 QUIT
+11 ;
SETBLRVS(TWO) ; EP - Set the BLRVERN variable(s)
+1 SET BLRVERN=$TRANSLATE($PIECE($TEXT(+1),";")," ")
+2 IF $DATA(TWO)
SET BLRVERN2=TWO
+3 QUIT
+4 ;
INCOMING ; EP
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 DO SETBLRVS
+4 ;
+5 DO ADDTMENU^BLRGMENU("INCOMALL^BLRLA7QR","All Transactions")
+6 DO ADDTMENU^BLRGMENU("INCSPINA^BLRLA7QR","Specific Instrument Transactions")
+7 ;
+8 ; Main Menu driver
+9 DO MENUDRVR^BLRGMENU("LA7 Message Queue (#62.49) File","Incoming Reports")
+10 QUIT
+11 ;
INCOMALL ; EP - All Incoming Transactions
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 IF $$ALLINIT("Incoming Messages")="Q"
QUIT
+4 ;
+5 DO ATXNLOOP(INDEXDT,"I")
+6 ;
+7 DO PRESSKEY^BLRGMENU(9)
+8 QUIT
+9 ;
INCSPINA ; EP - Incoming Transactions for a Specific Instrument
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 IF $$GETINST(.INSTRIEN,.INSTRNM)<1
QUIT
+4 ;
+5 IF $$SPININIT("Incoming Messages",INSTRNM)="Q"
QUIT
+6 ;
+7 DO STXNLOOP(INDEXDT,"I",INSTRNM)
+8 ;
+9 DO PRESSKEY^BLRGMENU(9)
+10 QUIT
+11 ;
STXNLOOP(INDEXDT,TYPE,INSTR) ; EP - Speicific Instrument messages loop
+1 FOR
SET INDEXDT=$ORDER(^LAHM(62.49,"AD",INDEXDT),-1)
IF INDEXDT<1!(QFLG="Q")
QUIT
Begin DoDot:1
+2 SET TXN="A"
+3 FOR
SET TXN=$ORDER(^LAHM(62.49,"AD",INDEXDT,TXN),-1)
IF TXN<1!(QFLG="Q")
QUIT
Begin DoDot:2
+4 SET STR=$GET(^LAHM(62.49,TXN,0))
+5 SET LOOPINST=$PIECE($PIECE(STR,"^",6),"-")
+6 ; Skip if not wanted message type
IF $PIECE(STR,"^",2)'=TYPE
QUIT
+7 IF LOOPINST'=INSTRNM
QUIT
+8 ;
+9 DO LINEALL
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
OUTGOING ; EP
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 DO SETBLRVS
+4 ;
+5 DO ADDTMENU^BLRGMENU("OUTALL^BLRLA7QR","All Transactions")
+6 DO ADDTMENU^BLRGMENU("OUTSPINA^BLRLA7QR","Specific Instrument Transactions")
+7 ;
+8 ; Main Menu driver
+9 DO MENUDRVR^BLRGMENU("LA7 Message Queue (#62.49) File","Outgoing Reports")
+10 QUIT
+11 ;
OUTALL ; EP - All Outgoing Transactions
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 IF $$ALLINIT("Outgoing Messages")="Q"
QUIT
+4 ;
+5 DO ATXNLOOP(INDEXDT,"O")
+6 ;
+7 DO PRESSKEY^BLRGMENU(9)
+8 QUIT
+9 ;
OUTSPINA ; EP - Outgoing Transactions for a Specific Instrument
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 IF $$GETINST(.INSTRIEN,.INSTRNM)<1
QUIT
+4 ;
+5 IF $$SPININIT("Outgoing Messages",INSTRNM)="Q"
QUIT
+6 ;
+7 DO STXNLOOP(INDEXDT,"O",INSTRNM)
+8 ;
+9 DO PRESSKEY^BLRGMENU(9)
+10 QUIT
+11 ;
ALLINIT(TWO) ; EP - Initialization
+1 DO SETBLRVS
+2 ;
+3 SET HEADER(1)="LA7 MESSAGE QUEUE (#62.49) FILE"
+4 SET HEADER(2)=TWO
+5 ;
+6 DO HEADERDT^BLRGMENU
+7 DO HEADONE^BLRGMENU(.HDRONE)
+8 ;
+9 SET HEADER(3)=" "
+10 SET HEADER(4)="Txn"
+11 SET $EXTRACT(HEADER(4),10)="Instrument"
+12 SET $EXTRACT(HEADER(4),25)="Entry Dt"
+13 SET $EXTRACT(HEADER(4),35)="STS"
+14 SET $EXTRACT(HEADER(4),40)="Name"
+15 SET $EXTRACT(HEADER(4),65)="UID"
+16 ;
+17 SET INDEXDT=$$HTFM^XLFDT(+$HOROLOG+1)
+18 SET QFLG="NO"
+19 SET MAXLINES=20
SET LINES=MAXLINES+10
+20 SET (CNT,PG)=0
+21 QUIT "OK"
+22 ;
ATXNLOOP(INDEXDT,TYPE) ; EP - ALL messages loop
+1 FOR
SET INDEXDT=$ORDER(^LAHM(62.49,"AD",INDEXDT),-1)
IF INDEXDT<1!(QFLG="Q")
QUIT
Begin DoDot:1
+2 SET TXN="A"
+3 FOR
SET TXN=$ORDER(^LAHM(62.49,"AD",INDEXDT,TXN),-1)
IF TXN<1!(QFLG="Q")
QUIT
Begin DoDot:2
+4 SET STR=$GET(^LAHM(62.49,TXN,0))
+5 ; Skip if not wanted message type
IF $PIECE(STR,"^",2)'=TYPE
QUIT
+6 ;
+7 DO LINEALL
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
LINEALL ; EP - Line of Data
+1 IF LINES>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,HDRONE)
IF QFLG="Q"
QUIT
+2 ;
+3 DO BRKOALL
+4 ;
+5 WRITE TXN
+6 WRITE ?9,INSTR
+7 WRITE ?24,$$FMTE^XLFDT(ENTRYDT,"2DZ")
+8 WRITE ?35,STATUS
+9 WRITE ?39,NAME
+10 WRITE ?64,UID
+11 WRITE !
+12 SET LINES=LINES+1
+13 SET CNT=CNT+1
+14 QUIT
+15 ;
BRKOALL ; EP - Beakout Data
+1 SET INSTR=$PIECE($PIECE(STR,"^",6),"-",1)
SET ENTRYDT=$PIECE(STR,"^",5)
SET STATUS=$PIECE(STR,"^",3)
+2 SET (NAME,UID)=""
+3 ;
+4 SET SEG=0
+5 FOR
SET SEG=$ORDER(^LAHM(62.49,TXN,150,SEG))
IF SEG<1!($LENGTH(NAME))
QUIT
Begin DoDot:1
+6 SET STR=$GET(^LAHM(62.49,TXN,150,SEG,0))
+7 ; Skip if not the PID segment
IF $PIECE(STR,"|")'="PID"
QUIT
+8 SET NAMESTR=$PIECE(STR,"|",6)
+9 SET NAME=$TRANSLATE($PIECE(NAMESTR,"^",1,2),"^",",")_" "_$TRANSLATE($PIECE(NAMESTR,"^",3,4),"^"," ")
+10 ; Trim leading & trailing blanks
SET NAME=$$TRIM^XLFSTR(NAME,"LR"," ")
End DoDot:1
+11 ;
+12 SET SEG=0
+13 FOR
SET SEG=$ORDER(^LAHM(62.49,TXN,150,SEG))
IF SEG<1!($LENGTH(UID))
QUIT
Begin DoDot:1
+14 SET STR=$GET(^LAHM(62.49,TXN,150,SEG,0))
+15 ; Skip if not the OBR segment
IF $PIECE(STR,"|")'="OBR"
QUIT
+16 SET UID=$PIECE($PIECE(STR,"|",3),"^")
End DoDot:1
+17 QUIT
+18 ;
GETINST(INSTRIEN,INSTRNM) ; EP - Get the Instrument
+1 NEW HEADER
+2 ;
+3 SET HEADER(1)="Select Auto Instrument"
+4 SET HEADER(2)=" "
+5 ;
+6 SET INSTRIEN=""
+7 FOR
IF $LENGTH(INSTRIEN)
QUIT
Begin DoDot:1
+8 DO HEADERDT^BLRGMENU
+9 DO ^XBFMK
+10 SET DIR(0)="PO^62.4:E"
+11 SET DIR("A")="Select Instrument"
+12 DO ^DIR
+13 IF +$GET(DIRUT)
SET INSTRIEN=$$BADINPUT("No/Invalid Entry.")
QUIT
+14 ;
+15 SET INSTRIEN=+$GET(Y)
SET INSTRNM=$PIECE(Y,"^",2)
End DoDot:1
+16 ;
+17 QUIT $SELECT(INSTRIEN="Q":0,1:1)
+18 ;
SPININIT(TWO,INITINST) ; EP - Initialization
+1 DO SETBLRVS
+2 ;
+3 SET HEADER(1)="LA7 MESSAGE QUEUE (#62.49) FILE"
+4 SET HEADER(2)=TWO
+5 ;
+6 DO HEADERDT^BLRGMENU
+7 DO HEADONE^BLRGMENU(.HDRONE)
+8 ;
+9 SET HEADER(3)=$$CJ^XLFSTR("Instrument: "_INITINST,IOM)
+10 SET HEADER(4)=" "
+11 SET HEADER(5)="Txn"
+12 SET $EXTRACT(HEADER(5),10)="Instrument"
+13 SET $EXTRACT(HEADER(5),25)="Entry Dt"
+14 SET $EXTRACT(HEADER(5),35)="STS"
+15 SET $EXTRACT(HEADER(5),40)="Name"
+16 SET $EXTRACT(HEADER(5),65)="UID"
+17 ;
+18 SET INDEXDT=$$HTFM^XLFDT(+$HOROLOG+1)
+19 SET QFLG="NO"
+20 SET MAXLINES=20
SET LINES=MAXLINES+10
+21 SET (CNT,PG)=0
+22 QUIT "OK"
+23 ;
BADINPUT(MSG) ; EP - Bad Input
+1 WRITE !!,?4,MSG
+2 DO PRESSKEY^BLRGMENU(9)
+3 QUIT "Q"
