IBDF18E2 ;ALB/AAS - AICS Error Logging Routine ;27-JAN-97
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
LOGERR(ERRNO,FORMID,DATANO,VALUE,PI,QLFR,TYPEDTA,TXT) ;
; -- log aics scanning processing error
N TEXT,IBDERR
S TEXT(1)=$$NOW^XLFDT
S TEXT(2)=$P($G(^IBD(357.96,+$G(FORMID),0)),"^",2) I 'TEXT(2) S TEXT(2)=$G(DFN) ; -- dfn
S TEXT(3)=$G(FORMID("APPT")) ; -- encounter date/time
S TEXT(4)=$P($G(^IBD(357.96,+$G(FORMID),0)),"^",4) ; -- pointer to 357.95
S TEXT(5)=$G(FORMID) S:+TEXT(5) TEXT(5)=+TEXT(5) ; -- pointer to 357.96
S:$G(DATANO)'="" TEXT(6)=$G(DATANO) ; -- number of bubble or hand print field (ie BUBBLE(1)
S:$G(VALUE)'="" TEXT(7)=$G(VALUE) ; -- value of bubble or hand print field
S TEXT(8)=$G(FORMID("SOURCE"))
S TEXT(9)=$P($G(^IBD(357.95,+$P($G(^IBD(357.96,+$G(FORMID),0)),"^",4),0)),"^",21) ; -- form name
S:$G(PI)'="" TEXT(10)=$G(PI) ; -- package interface
S:$G(QLFR)'="" TEXT(11)=$G(QLFR) ; -- name of qualifier
S:$G(TXT)'="" TEXT(12)=$G(TXT) ; -- Text appearing on the form
S TEXT(13)=$G(DUZ) ; -- user
S:$G(TYPEDTA)'="" TEXT(14)=$P($G(^IBE(359.1,+TYPEDTA,0)),"^")
S:$G(XQY0)'="" TEXT(15)=$P(XQY0,"^") ; -- option name
S TEXT(16)=$G(ERRNO) ; -- entry in dialog file
S:$G(FORMID("PAGE")) TEXT(17)=$G(FORMID("PAGE"))
;
; -- Build Error Message from Dialog file
D BLD^DIALOG(ERRNO,.TEXT,.IBDOUT,"IBDERR","S")
;D ERRMSG(ERRNO,.TEXT)
;
; -- file error in aics error log file
D ERRFIL(ERRNO,.TEXT,.IBDERR)
Q:ERRNO=3570001!(ERRNO=3570004)
;
; -- set error in pxca(aics error) array to pass back to workstation
S CNT=$G(PXCA("AICS ERROR"))+1
S PXCA("AICS ERROR")=CNT
S PXCA("AICS ERROR",1,1,1,CNT)=$P($G(IBDERR(1)),": ",2,99)
Q
;
ERRMSG(ERRNO,TEXT) ;
; -- Build Error Message from Dialog file
D BLD^DIALOG(ERRNO,.TEXT,.IBDOUT,"IBDERR","S")
Q
;
ERRFIL(ERRNO,TEXT,IBDERR) ;
; -- file error in aics error log file
N FDAROOT,FDAIEN
;
Q:$G(TEXT(1))=""
S FDAROOT(359.3,"+1,",.01)=$G(TEXT(1))
S:$G(TEXT(2))'="" FDAROOT(359.3,"+1,",.02)=$G(TEXT(2))
S:$G(TEXT(3))'="" FDAROOT(359.3,"+1,",.03)=$G(TEXT(3))
S:$G(TEXT(4))'="" FDAROOT(359.3,"+1,",.04)=$G(TEXT(4))
S:$G(TEXT(5))'="" FDAROOT(359.3,"+1,",.05)=$G(TEXT(5))
S:$G(TEXT(6))'="" FDAROOT(359.3,"+1,",.06)=$G(TEXT(6))
S:$G(TEXT(7))'="" FDAROOT(359.3,"+1,",.07)=$G(TEXT(7))
S:$G(TEXT(8))'="" FDAROOT(359.3,"+1,",.08)=$G(TEXT(8))
S:$G(TEXT(9))'="" FDAROOT(359.3,"+1,",.09)=$G(TEXT(9))
S:$G(TEXT(10))'="" FDAROOT(359.3,"+1,",.1)=$G(TEXT(10))
S:$G(TEXT(11))'="" FDAROOT(359.3,"+1,",.11)=$G(TEXT(11))
S:$G(TEXT(12))'="" FDAROOT(359.3,"+1,",.12)=$G(TEXT(12))
S:$G(TEXT(13))'="" FDAROOT(359.3,"+1,",.13)=$G(TEXT(13))
S:$G(TEXT(16))'="" FDAROOT(359.3,"+1,",.16)=$G(TEXT(16))
S:$G(TEXT(15))'="" FDAROOT(359.3,"+1,",1.01)=$G(TEXT(15))
;
S CNT=2
I ERRNO=3570001 D EW^IBDFBK2(.IBDERR,.PXCA,.CNT,1)
;
D UPDATE^DIE("","FDAROOT","FDAIEN")
D WP^DIE(359.3,FDAIEN(1)_",",10,"KA","IBDERR")
Q
;
PRT ; -- print error listing
I '$D(IOF) D HOME^%ZIS
W @IOF,?10,"Print List of Scanning Errors and Warnings",!!!
;
S DIC="^IBD(359.3,",L=0,FR="?,?,?,?",TO="?,?,?,?"
S BY="[IBD LIST ERRORS]"
S FLDS="[IBD LIST ERRORS]"
;
;S DISUPNO=1 ; -- print No records found if not set, don't uncomment this line
S DIPCRIT=1 ; -- print sort criteria on first page.
S DIS(0)="I '$P($G(^IBD(359.3,D0,1)),U,2)"
D EN1^DIP
PRTQ K DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,DUOUT,DIRUT
Q
IBDF18E2 ;ALB/AAS - AICS Error Logging Routine ;27-JAN-97
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
LOGERR(ERRNO,FORMID,DATANO,VALUE,PI,QLFR,TYPEDTA,TXT) ;
+1 ; -- log aics scanning processing error
+2 NEW TEXT,IBDERR
+3 SET TEXT(1)=$$NOW^XLFDT
+4 ; -- dfn
SET TEXT(2)=$PIECE($GET(^IBD(357.96,+$GET(FORMID),0)),"^",2)
IF 'TEXT(2)
SET TEXT(2)=$GET(DFN)
+5 ; -- encounter date/time
SET TEXT(3)=$GET(FORMID("APPT"))
+6 ; -- pointer to 357.95
SET TEXT(4)=$PIECE($GET(^IBD(357.96,+$GET(FORMID),0)),"^",4)
+7 ; -- pointer to 357.96
SET TEXT(5)=$GET(FORMID)
IF +TEXT(5)
SET TEXT(5)=+TEXT(5)
+8 ; -- number of bubble or hand print field (ie BUBBLE(1)
IF $GET(DATANO)'=""
SET TEXT(6)=$GET(DATANO)
+9 ; -- value of bubble or hand print field
IF $GET(VALUE)'=""
SET TEXT(7)=$GET(VALUE)
+10 SET TEXT(8)=$GET(FORMID("SOURCE"))
+11 ; -- form name
SET TEXT(9)=$PIECE($GET(^IBD(357.95,+$PIECE($GET(^IBD(357.96,+$GET(FORMID),0)),"^",4),0)),"^",21)
+12 ; -- package interface
IF $GET(PI)'=""
SET TEXT(10)=$GET(PI)
+13 ; -- name of qualifier
IF $GET(QLFR)'=""
SET TEXT(11)=$GET(QLFR)
+14 ; -- Text appearing on the form
IF $GET(TXT)'=""
SET TEXT(12)=$GET(TXT)
+15 ; -- user
SET TEXT(13)=$GET(DUZ)
+16 IF $GET(TYPEDTA)'=""
SET TEXT(14)=$PIECE($GET(^IBE(359.1,+TYPEDTA,0)),"^")
+17 ; -- option name
IF $GET(XQY0)'=""
SET TEXT(15)=$PIECE(XQY0,"^")
+18 ; -- entry in dialog file
SET TEXT(16)=$GET(ERRNO)
+19 IF $GET(FORMID("PAGE"))
SET TEXT(17)=$GET(FORMID("PAGE"))
+20 ;
+21 ; -- Build Error Message from Dialog file
+22 DO BLD^DIALOG(ERRNO,.TEXT,.IBDOUT,"IBDERR","S")
+23 ;D ERRMSG(ERRNO,.TEXT)
+24 ;
+25 ; -- file error in aics error log file
+26 DO ERRFIL(ERRNO,.TEXT,.IBDERR)
+27 IF ERRNO=3570001!(ERRNO=3570004)
QUIT
+28 ;
+29 ; -- set error in pxca(aics error) array to pass back to workstation
+30 SET CNT=$GET(PXCA("AICS ERROR"))+1
+31 SET PXCA("AICS ERROR")=CNT
+32 SET PXCA("AICS ERROR",1,1,1,CNT)=$PIECE($GET(IBDERR(1)),": ",2,99)
+33 QUIT
+34 ;
ERRMSG(ERRNO,TEXT) ;
+1 ; -- Build Error Message from Dialog file
+2 DO BLD^DIALOG(ERRNO,.TEXT,.IBDOUT,"IBDERR","S")
+3 QUIT
+4 ;
ERRFIL(ERRNO,TEXT,IBDERR) ;
+1 ; -- file error in aics error log file
+2 NEW FDAROOT,FDAIEN
+3 ;
+4 IF $GET(TEXT(1))=""
QUIT
+5 SET FDAROOT(359.3,"+1,",.01)=$GET(TEXT(1))
+6 IF $GET(TEXT(2))'=""
SET FDAROOT(359.3,"+1,",.02)=$GET(TEXT(2))
+7 IF $GET(TEXT(3))'=""
SET FDAROOT(359.3,"+1,",.03)=$GET(TEXT(3))
+8 IF $GET(TEXT(4))'=""
SET FDAROOT(359.3,"+1,",.04)=$GET(TEXT(4))
+9 IF $GET(TEXT(5))'=""
SET FDAROOT(359.3,"+1,",.05)=$GET(TEXT(5))
+10 IF $GET(TEXT(6))'=""
SET FDAROOT(359.3,"+1,",.06)=$GET(TEXT(6))
+11 IF $GET(TEXT(7))'=""
SET FDAROOT(359.3,"+1,",.07)=$GET(TEXT(7))
+12 IF $GET(TEXT(8))'=""
SET FDAROOT(359.3,"+1,",.08)=$GET(TEXT(8))
+13 IF $GET(TEXT(9))'=""
SET FDAROOT(359.3,"+1,",.09)=$GET(TEXT(9))
+14 IF $GET(TEXT(10))'=""
SET FDAROOT(359.3,"+1,",.1)=$GET(TEXT(10))
+15 IF $GET(TEXT(11))'=""
SET FDAROOT(359.3,"+1,",.11)=$GET(TEXT(11))
+16 IF $GET(TEXT(12))'=""
SET FDAROOT(359.3,"+1,",.12)=$GET(TEXT(12))
+17 IF $GET(TEXT(13))'=""
SET FDAROOT(359.3,"+1,",.13)=$GET(TEXT(13))
+18 IF $GET(TEXT(16))'=""
SET FDAROOT(359.3,"+1,",.16)=$GET(TEXT(16))
+19 IF $GET(TEXT(15))'=""
SET FDAROOT(359.3,"+1,",1.01)=$GET(TEXT(15))
+20 ;
+21 SET CNT=2
+22 IF ERRNO=3570001
DO EW^IBDFBK2(.IBDERR,.PXCA,.CNT,1)
+23 ;
+24 DO UPDATE^DIE("","FDAROOT","FDAIEN")
+25 DO WP^DIE(359.3,FDAIEN(1)_",",10,"KA","IBDERR")
+26 QUIT
+27 ;
PRT ; -- print error listing
+1 IF '$DATA(IOF)
DO HOME^%ZIS
+2 WRITE @IOF,?10,"Print List of Scanning Errors and Warnings",!!!
+3 ;
+4 SET DIC="^IBD(359.3,"
SET L=0
SET FR="?,?,?,?"
SET TO="?,?,?,?"
+5 SET BY="[IBD LIST ERRORS]"
+6 SET FLDS="[IBD LIST ERRORS]"
+7 ;
+8 ;S DISUPNO=1 ; -- print No records found if not set, don't uncomment this line
+9 ; -- print sort criteria on first page.
SET DIPCRIT=1
+10 SET DIS(0)="I '$P($G(^IBD(359.3,D0,1)),U,2)"
+11 DO EN1^DIP
PRTQ KILL DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,DUOUT,DIRUT
+1 QUIT
