ALPBELOG ;OIFO-DALLAS MW,SED,KC - BCBU LOG PROCESSOR ;01/01/03
;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
;
; This utility processes error log entries from the
; ERROR LOG section of the BCMA BACKUP PARAMETERS file
;
EN ; -- main entry point for ALPB ERROR LOG
D EN^VALM("PSB ERROR LOG")
Q
;
HDR ; -- header code
S VALMHDR(1)="Listing of data update filing errors (Error Log is in file 53.71)"
Q
;
INIT ; -- init variables and list array
K ^TMP("ALPBELOG",$J)
S ALPBPARM=+$O(^ALPB(53.71,0))
I ALPBPARM'>0 D Q
.S ^TMP("ALPBELOG",$J,1,0)="BCMA BACKUP PARAMETERS FILE IS NOT SET UP CORRECTLY."
.K ALPBPARM
.S VALMCNT=1
I $O(^ALPB(53.71,"C",""))="" D Q
.S ^TMP("ALPBELOG",$J,1,0)="There are no errors in the log."
.S VALMCNT=1
;
S ALPBLINE=0
S ALPBIEN=""
F S ALPBIEN=$O(^ALPB(53.71,"C",ALPBIEN)) Q:ALPBIEN="" D
.I ALPBIEN>0 D CLEAN^ALPBUTL1(ALPBIEN)
.I ALPBIEN>0&('$D(^ALPB(53.7,ALPBIEN,0))) Q
.S ALPBPDAT=$G(^ALPB(53.7,ALPBIEN,0))
.I ALPBPDAT="" S ALPBPDAT="SYSTEM/FILER ERROR^"
.S ALPBLINE=ALPBLINE+1
.S ALPBDATA(ALPBLINE,0)=" "_$P(ALPBPDAT,U)
.I $P(ALPBPDAT,U,2)'="" S ALPBDATA(ALPBLINE,0)=ALPBDATA(ALPBLINE,0)_$P(ALPBPDAT,U,2)
.S ALPBX=0
.F S ALPBX=$O(^ALPB(53.71,"C",ALPBIEN,ALPBX)) Q:'ALPBX D
..S ALPBEIEN=0
..F S ALPBEIEN=$O(^ALPB(53.71,"C",ALPBIEN,ALPBX,ALPBEIEN)) Q:'ALPBEIEN D
...;
...M ALPBEDAT=^ALPB(53.71,ALPBPARM,1,ALPBEIEN)
...S ALPBLINE=ALPBLINE+1
...S ALPBDATA(ALPBLINE,0)=" Log Ref#: "_ALPBEIEN
...S ALPBLINE=ALPBLINE+1
...S ALPBDATA(ALPBLINE,0)=" Log Date: "_$$FDATE^ALPBUTL($P(ALPBEDAT(0),U))
...S ALPBLINE=ALPBLINE+1
...S ALPBDATA(ALPBLINE,0)=" Order Number: "_$P($G(^ALPB(53.7,ALPBIEN,2,+$P(ALPBEDAT(0),U,3),0),"<undefined>"),U)
...S ALPBLINE=ALPBLINE+1
...S ALPBDATA(ALPBLINE,0)=" HL7 Msg IEN: "_$P(ALPBEDAT(0),U,4)
...I $G(^HL(772,+$P(ALPBEDAT(0),U,4),0))="" S ALPBDATA(ALPBLINE,0)=ALPBDATA(ALPBLINE,0)_" <--no longer in file 772"
...S ALPBLINE=ALPBLINE+1
...S ALPBDATA(ALPBLINE,0)=" HL7 Segment: "_$P(ALPBEDAT(0),U,5)
...S ALPBLINE=ALPBLINE+1
...S ALPBDATA(ALPBLINE,0)=" Segment Data: "
...I $D(ALPBEDAT(1)) D
....I $L(ALPBEDAT(1))<66 S ALPBDATA(ALPBLINE,0)=ALPBDATA(ALPBLINE,0)_ALPBEDAT(1)
....I $L(ALPBEDAT(1))>65&($L(ALPBEDAT(1))<131) D
.....S ALPBDATA(ALPBLINE,0)=ALPBDATA(ALPBLINE,0)_$E(ALPBEDAT(1),1,65)
.....S ALPBLINE=ALPBLINE+1
.....S ALPBDATA(ALPBLINE,0)=$$PAD^ALPBUTL($G(ALPBDATA(ALPBLINE,0)),16)_$E(ALPBEDAT(1),66,130)
.....I $L(ALPBEDAT(1))>130 D
......S ALPBLINE=ALPBLINE+1
......S ALPBDATA(ALPBLINE,0)=$$PAD^ALPBUTL($G(ALPBDATA(ALPBLINE,0)),16)_$E(ALPBEDAT(1),130,180)
...S ALPBY=0
...F S ALPBY=$O(ALPBEDAT(2,ALPBY)) Q:'ALPBY D
....S ALPBLINE=ALPBLINE+1
....S ALPBDATA(ALPBLINE,0)=" Error Code: "_$P(ALPBEDAT(2,ALPBY,0),U)
....S ALPBZ=0
....F S ALPBZ=$O(ALPBEDAT(2,ALPBY,1,ALPBZ)) Q:'ALPBZ D
.....S ALPBLINE=ALPBLINE+1
.....S $P(ALPBDATA(ALPBLINE,0)," ",16)=ALPBEDAT(2,ALPBY,1,ALPBZ,0)
....K ALPBZ
...K ALPBY
...S ALPBLINE=ALPBLINE+1
...S ALPBDATA(ALPBLINE,0)=""
...M ^TMP("ALPBELOG",$J)=ALPBDATA
...K ALPBDATA,ALPBEDAT
..K ALPBEIEN,ALPBPDAT
.K ALPBX
S VALMCNT=ALPBLINE
K ALPBIEN,ALPBLINE
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("ALPBELOG",$J)
Q
;
EXPND ; -- expand code
Q
;
DELONE ; select and delete a log entry...
N ALPBPARM,DIR,DIRUT,DTOUT,X,Y
S ALPBPARM=+$O(^ALPB(53.71,0))
I ALPBPARM'>0 Q
S DIR(0)="FAO^1:9999999^K:'$D(^ALPB(53.71,ALPBPARM,1,+X)) X"
S DIR("A")="Select Log's REF# TO DELETE: "
S DIR("?")="Select a Log entry by the 'Log Ref#' NUMBER shown in the display"
D ^DIR K DIR
I $D(DIRUT) Q
I +Y>0 D DELERR^ALPBUTL2(+Y)
D INIT
Q
;
DELALL ; purge all errors from the log...
N ALPBPARM,ALPBX,DIR,DIRUT,DTOUT,X,Y
S ALPBPARM=+$O(^ALPB(53.71,0))
I ALPBPARM'>0 Q
S DIR(0)="YA"
S DIR("A")="Are you SURE you wish to purge all Error Log entries? "
S DIR("B")="NO"
D ^DIR K DIR
I $D(DIRUT)!(Y'=1) K DIRUT,DTOUT,X,Y Q
S ALPBX=0
F S ALPBX=$O(^ALPB(53.71,ALPBPARM,1,ALPBX)) Q:'ALPBX D DELERR^ALPBUTL2(ALPBX)
D INIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HALPBELOG 4149 printed Apr 09, 2024@20:44:30 Page 2
ALPBELOG ;OIFO-DALLAS MW,SED,KC - BCBU LOG PROCESSOR ;01/01/03
+1 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
+2 ;
+3 ; This utility processes error log entries from the
+4 ; ERROR LOG section of the BCMA BACKUP PARAMETERS file
+5 ;
EN ; -- main entry point for ALPB ERROR LOG
+1 DO EN^VALM("PSB ERROR LOG")
+2 QUIT
+3 ;
HDR ; -- header code
+1 SET VALMHDR(1)="Listing of data update filing errors (Error Log is in file 53.71)"
+2 QUIT
+3 ;
INIT ; -- init variables and list array
+1 KILL ^TMP("ALPBELOG",$JOB)
+2 SET ALPBPARM=+$ORDER(^ALPB(53.71,0))
+3 IF ALPBPARM'>0
Begin DoDot:1
+4 SET ^TMP("ALPBELOG",$JOB,1,0)="BCMA BACKUP PARAMETERS FILE IS NOT SET UP CORRECTLY."
+5 KILL ALPBPARM
+6 SET VALMCNT=1
End DoDot:1
QUIT
+7 IF $ORDER(^ALPB(53.71,"C",""))=""
Begin DoDot:1
+8 SET ^TMP("ALPBELOG",$JOB,1,0)="There are no errors in the log."
+9 SET VALMCNT=1
End DoDot:1
QUIT
+10 ;
+11 SET ALPBLINE=0
+12 SET ALPBIEN=""
+13 FOR
SET ALPBIEN=$ORDER(^ALPB(53.71,"C",ALPBIEN))
if ALPBIEN=""
QUIT
Begin DoDot:1
+14 IF ALPBIEN>0
DO CLEAN^ALPBUTL1(ALPBIEN)
+15 IF ALPBIEN>0&('$DATA(^ALPB(53.7,ALPBIEN,0)))
QUIT
+16 SET ALPBPDAT=$GET(^ALPB(53.7,ALPBIEN,0))
+17 IF ALPBPDAT=""
SET ALPBPDAT="SYSTEM/FILER ERROR^"
+18 SET ALPBLINE=ALPBLINE+1
+19 SET ALPBDATA(ALPBLINE,0)=" "_$PIECE(ALPBPDAT,U)
+20 IF $PIECE(ALPBPDAT,U,2)'=""
SET ALPBDATA(ALPBLINE,0)=ALPBDATA(ALPBLINE,0)_$PIECE(ALPBPDAT,U,2)
+21 SET ALPBX=0
+22 FOR
SET ALPBX=$ORDER(^ALPB(53.71,"C",ALPBIEN,ALPBX))
if 'ALPBX
QUIT
Begin DoDot:2
+23 SET ALPBEIEN=0
+24 FOR
SET ALPBEIEN=$ORDER(^ALPB(53.71,"C",ALPBIEN,ALPBX,ALPBEIEN))
if 'ALPBEIEN
QUIT
Begin DoDot:3
+25 ;
+26 MERGE ALPBEDAT=^ALPB(53.71,ALPBPARM,1,ALPBEIEN)
+27 SET ALPBLINE=ALPBLINE+1
+28 SET ALPBDATA(ALPBLINE,0)=" Log Ref#: "_ALPBEIEN
+29 SET ALPBLINE=ALPBLINE+1
+30 SET ALPBDATA(ALPBLINE,0)=" Log Date: "_$$FDATE^ALPBUTL($PIECE(ALPBEDAT(0),U))
+31 SET ALPBLINE=ALPBLINE+1
+32 SET ALPBDATA(ALPBLINE,0)=" Order Number: "_$PIECE($GET(^ALPB(53.7,ALPBIEN,2,+$PIECE(ALPBEDAT(0),U,3),0),"<undefined>"),U)
+33 SET ALPBLINE=ALPBLINE+1
+34 SET ALPBDATA(ALPBLINE,0)=" HL7 Msg IEN: "_$PIECE(ALPBEDAT(0),U,4)
+35 IF $GET(^HL(772,+$PIECE(ALPBEDAT(0),U,4),0))=""
SET ALPBDATA(ALPBLINE,0)=ALPBDATA(ALPBLINE,0)_" <--no longer in file 772"
+36 SET ALPBLINE=ALPBLINE+1
+37 SET ALPBDATA(ALPBLINE,0)=" HL7 Segment: "_$PIECE(ALPBEDAT(0),U,5)
+38 SET ALPBLINE=ALPBLINE+1
+39 SET ALPBDATA(ALPBLINE,0)=" Segment Data: "
+40 IF $DATA(ALPBEDAT(1))
Begin DoDot:4
+41 IF $LENGTH(ALPBEDAT(1))<66
SET ALPBDATA(ALPBLINE,0)=ALPBDATA(ALPBLINE,0)_ALPBEDAT(1)
+42 IF $LENGTH(ALPBEDAT(1))>65&($LENGTH(ALPBEDAT(1))<131)
Begin DoDot:5
+43 SET ALPBDATA(ALPBLINE,0)=ALPBDATA(ALPBLINE,0)_$EXTRACT(ALPBEDAT(1),1,65)
+44 SET ALPBLINE=ALPBLINE+1
+45 SET ALPBDATA(ALPBLINE,0)=$$PAD^ALPBUTL($GET(ALPBDATA(ALPBLINE,0)),16)_$EXTRACT(ALPBEDAT(1),66,130)
+46 IF $LENGTH(ALPBEDAT(1))>130
Begin DoDot:6
+47 SET ALPBLINE=ALPBLINE+1
+48 SET ALPBDATA(ALPBLINE,0)=$$PAD^ALPBUTL($GET(ALPBDATA(ALPBLINE,0)),16)_$EXTRACT(ALPBEDAT(1),130,180)
End DoDot:6
End DoDot:5
End DoDot:4
+49 SET ALPBY=0
+50 FOR
SET ALPBY=$ORDER(ALPBEDAT(2,ALPBY))
if 'ALPBY
QUIT
Begin DoDot:4
+51 SET ALPBLINE=ALPBLINE+1
+52 SET ALPBDATA(ALPBLINE,0)=" Error Code: "_$PIECE(ALPBEDAT(2,ALPBY,0),U)
+53 SET ALPBZ=0
+54 FOR
SET ALPBZ=$ORDER(ALPBEDAT(2,ALPBY,1,ALPBZ))
if 'ALPBZ
QUIT
Begin DoDot:5
+55 SET ALPBLINE=ALPBLINE+1
+56 SET $PIECE(ALPBDATA(ALPBLINE,0)," ",16)=ALPBEDAT(2,ALPBY,1,ALPBZ,0)
End DoDot:5
+57 KILL ALPBZ
End DoDot:4
+58 KILL ALPBY
+59 SET ALPBLINE=ALPBLINE+1
+60 SET ALPBDATA(ALPBLINE,0)=""
+61 MERGE ^TMP("ALPBELOG",$JOB)=ALPBDATA
+62 KILL ALPBDATA,ALPBEDAT
End DoDot:3
+63 KILL ALPBEIEN,ALPBPDAT
End DoDot:2
+64 KILL ALPBX
End DoDot:1
+65 SET VALMCNT=ALPBLINE
+66 KILL ALPBIEN,ALPBLINE
+67 QUIT
+68 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("ALPBELOG",$JOB)
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
DELONE ; select and delete a log entry...
+1 NEW ALPBPARM,DIR,DIRUT,DTOUT,X,Y
+2 SET ALPBPARM=+$ORDER(^ALPB(53.71,0))
+3 IF ALPBPARM'>0
QUIT
+4 SET DIR(0)="FAO^1:9999999^K:'$D(^ALPB(53.71,ALPBPARM,1,+X)) X"
+5 SET DIR("A")="Select Log's REF# TO DELETE: "
+6 SET DIR("?")="Select a Log entry by the 'Log Ref#' NUMBER shown in the display"
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
QUIT
+9 IF +Y>0
DO DELERR^ALPBUTL2(+Y)
+10 DO INIT
+11 QUIT
+12 ;
DELALL ; purge all errors from the log...
+1 NEW ALPBPARM,ALPBX,DIR,DIRUT,DTOUT,X,Y
+2 SET ALPBPARM=+$ORDER(^ALPB(53.71,0))
+3 IF ALPBPARM'>0
QUIT
+4 SET DIR(0)="YA"
+5 SET DIR("A")="Are you SURE you wish to purge all Error Log entries? "
+6 SET DIR("B")="NO"
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)!(Y'=1)
KILL DIRUT,DTOUT,X,Y
QUIT
+9 SET ALPBX=0
+10 FOR
SET ALPBX=$ORDER(^ALPB(53.71,ALPBPARM,1,ALPBX))
if 'ALPBX
QUIT
DO DELERR^ALPBUTL2(ALPBX)
+11 DO INIT
+12 QUIT
