- 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
