BLRLA7QR.m

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"