- INHE ;JSH; 27 Feb 96 16:05;Interface Error handler part 1
- ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- ;COPYRIGHT 1991-2000 SAIC
- ;
- ENO(TT,UIF,DEST,ERROR) ;Log an Output Controller error in the Interface Error File (IEF)
- D LOAD(TT,"",UIF,"O","",DEST,"",.ERROR)
- Q
- ;
- ENF(TT,DA,DUZ,ARRAY,ERROR) ;Log a Formatter error in the IEF
- D LOAD(TT,DA,"","F",DUZ,"",.ARRAY,.ERROR)
- Q
- ;
- END(UIF,ERROR,DEST) ;Log a deformatter error in the IEF
- D LOAD("","",UIF,"D","",$G(DEST),"",.ERROR)
- Q
- ;
- ENT(UIF,DEST,ERROR,BPN) ;Log an Transceiver error in the IEF
- I $G(BPN)'="" D:$D(ERROR)
- .N PROC S PROC="<"_$P($G(^INTHPC(BPN,0)),U)_"> "
- .I $D(ERROR)<10 S:$L(PROC_ERROR)<256 ERROR=PROC_ERROR Q
- .S:$L(PROC_$G(ERROR(1)))<256 ERROR(1)=PROC_$G(ERROR(1))
- D LOAD("","",UIF,"T","",DEST,"",.ERROR,$G(BPN))
- Q
- ;
- ENI(TT,DEST,ERROR) ;Log an Input Driver error in the IEF
- D LOAD(TT,"","","I","",DEST,"",.ERROR)
- Q
- ;
- ENR(BPN,ERROR) ;Log a receiver error in the IEF
- D:$D(ERROR)
- .N PROC S PROC="<"_$P($G(^INTHPC(BPN,0)),U)_"> "
- .I $D(ERROR)<10 S:$L(PROC_ERROR)<256 ERROR=PROC_ERROR Q
- .S:$L(PROC_$G(ERROR(1)))<256 ERROR(1)=PROC_$G(ERROR(1))
- D LOAD("","","","R","","","",.ERROR,BPN)
- Q
- ;
- ENK(UIF,ERROR) ;Log a negative acknowledgement
- D LOAD("","",UIF,"K","","","",.ERROR)
- Q
- ;
- LOAD(TT,INDA,UIF,LOC,DUZ,DEST,ARRAY,ERROR,BPN,ENUM) ;Load an error entry
- ;TT = Transaction type (file #4000)
- ;INDA = DA of from file
- ;UIF = entry # in UIF (file #4001)
- ;LOC = location of error
- ;DUZ = originating user
- ;DEST = Destination entry # (file #4005)
- ;ARRAY = Programmer's array
- ;ERROR = Array of error strings - if only ERROR exists and no
- ; descendents, then that will be used as ERROR(1)
- ;BPN = Entry number in Background Process Control file (#4004)
- ;ENUM = IEN of INTERFACE ERROR entry created (PBR to retrieve)
- ;
- N DIK,X,Y,I,%,DIC,DLAYGO S X=+$G(DUZ) N DUZ S DUZ=X,DUZ(0)="@" K DO
- S U="^",X="""NOW""",DIC=4003,DIC(0)="L",DLAYGO=4003 D ^DIC Q:Y<0
- S:$G(LOC)]"" LOC=$O(^INTHERL("C",LOC,""))
- S $P(^INTHER(+Y,0),U,2,10)=$G(TT)_U_$G(INDA)_U_$G(UIF)_U_$G(LOC)_U_U_U_$G(DUZ)_U_$G(DEST)_U_0_U_$G(BPN)
- I $D(ERROR)=1,ERROR]"" S ERROR(1)=ERROR
- S (%,I)=0 F S I=$O(ERROR(I)) Q:'I S %=%+1,^INTHER(+Y,2,%,0)=ERROR(I)
- S:% ^INTHER(+Y,2,0)=U_U_%_U_%
- ;FIX THIS WHOLE THING - DO SOME KIND OF %XY^%RCR TO ACCOUNT FOR LOWER LEVEL SUBSCRIPTS IN ARRAY - USE $Q
- S (%,I)=0 I $D(ARRAY)>9 F S I=$O(ARRAY(I)) Q:I="" S %=%+1,^INTHER(+Y,1,%,0)=I,%=%+1,^INTHER(+Y,1,%,0)=$G(ARRAY(I))
- S:% ^INTHER(+Y,1,0)=U_U_%_U_%
- N DA S DIK="^INTHER(",(DA,ENUM)=+Y D IX1^DIK
- Q
- INHE ;JSH; 27 Feb 96 16:05;Interface Error handler part 1
- +1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- +2 ;COPYRIGHT 1991-2000 SAIC
- +3 ;
- ENO(TT,UIF,DEST,ERROR) ;Log an Output Controller error in the Interface Error File (IEF)
- +1 DO LOAD(TT,"",UIF,"O","",DEST,"",.ERROR)
- +2 QUIT
- +3 ;
- ENF(TT,DA,DUZ,ARRAY,ERROR) ;Log a Formatter error in the IEF
- +1 DO LOAD(TT,DA,"","F",DUZ,"",.ARRAY,.ERROR)
- +2 QUIT
- +3 ;
- END(UIF,ERROR,DEST) ;Log a deformatter error in the IEF
- +1 DO LOAD("","",UIF,"D","",$GET(DEST),"",.ERROR)
- +2 QUIT
- +3 ;
- ENT(UIF,DEST,ERROR,BPN) ;Log an Transceiver error in the IEF
- +1 IF $GET(BPN)'=""
- IF $DATA(ERROR)
- Begin DoDot:1
- +2 NEW PROC
- SET PROC="<"_$PIECE($GET(^INTHPC(BPN,0)),U)_"> "
- +3 IF $DATA(ERROR)<10
- IF $LENGTH(PROC_ERROR)<256
- SET ERROR=PROC_ERROR
- QUIT
- +4 IF $LENGTH(PROC_$GET(ERROR(1)))<256
- SET ERROR(1)=PROC_$GET(ERROR(1))
- End DoDot:1
- +5 DO LOAD("","",UIF,"T","",DEST,"",.ERROR,$GET(BPN))
- +6 QUIT
- +7 ;
- ENI(TT,DEST,ERROR) ;Log an Input Driver error in the IEF
- +1 DO LOAD(TT,"","","I","",DEST,"",.ERROR)
- +2 QUIT
- +3 ;
- ENR(BPN,ERROR) ;Log a receiver error in the IEF
- +1 IF $DATA(ERROR)
- Begin DoDot:1
- +2 NEW PROC
- SET PROC="<"_$PIECE($GET(^INTHPC(BPN,0)),U)_"> "
- +3 IF $DATA(ERROR)<10
- IF $LENGTH(PROC_ERROR)<256
- SET ERROR=PROC_ERROR
- QUIT
- +4 IF $LENGTH(PROC_$GET(ERROR(1)))<256
- SET ERROR(1)=PROC_$GET(ERROR(1))
- End DoDot:1
- +5 DO LOAD("","","","R","","","",.ERROR,BPN)
- +6 QUIT
- +7 ;
- ENK(UIF,ERROR) ;Log a negative acknowledgement
- +1 DO LOAD("","",UIF,"K","","","",.ERROR)
- +2 QUIT
- +3 ;
- LOAD(TT,INDA,UIF,LOC,DUZ,DEST,ARRAY,ERROR,BPN,ENUM) ;Load an error entry
- +1 ;TT = Transaction type (file #4000)
- +2 ;INDA = DA of from file
- +3 ;UIF = entry # in UIF (file #4001)
- +4 ;LOC = location of error
- +5 ;DUZ = originating user
- +6 ;DEST = Destination entry # (file #4005)
- +7 ;ARRAY = Programmer's array
- +8 ;ERROR = Array of error strings - if only ERROR exists and no
- +9 ; descendents, then that will be used as ERROR(1)
- +10 ;BPN = Entry number in Background Process Control file (#4004)
- +11 ;ENUM = IEN of INTERFACE ERROR entry created (PBR to retrieve)
- +12 ;
- +13 NEW DIK,X,Y,I,%,DIC,DLAYGO
- SET X=+$GET(DUZ)
- NEW DUZ
- SET DUZ=X
- SET DUZ(0)="@"
- KILL DO
- +14 SET U="^"
- SET X="""NOW"""
- SET DIC=4003
- SET DIC(0)="L"
- SET DLAYGO=4003
- DO ^DIC
- IF Y<0
- QUIT
- +15 IF $GET(LOC)]""
- SET LOC=$ORDER(^INTHERL("C",LOC,""))
- +16 SET $PIECE(^INTHER(+Y,0),U,2,10)=$GET(TT)_U_$GET(INDA)_U_$GET(UIF)_U_$GET(LOC)_U_U_U_$GET(DUZ)_U_$GET(DEST)_U_0_U_$GET(BPN)
- +17 IF $DATA(ERROR)=1
- IF ERROR]""
- SET ERROR(1)=ERROR
- +18 SET (%,I)=0
- FOR
- SET I=$ORDER(ERROR(I))
- IF 'I
- QUIT
- SET %=%+1
- SET ^INTHER(+Y,2,%,0)=ERROR(I)
- +19 IF %
- SET ^INTHER(+Y,2,0)=U_U_%_U_%
- +20 ;FIX THIS WHOLE THING - DO SOME KIND OF %XY^%RCR TO ACCOUNT FOR LOWER LEVEL SUBSCRIPTS IN ARRAY - USE $Q
- +21 SET (%,I)=0
- IF $DATA(ARRAY)>9
- FOR
- SET I=$ORDER(ARRAY(I))
- IF I=""
- QUIT
- SET %=%+1
- SET ^INTHER(+Y,1,%,0)=I
- SET %=%+1
- SET ^INTHER(+Y,1,%,0)=$GET(ARRAY(I))
- +22 IF %
- SET ^INTHER(+Y,1,0)=U_U_%_U_%
- +23 NEW DA
- SET DIK="^INTHER("
- SET (DA,ENUM)=+Y
- DO IX1^DIK
- +24 QUIT
