Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBDF18E2

IBDF18E2.m

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