- IBDF18E2 ;ALB/AAS - AICS Error Logging Routine ;27-JAN-97
- ;;3.0;AUTOMATED INFO COLLECTION SYS;**25,51**;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"))
- S:$G(FORMID("WSID"))'="" TEXT(18)=$G(FORMID("WSID"))
- ;
- ; -- 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:$G(TEXT(17))'="" FDAROOT(359.3,"+1,",.17)=$G(TEXT(17))
- S:$G(TEXT(18))'="" FDAROOT(359.3,"+1,",.18)=$G(TEXT(18))
- ;
- 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
- ;
- W !,?4,"** This option is OUT OF ORDER **" QUIT ;Code set Versioning
- ;
- 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
- ;
- NOAPP ; -- print no appointment listing
- I '$D(IOF) D HOME^%ZIS
- S IBDCNT=0
- W @IOF,?10,"Print List Patients with Data from Encounter Forms and No appointemnts",!!!
- ;
- S DIC="^IBD(357.96,",L=0,FR="?,?,?,T-1",TO="?,?,?,T-1"
- S BY="[IBD NO APPOINTMENT LIST]"
- S FLDS="[IBD NO APPOINTMENT LIST]"
- ;
- ;S DIPCRIT=1 ; -- print sort criteria on first page.
- S DIS(0)="I 1 S IBDCNT=IBDCNT+1"
- S IOP="HOME"
- D EN1^DIP
- NOAPPQ K DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,DUOUT,DIRUT,IBDCNT
- Q
- NOAPP1 ; -- print no appointment listing
- I '$D(IOF) D HOME^%ZIS
- S IBDCNT=0
- W @IOF,?10,"Print List Patients with Data from Encounter Forms and No appointemnts",!!!
- ;
- S DIC="^IBD(357.96,",L=0,FR="?,?,?,T-1",TO="?,?,?,T-1"
- S BY="[IBD NO APPOINTMENT1]"
- S FLDS="[IBD NO APPOINTMENT LIST]"
- ;
- ;S DIPCRIT=1 ; -- print sort criteria on first page.
- S DIS(0)="I 1 S IBDCNT=IBDCNT+1"
- S IOP="HOME"
- D EN1^DIP
- NOAPP1Q K DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,DUOUT,DIRUT,IBDCNT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF18E2 4702 printed Jan 18, 2025@03:52:09 Page 2
- IBDF18E2 ;ALB/AAS - AICS Error Logging Routine ;27-JAN-97
- +1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**25,51**;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 if $GET(FORMID("WSID"))'=""
- SET TEXT(18)=$GET(FORMID("WSID"))
- +21 ;
- +22 ; -- Build Error Message from Dialog file
- +23 DO BLD^DIALOG(ERRNO,.TEXT,.IBDOUT,"IBDERR","S")
- +24 ;D ERRMSG(ERRNO,.TEXT)
- +25 ;
- +26 ; -- file error in aics error log file
- +27 DO ERRFIL(ERRNO,.TEXT,.IBDERR)
- +28 if ERRNO=3570001!(ERRNO=3570004)
- QUIT
- +29 ;
- +30 ; -- set error in pxca(aics error) array to pass back to workstation
- +31 SET CNT=$GET(PXCA("AICS ERROR"))+1
- +32 SET PXCA("AICS ERROR")=CNT
- +33 SET PXCA("AICS ERROR",1,1,1,CNT)=$PIECE($GET(IBDERR(1)),": ",2,99)
- +34 QUIT
- +35 ;
- 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 if $GET(TEXT(17))'=""
- SET FDAROOT(359.3,"+1,",.17)=$GET(TEXT(17))
- +21 if $GET(TEXT(18))'=""
- SET FDAROOT(359.3,"+1,",.18)=$GET(TEXT(18))
- +22 ;
- +23 SET CNT=2
- +24 IF ERRNO=3570001
- DO EW^IBDFBK2(.IBDERR,.PXCA,.CNT,1)
- +25 ;
- +26 DO UPDATE^DIE("","FDAROOT","FDAIEN")
- +27 DO WP^DIE(359.3,FDAIEN(1)_",",10,"KA","IBDERR")
- +28 QUIT
- +29 ;
- PRT ; -- print error listing
- +1 ;
- +2 ;Code set Versioning
- WRITE !,?4,"** This option is OUT OF ORDER **"
- QUIT
- +3 ;
- +4 IF '$DATA(IOF)
- DO HOME^%ZIS
- +5 WRITE @IOF,?10,"Print List of Scanning Errors and Warnings",!!!
- +6 ;
- +7 SET DIC="^IBD(359.3,"
- SET L=0
- SET FR="?,?,?,?"
- SET TO="?,?,?,?"
- +8 SET BY="[IBD LIST ERRORS]"
- +9 SET FLDS="[IBD LIST ERRORS]"
- +10 ;
- +11 ;S DISUPNO=1 ; -- print No records found if not set, don't uncomment this line
- +12 ; -- print sort criteria on first page.
- SET DIPCRIT=1
- +13 SET DIS(0)="I '$P($G(^IBD(359.3,D0,1)),U,2)"
- +14 DO EN1^DIP
- PRTQ KILL DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,DUOUT,DIRUT
- +1 QUIT
- +2 ;
- NOAPP ; -- print no appointment listing
- +1 IF '$DATA(IOF)
- DO HOME^%ZIS
- +2 SET IBDCNT=0
- +3 WRITE @IOF,?10,"Print List Patients with Data from Encounter Forms and No appointemnts",!!!
- +4 ;
- +5 SET DIC="^IBD(357.96,"
- SET L=0
- SET FR="?,?,?,T-1"
- SET TO="?,?,?,T-1"
- +6 SET BY="[IBD NO APPOINTMENT LIST]"
- +7 SET FLDS="[IBD NO APPOINTMENT LIST]"
- +8 ;
- +9 ;S DIPCRIT=1 ; -- print sort criteria on first page.
- +10 SET DIS(0)="I 1 S IBDCNT=IBDCNT+1"
- +11 SET IOP="HOME"
- +12 DO EN1^DIP
- NOAPPQ KILL DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,DUOUT,DIRUT,IBDCNT
- +1 QUIT
- NOAPP1 ; -- print no appointment listing
- +1 IF '$DATA(IOF)
- DO HOME^%ZIS
- +2 SET IBDCNT=0
- +3 WRITE @IOF,?10,"Print List Patients with Data from Encounter Forms and No appointemnts",!!!
- +4 ;
- +5 SET DIC="^IBD(357.96,"
- SET L=0
- SET FR="?,?,?,T-1"
- SET TO="?,?,?,T-1"
- +6 SET BY="[IBD NO APPOINTMENT1]"
- +7 SET FLDS="[IBD NO APPOINTMENT LIST]"
- +8 ;
- +9 ;S DIPCRIT=1 ; -- print sort criteria on first page.
- +10 SET DIS(0)="I 1 S IBDCNT=IBDCNT+1"
- +11 SET IOP="HOME"
- +12 DO EN1^DIP
- NOAPP1Q KILL DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,DUOUT,DIRUT,IBDCNT
- +1 QUIT