INHE1 ;JSH; 22 Oct 1999 15:25 ;Interface Error reporting/processing
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
LIST ;List errors
N %DT,INSD,INED,DIC,DA,DR,IOP,INT,INLOC,%,INBRIEF
S %DT("A")="Start DATE: ",%DT="ATE" D ^%DT Q:Y<0 S INSD=+Y
S %DT("A")="Ending DATE: ",%DT="ATE",%DT("B")="TODAY" D ^%DT Q:Y<0 S INED=+Y S:INED\1=INED INED=INED+.9999
S DIC("A")="Select LOCATION OF ERROR to print: ",DIC="^INTHERL(",DIC(0)="QAEM" D ^DIC Q:Y<0 S INLOC=+Y,INLOC(1)=$P(Y,U,2) S:INLOC(1)="ALL" INLOC=0
W ! S INBRIEF=$$YN^UTSRD("Do you want to see the transaction messages? ;0","") Q:INBRIEF="0^0" S INBRIEF='INBRIEF
K IOP S %ZIS="NMQ" D ^%ZIS Q:POP
I IO'=IO(0) D Q
. S ZTRTN="ZTSK^INHE1",ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
. F I="INLOC*","INSD","INED","INBRIEF" S ZTSAVE(I)=""
. D ^%ZTLOAD I $D(ZTSK) W !,"Request Queued." K ZTSK
. D ^%ZISC
S IOP=ION_";"_IOST_";"_IOM_";"_IOSL D ^%ZIS,ZTSK,^%ZISC
Q
;
ZTSK ;Entry point to print
;INSD = FileMan format start date/time
;INED = FileMan format end date/time
;INLOC= location of error to print (internal #, 0 = ALL)
;INLOC(1) = name of error location
W:$E(IOST)="C" @IOF
N INPAGE,INLINE,INDT,DTOUT,DUOUT,DIOUT,INI,INJ,INK,INROU,D0,I,J
S INROU=^DIPT($O(^DIPT("B","INH ERROR DISPLAY",0)),"ROU"),INDT=$$DATEFMT^UTDT("NOW","DD MMM YYYY@HH:II"),(INPAGE,INK)=0
S $P(INLINE,$S($D(DWA("HL")):DWA("HL"),1:"-"),IOM+1)=""
D HEAD
S ^UTILITY($J,1)=$S($E(IOST)="C":"D TOP^INHE1",1:"W @IOF D HEAD^INHE1"),I(0)="^INTHER(",J(0)=4003
S INI=INSD-.0000001,%=0 F S INI=$O(^INTHER("B",INI)) Q:'INI!(INI>INED)!$G(DIOUT)!$G(DTOUT) S INJ=0 D
. F S INJ=$O(^INTHER("B",INI,INJ)) Q:'INJ S D0=INJ D:$D(^INTHER(INJ,0)) Q:$G(DIOUT)!$G(DTOUT)
.. K DXS
.. I 'INLOC D @INROU S INK=1 Q
.. I INLOC<9 D:$P(^INTHER(INJ,0),U,5)=INLOC @INROU S INK=1 Q
.. I +$P(^INTHER(INJ,0),U,10)=(INLOC-9) D @INROU S INK=1 Q
W:'INK !!," No entries found."
W:$E(IOST)'="C" @IOF K DIOUT
K ^UTILITY($J,1)
Q
;
TOP ;End of a page
Q:$G(DIOUT) N X
W *7 D ^UTSRD("",1) I $E(X)=U S DIOUT=1 Q
W @IOF D HEAD
Q
;
HEAD ;Header
Q:$G(DIOUT) S INPAGE=INPAGE+1 W !,?(IOM\2-11),"Interface Error Report",!?(IOM\2-9),INDT
W !,"Error Location: "_INLOC(1),?(IOM-10),"Page: "_INPAGE
W !,"DATE/TIME",?36,"RESOLUTION",!,"OF ERROR",?22,"MESSAGE ID",?36,"STATUS",?48,"DESTINATION"
W !,INLINE Q
INHE1 ;JSH; 22 Oct 1999 15:25 ;Interface Error reporting/processing
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
LIST ;List errors
+1 NEW %DT,INSD,INED,DIC,DA,DR,IOP,INT,INLOC,%,INBRIEF
+2 SET %DT("A")="Start DATE: "
SET %DT="ATE"
DO ^%DT
IF Y<0
QUIT
SET INSD=+Y
+3 SET %DT("A")="Ending DATE: "
SET %DT="ATE"
SET %DT("B")="TODAY"
DO ^%DT
IF Y<0
QUIT
SET INED=+Y
IF INED\1=INED
SET INED=INED+.9999
+4 SET DIC("A")="Select LOCATION OF ERROR to print: "
SET DIC="^INTHERL("
SET DIC(0)="QAEM"
DO ^DIC
IF Y<0
QUIT
SET INLOC=+Y
SET INLOC(1)=$PIECE(Y,U,2)
IF INLOC(1)="ALL"
SET INLOC=0
+5 WRITE !
SET INBRIEF=$$YN^UTSRD("Do you want to see the transaction messages? ;0","")
IF INBRIEF="0^0"
QUIT
SET INBRIEF='INBRIEF
+6 KILL IOP
SET %ZIS="NMQ"
DO ^%ZIS
IF POP
QUIT
+7 IF IO'=IO(0)
Begin DoDot:1
+8 SET ZTRTN="ZTSK^INHE1"
SET ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
+9 FOR I="INLOC*","INSD","INED","INBRIEF"
SET ZTSAVE(I)=""
+10 DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !,"Request Queued."
KILL ZTSK
+11 DO ^%ZISC
End DoDot:1
QUIT
+12 SET IOP=ION_";"_IOST_";"_IOM_";"_IOSL
DO ^%ZIS
DO ZTSK
DO ^%ZISC
+13 QUIT
+14 ;
ZTSK ;Entry point to print
+1 ;INSD = FileMan format start date/time
+2 ;INED = FileMan format end date/time
+3 ;INLOC= location of error to print (internal #, 0 = ALL)
+4 ;INLOC(1) = name of error location
+5 IF $EXTRACT(IOST)="C"
WRITE @IOF
+6 NEW INPAGE,INLINE,INDT,DTOUT,DUOUT,DIOUT,INI,INJ,INK,INROU,D0,I,J
+7 SET INROU=^DIPT($ORDER(^DIPT("B","INH ERROR DISPLAY",0)),"ROU")
SET INDT=$$DATEFMT^UTDT("NOW","DD MMM YYYY@HH:II")
SET (INPAGE,INK)=0
+8 SET $PIECE(INLINE,$SELECT($DATA(DWA("HL")):DWA("HL"),1:"-"),IOM+1)=""
+9 DO HEAD
+10 SET ^UTILITY($JOB,1)=$SELECT($EXTRACT(IOST)="C":"D TOP^INHE1",1:"W @IOF D HEAD^INHE1")
SET I(0)="^INTHER("
SET J(0)=4003
+11 SET INI=INSD-.0000001
SET %=0
FOR
SET INI=$ORDER(^INTHER("B",INI))
IF 'INI!(INI>INED)!$GET(DIOUT)!$GET(DTOUT)
QUIT
SET INJ=0
Begin DoDot:1
+12 FOR
SET INJ=$ORDER(^INTHER("B",INI,INJ))
IF 'INJ
QUIT
SET D0=INJ
IF $DATA(^INTHER(INJ,0))
Begin DoDot:2
+13 KILL DXS
+14 IF 'INLOC
DO @INROU
SET INK=1
QUIT
+15 IF INLOC<9
IF $PIECE(^INTHER(INJ,0),U,5)=INLOC
DO @INROU
SET INK=1
QUIT
+16 IF +$PIECE(^INTHER(INJ,0),U,10)=(INLOC-9)
DO @INROU
SET INK=1
QUIT
End DoDot:2
IF $GET(DIOUT)!$GET(DTOUT)
QUIT
End DoDot:1
+17 IF 'INK
WRITE !!," No entries found."
+18 IF $EXTRACT(IOST)'="C"
WRITE @IOF
KILL DIOUT
+19 KILL ^UTILITY($JOB,1)
+20 QUIT
+21 ;
TOP ;End of a page
+1 IF $GET(DIOUT)
QUIT
NEW X
+2 WRITE *7
DO ^UTSRD("",1)
IF $EXTRACT(X)=U
SET DIOUT=1
QUIT
+3 WRITE @IOF
DO HEAD
+4 QUIT
+5 ;
HEAD ;Header
+1 IF $GET(DIOUT)
QUIT
SET INPAGE=INPAGE+1
WRITE !,?(IOM\2-11),"Interface Error Report",!?(IOM\2-9),INDT
+2 WRITE !,"Error Location: "_INLOC(1),?(IOM-10),"Page: "_INPAGE
+3 WRITE !,"DATE/TIME",?36,"RESOLUTION",!,"OF ERROR",?22,"MESSAGE ID",?36,"STATUS",?48,"DESTINATION"
+4 WRITE !,INLINE
QUIT
