INHVA8.m

INHVA8 ;FRW ; 11 Feb 93 12:33; Identify missing interface transactions

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;COPYRIGHT 1991-2000 SAIC

EN ;Main entry point

 ;NEW statements

 N %ZIS,A,COUNT,DATA,EXIT,HDR,LOOP,PAGE,X,ZTDESC,ZTIO,ZTRTN,ZTSAVE

 S U="^"

ENUSE ;User input

 ;ask for prefix

 S INPRE=$$SOC^UTIL("Select message prefix: ","","SAIC^DHCP",0)

 ;goto QUIT if user aborts

 G:INPRE[U!('$L(INPRE)) QUIT

 ;Device handling & Tasking logic

 K IOP S %ZIS("A")="QUEUE ON DEVICE: ",%ZIS("B")="",%ZIS="NQ" D ^%ZIS G:POP QUIT

 S IOP=ION_";"_IOST_";"_IOM_";"_IOSL

 I IO=IO(0) S %ZIS="" D ^%ZIS I POP W *7,!,"Sorry, unable to find device..." G QUIT

 I IO'=IO(0) S ZTDESC="Identify missing interface transactions",ZTIO=IOP,ZTRTN="ENQUE^INHVA8" D  G QUIT

 .F X="U","IO*","D*","INPRE" S ZTSAVE(X)=""

 .D ^%ZTLOAD

 ;

ENQUE ;Taskman entry point

 ;initialize variables

 S PAGE=0,EXIT=0

 D HSET,HEADER

 ;call modules

 S CUR=0,LAST=CUR,MES=INPRE_CUR,COUNT=0,INPREL=$L(INPRE)

 F CMES=1:1 S LAST=CUR,MES=$O(^INTHU("C",MES)) Q:$E(MES,1,INPREL)'=INPRE!(EXIT)  S CUR=$E(MES,INPREL+1,999) I (LAST+1)'=CUR S DATA="LAST,?12,CUR" D WRITE S COUNT=COUNT+1

 ;

 S DATA="!!,""Total Gaps => "",COUNT,!,""Total Messages => "",CMES"

 G QUIT

 ;

HEADER ;output header in local array HDR(x)

 N A

 I ($P(IOST,"-")["C")&('$D(IO("Q")))&(IO=IO(0))&(PAGE>0) R !,"Press <RETURN> to continue ",A:DTIME I A[U S EXIT=1 Q

 S PAGE=PAGE+1 W @IOF

 S A=0 F  S A=$O(HDR(A)) Q:'A  U IO W !,@HDR(A)

 Q

 ;

WRITE ;output a line

 I ($Y>(IOSL-3))&(PAGE>0) D HEADER

 Q:EXIT  W !,@DATA Q

 ;

HSET ;set up header

 K HDR

 D NOW^%DTC S Y=% D DD^%DT S HDR(1)="?(IOM-30),"""_$P(Y,":",1,2)_""",?(IOM-10),""PAGE: "",PAGE"

 S HDR(3)="""Missing Interface Transaction with the prefix: "",INPRE"

 S HDR(3.5)="""Before Gap  After Gap"""

 S HDR(4)="",$P(HDR(4),"-",IOM-1)="",HDR(4)=""""_HDR(4)_""",!"

 Q

 ;

QUIT ;exit module

 D ^%ZISC

 S IOP="",%ZIS="" D ^%ZIS U IO K IO("Q"),IOP,POP

 Q

INHVA8    ;FRW ; 11 Feb 93 12:33; Identify missing interface transactions

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;COPYRIGHT 1991-2000 SAIC

EN        ;Main entry point

 +1       ;NEW statements

 +2        NEW %ZIS,A,COUNT,DATA,EXIT,HDR,LOOP,PAGE,X,ZTDESC,ZTIO,ZTRTN,ZTSAVE

 +3        SET U="^"

ENUSE     ;User input

 +1       ;ask for prefix

 +2        SET INPRE=$$SOC^UTIL("Select message prefix: ","","SAIC^DHCP",0)

 +3       ;goto QUIT if user aborts

 +4        IF INPRE[U!('$LENGTH(INPRE))

               GOTO QUIT

 +5       ;Device handling & Tasking logic

 +6        KILL IOP

           SET %ZIS("A")="QUEUE ON DEVICE: "

           SET %ZIS("B")=""

           SET %ZIS="NQ"

           DO ^%ZIS

           IF POP

               GOTO QUIT

 +7        SET IOP=ION_";"_IOST_";"_IOM_";"_IOSL

 +8        IF IO=IO(0)

               SET %ZIS=""

               DO ^%ZIS

               IF POP

                   WRITE *7,!,"Sorry, unable to find device..."

                   GOTO QUIT

 +9        IF IO'=IO(0)

               SET ZTDESC="Identify missing interface transactions"

               SET ZTIO=IOP

               SET ZTRTN="ENQUE^INHVA8"

               Begin DoDot:1

 +10               FOR X="U","IO*","D*","INPRE"

                       SET ZTSAVE(X)=""

 +11               DO ^%ZTLOAD

               End DoDot:1

               GOTO QUIT

 +12      ;

ENQUE     ;Taskman entry point

 +1       ;initialize variables

 +2        SET PAGE=0

           SET EXIT=0

 +3        DO HSET

           DO HEADER

 +4       ;call modules

 +5        SET CUR=0

           SET LAST=CUR

           SET MES=INPRE_CUR

           SET COUNT=0

           SET INPREL=$LENGTH(INPRE)

 +6        FOR CMES=1:1

               SET LAST=CUR

               SET MES=$ORDER(^INTHU("C",MES))

               IF $EXTRACT(MES,1,INPREL)'=INPRE!(EXIT)

                   QUIT 

               SET CUR=$EXTRACT(MES,INPREL+1,999)

               IF (LAST+1)'=CUR

                   SET DATA="LAST,?12,CUR"

                   DO WRITE

                   SET COUNT=COUNT+1

 +7       ;

 +8        SET DATA="!!,""Total Gaps => "",COUNT,!,""Total Messages => "",CMES"

 +9        GOTO QUIT

 +10      ;

HEADER    ;output header in local array HDR(x)

 +1        NEW A

 +2        IF ($PIECE(IOST,"-")["C")&('$DATA(IO("Q")))&(IO=IO(0))&(PAGE>0)

               READ !,"Press <RETURN> to continue ",A:DTIME

               IF A[U

                   SET EXIT=1

                   QUIT 

 +3        SET PAGE=PAGE+1

           WRITE @IOF

 +4        SET A=0

           FOR 

               SET A=$ORDER(HDR(A))

               IF 'A

                   QUIT 

               USE IO

               WRITE !,@HDR(A)

 +5        QUIT 

 +6       ;

WRITE     ;output a line

 +1        IF ($Y>(IOSL-3))&(PAGE>0)

               DO HEADER

 +2        IF EXIT

               QUIT 

           WRITE !,@DATA

           QUIT 

 +3       ;

HSET      ;set up header

 +1        KILL HDR

 +2        DO NOW^%DTC

           SET Y=%

           DO DD^%DT

           SET HDR(1)="?(IOM-30),"""_$PIECE(Y,":",1,2)_""",?(IOM-10),""PAGE: "",PAGE"

 +3        SET HDR(3)="""Missing Interface Transaction with the prefix: "",INPRE"

 +4        SET HDR(3.5)="""Before Gap  After Gap"""

 +5        SET HDR(4)=""

           SET $PIECE(HDR(4),"-",IOM-1)=""

           SET HDR(4)=""""_HDR(4)_""",!"

 +6        QUIT 

 +7       ;

QUIT      ;exit module

 +1        DO ^%ZISC

 +2        SET IOP=""

           SET %ZIS=""

           DO ^%ZIS

           USE IO

           KILL IO("Q"),IOP,POP

 +3        QUIT