Routine: ALPBELOG

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")

HDR ; -- header code

 S VALMHDR(1)="Listing of data update filing errors (Error Log is in file 53.71)"

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

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

EXIT ; -- exit code

 K ^TMP("ALPBELOG",$J)

EXPND ; -- expand code

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HALPBELOG   4149     printed  Feb 18, 2025@23:05:40                                                                                                                                                                                                    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

ALPBELOG.m