HLCSRPT2.m

HLCSRPT2 ;ISC-SF/RAH-TRANS LOG ERROR LIST ;05/12/03  05:47 PM [ 12/23/2003  4:01 PM ]

 ;;1.6;HEALTH LEVEL SEVEN;**50,85,107,1005**;Oct 13, 1995

 ;Calls to SAVEDDB^DDBR2, USAVEDDB^DDBR2, PSR^DDBR0, and WP^DDBR2 supported by IA#2540 & IA#3594

 ;

 Q

 ;

EN ; Entry point for reporting error messages.

 ;

 ; All NEWs below added by HL*1.6*85

 N BLDOFF,BLDON,DY,ERRDTB,ERRDTE,HLCSCLNT,HLCSDTE,HLCSDTP

 N HLCSEVN,HLCSEVN1,HLCSEVN2,HLCSHDR,HLCSK,HLCSLINK

 N HLCSLNK,HLCSMID,HLCSMX,HLCSNREC,HLCSPTR,HLCSRNO,HLCSSRVR

 N HLCSTITL,HLCSTYP,HLERR,IEN773,LAST773,LASTPDT

 N LPIENS,NOREC,NUMERR,OLD773,OLDPDT,RVOFF,RVON,SPACE

 N SPACE20,SPACE25,SPACE30,SPACE80,STOP,TYPEINFO,VERS22

 ;

 D CLEANGBL ;HL*1.6*85

 ;

 S (STOP,NOREC)=""

 D SCREEN^HLCSRPT

 S HLCSNREC=BLDON_" ===>>>  NO MATCHING RECORDS  <<<=== "_BLDOFF

 S HLCSTITL="#773-IEN      Message-ID       Procd     Log-Link   Msg:Evn IO Sndg-Apl Rcvr-Apl" ;HL*1.6*85

 S HLCSPTR=1,HLCSRNO=1

 S VERS22=""

 I 22'>+$$VERSION^XPDUTL("DI")!($$PATCH^XPDUTL("DI*21.0*32")) S VERS22="YES" ;HL*1.6*85

 I VERS22'="YES" D

 . S ^TMP("DDBPF1Z",$J)="D SHOWMSG^HLCSRPT2 Q"

 . S HLCSTITL=HLCSTITL_" ERR"

 E  S HLCSTITL=HLCSTITL_"    "

 S ^TMP($J,"LIST","MESSAGE")="^TMP($J,""MESSAGE"",HLCSRNO)"

 S ^TMP($J,"LIST",HLCSTITL_" ERR")="^TMP(""TLOG"",$J)" ;HL*1.6*85

 ;

REEN ; Internal Re-entry Point

 S STOP=""

 D WHATERR Q:(+$G(STOP))

 QUIT:'$$SETUP^HLCSRPT4  ;-> HL*1.6*85

 I TYPEINFO=2 S HLCSTITL="#773-IEN      Message-ID       Procd     Log-Link   Error-type               " ;HL*1.6*85

 D ERRSRCH

 I ERRDTE[9999999 S ERRDTE=$$NOW^XLFDT

 I +$G(STOP) D EXIT Q

 I +$G(NOREC) W !!,HLCSNREC,!! S DIR(0)="E" D ^DIR K DIR,X,Y D EXIT Q

 D DISPLAY^HLCSRPT ;HL*1.6*85

 D CLEANGBL ;HL*1.6*85

 D EXIT

 S STOP=1

 Q

 ;

CLEANGBL ; New subroutine added by HL*1.6*85 to clean up globals

 N GBL

 F GBL="LIST","MESSAGE" KILL ^TMP($J,GBL)

 F GBL="DDBPF1Z","DDBLST","TLOG","TMPLOG" KILL ^TMP(GBL,$J)

 QUIT

 ;

WHATERR ; Ask for one error code; with default of all

 W @IOF,! S HLCSHDR="Error Type Selection" D HLCSBAR

 S X="",HLCSER="ALL"

 S DIR(0)="PAO^771.7:AEO",DIR("A")="Select Error Type:  ALL//"

 D ^DIR S:($D(DTOUT)!($D(DUOUT))) STOP=1

 I +$G(STOP) K DIR,X,Y Q

 I X="" K DIR,X,Y Q

 I Y=-1 W !,X_" NOT VALID " K DIR,X,Y G WHATERR

 S HLCSTER1=$P(Y,U,1),HLCSTER2=$P(Y,U,2) K DIR,X,Y

 S HLCSER=1

 Q

 ;

ERRSRCH ; Find and report the 'errored' messages (Multiple HL*1.6*85 changes start here)

 ; ERRDTB,ERRDTE,NUMERR -- req

 N NEXT,CT

 W !!,"PLEASE WAIT, THIS CAN TAKE AWHILE..."

 ;

 ;HL*1.6*85 - LOADERR loads all errors, using the user-supplied 

 ;            parameters, and places them in ^TMP.  Below, the code

 ;            now loops thru ^TMP instead of ^HLMA (which happened

 ;            in LOADERR.)

 D LOADERR^HLCSRPT4

 ;

 ; Looping starts here...

 S HLCSI=0,HLCSST=0,HLCSLN=0

 F  S HLCSI=$O(^TMP("ERRLST",$J,HLCSI)) Q:HLCSI'>0  D

 .  S HLCSN=HLCSI,HLCSJ=0

 .  F  S HLCSJ=$O(^TMP("ERRLST",$J,HLCSI,HLCSJ)) Q:HLCSJ'>0  D

 .. ;HL*1.6*85 changes end here, until noted otherwise below.

 ..

 .. I '$D(^HLMA(HLCSJ,0)) Q

 .. S HLCSX=^HLMA(HLCSJ,0),HLCSDTE=$P(HLCSX,U,1)

 .. I $D(^HLMA(HLCSJ,"S")) S HLCSDTP=$P(^HLMA(HLCSJ,"S"),U,1)

 .. E  S HLCSDTP=""

 .. I $D(^HLMA(HLCSJ,"P")) S HLCSY=^HLMA(HLCSJ,"P")

 .. E  S HLCSY=""

 .. I HLCSER=1,(HLCSTER1'=$P(HLCSY,U,4)) Q

 .. S HLCSER1=$P(HLCSY,U,4),HLCSER2=HLCSER1

 .. I HLCSER1'="",($D(^HL(771.7,HLCSER1,0))) S HLCSER1=$P(^HL(771.7,HLCSER1,0),U,1)

 .. S HLCSERMS=$P(HLCSY,U,3)

 .. S HLCSLINK=$P(HLCSX,U,7) S HLCSLNK="          "

 .. I HLCSLINK'="",($D(^HLCS(870,HLCSLINK,0))) S HLCSLNK=$P(^HLCS(870,HLCSLINK,0),U,1)

 .. S HLCSEVN1=$P(HLCSX,U,13) I HLCSEVN1'="",($D(^HL(771.2,HLCSEVN1,0))) S HLCSEVN1=$P(^HL(771.2,HLCSEVN1,0),U,1)

 .. S HLCSEVN2=$P(HLCSX,U,14) I HLCSEVN2'="",($D(^HL(779.001,HLCSEVN2,0))) S HLCSEVN2=$P(^HL(779.001,HLCSEVN2,0),U,1)

 .. I HLCSEVN1="" S HLCSEVN1=$$MSGEVN^HLCSRPT5(HLCSJ,2) ;HL*1.6*85

 .. I HLCSEVN2="" S HLCSEVN2=$$MSGEVN^HLCSRPT5(HLCSJ,2) ;HL*1.6*85

 .. I $L(HLCSEVN1)<3 S HLCSEVN1=HLCSEVN1_"   ",HLCSEVN1=$E(HLCSEVN1,1,3)

 .. I $L(HLCSEVN2)<3 S HLCSEVN2=HLCSEVN2_"   ",HLCSEVN2=$E(HLCSEVN2,1,3)

 .. S HLCSEVN=HLCSEVN1_":"_HLCSEVN2

 .. D ERRRPT^HLCSRPT5 ;HL*1.6*85 - Code overrun moved

 .. Q

 .Q

 KILL ^TMP("ERRLST",$J) ;HL*1.6*85

 D TMPLOG^HLCSRPT4 ;HL*1.6*85 Reset ^TMP("TMPLOG",$J) to ^TMP("TLOG",$J)

 I '$D(^TMP("TLOG",$J,1)) S NOREC=1 Q

 ;HL*1.6*85 - HLCSTITL already set above ;S HLCSTITL="IEN Record #   MESSAGE ID #         Log Link   Msg:Evn IO Sndg Apl Rcvr Apl"

 I '$D(VERS22) S HLCSTITL=HLCSTITL_" ERR"

 E  S HLCSTITL=HLCSTITL_"    "

 D TEST

 Q

 ;

SHOWMSG ; Enable switching to specific message (used by PF1Z).

 ; If FM version 22 installed, uses VERS22 code, instead.

 W @IOF

 S DIR(0)="F:AE",DIR("A")="Enter Record Number: "

 D ^DIR Q:$D(DIRUT)

 I Y=-1!(X="") Q

 S HLCSRNO=X I '$D(^HLMA(HLCSRNO,0)) D  Q

 . W !!,BLDON,"  ==>  NO SUCH RECORD NUMBER <== ",BLDOFF H 3

 S HLCSPTR=$P(^HLMA(HLCSRNO,0),"^",1)

 S XXY=HLCSRNO,XXZ=HLCSPTR D VERS22(XXY,XXZ)

 D SWITCH

 Q

SWITCH ; Non-standard Fileman Browser calls covered by IA# 2540.

 N DDBLN,DDBZ,DIC,DIR,X,Y,DIRUT,DIROUT,DUOUT,DILN

 S DILN=DDBRSA(DDBRSA,"DDBSRL")-2

 S:$G(DDBLST)="" DDBLST="^TMP(""DDBLST"",$J)" S DDBLN=$S($D(@DDBLST@("A",DDBSA)):^(DDBSA),1:$O(@DDBLST@(" "),-1)+1)

 I $D(@DDBLST) D

 .I $O(@DDBLST@(" "),-1)=1,$G(@DDBLST@(1,"DDBSA"))=DDBSA Q

 .S DDBZ=$G(@DDBLST@("A",DDBSA),0)

 .S Y=2

 .D SAVEDDB^DDBR2(DDBLST,DDBLN),USAVEDDB^DDBR2(DDBLST,+Y)

 .S DIROUT=1

 N DDBLNA

 I $G(DDBLNA,-1)=-1 G PS

 I $G(DDBLNA(6))=DDBSA G PS  ;if current doc re-selected

 I $G(DDBLNA(6))]"",$D(@DDBLST@("APSA",DDBSA)) G PS  ;on list

 D:DDBLNA>0 SAVEDDB^DDBR2(DDBLST,DDBLN),WP^DDBR2(.DDBLNA)

PS D PSR^DDBR0(1)

 Q

 ;

VERS22(XXY,XXZ) ; this is modified code from SHOWMSG^HLCSRPT1.

 ; Each node, ^tmp($j,"message",record_ien), invokes this code

 ; to compile a 'virtual w-p document' when a message is browsed.

 I $D(^HLMA(XXY,"MSH",0)) D

 .S ^TMP($J,"MESSAGE",XXY,0)=^HLMA(XXY,"MSH",0)

 .S YY1=$P(^HLMA(XXY,"MSH",0),U,3),YY2=$P(^HLMA(XXY,"MSH",0),U,4)

 E  S ^TMP($J,"MESSAGE",XXY,0)="^^1^1" S (YY1,YY2)=1

 S XLINE=^HLMA(XXY,0)

 S LINE="Record #: "_XXY_"                    ",LINE=$E(LINE,1,30)

 S LINE=LINE_"Message #: "_$P(XLINE,U,2)

 S ^TMP($J,"MESSAGE",XXY,1,0)=LINE

 S DTE=$P(XLINE,U,1) I $P($G(^HL(772,DTE,0)),U,1)'="" S DTE=$P(^HL(772,DTE,0),U,1),DTE=$E(DTE,4,7)_$E(DTE,2,3)_"."_$P(DTE,".",2)_"      "

 I $D(^HLMA(XXY,"S")),$P(^HLMA(XXY,"S"),U,1)'="" S DTP=$P(^HLMA(XXY,"S"),U,1) S DTP=$E(DTP,4,7)_$E(DTP,2,3)_"."_$P(DTP,".",2)

 E  S DTP=" "

 S LINE="D/T Entered: "_DTE,LINE=$E(LINE,1,30)_"D/T Processed: "_DTP

 S ^TMP($J,"MESSAGE",XXY,2,0)=LINE K DTE,DTP

 S LINE="Logical Link: " I $P(XLINE,U,7)'="",($G(^HLCS(870,$P(XLINE,U,7),0))) S LINE=LINE_$P(^HLCS(870,$P(XLINE,U,7),0),U,1)

 S LINE=LINE_"                ",LINE=$E(LINE,1,30)

 S LINE=LINE_"Ack To MSG#: " I $P(XLINE,U,6)'="",$G(^HLMA($P(XLINE,U,6),0)) S LINE=LINE_$P(^HLMA($P(XLINE,U,6),0),U,2)

 S ^TMP($J,"MESSAGE",XXY,3,0)=LINE

 S DTS="" I $P($G(^HLMA(XXY,"P")),U,2)'="" S DTS=$P(^HLMA(XXY,"P"),U,2),DTS=$E(DTS,4,7)_$E(DTS,2,3)_"."_$P(DTS,".",2)

 S LINE="D/T STATUS: "_DTS_"                 ",LINE=$E(LINE,1,30),LINE=LINE_"STATUS: "

 I $P(^HLMA(XXY,"P"),U,2)'="",($G(^HL(771.6,+$P(^HLMA(XXY,"P"),U,1),0))) S LINE=LINE_$P(^HL(771.6,+$P(^HLMA(XXY,"P"),U,1),0),U,1)

 S ^TMP($J,"MESSAGE",XXY,4,0)=LINE K DTS

 S LINE="ERR MSG: " I $P(^HLMA(XXY,"P"),U,3)'="" S LINE=LINE_$E($P(^HLMA(XXY,"P"),U,3),1,20)

 S LINE=LINE_"                      ",LINE=$E(LINE,1,30)_"ERR TYPE: "

 I $P(^HLMA(XXY,"P"),U,4)'="",($D(^HL(771.7,+$P(^HLMA(XXY,"P"),U,4),0))) S LINE=LINE_$P(^HL(771.7,+$P(^HLMA(XXY,"P"),U,4),0),U,1)

 S ^TMP($J,"MESSAGE",XXY,5,0)=LINE

 S LINE="Sending Appl: " I $P(XLINE,U,11)'="",($D(^HL(771,$P(XLINE,U,11),0))) S LINE=LINE_$P(^HL(771,$P(XLINE,U,11),0),U,1)

 S ^TMP($J,"MESSAGE",XXY,6,0)=LINE

 S LINE="Receiving Appl: " I $P(XLINE,U,12)'="",($D(^HL(771,$P(XLINE,U,12),0))) S LINE=LINE_$P(^HL(771,$P(XLINE,U,12),0),U,1)

 S ^TMP($J,"MESSAGE",XXY,7,0)=LINE

 S LINE="Message Type: " I $P(XLINE,U,13)'="",($D(^HL(771.2,$P(XLINE,U,13),0))) S LINE=LINE_$P(^HL(771.2,$P(XLINE,U,13),0),U,1)

 S LINE=LINE_"                    ",LINE=$E(LINE,1,30)_"Event Type: "

 I $P(XLINE,U,14)'="",($D(^HL(779.001,$P(XLINE,U,14),0))) S LINE=LINE_$P(^HL(779.001,$P(XLINE,U,14),0),U,1)

 S ^TMP($J,"MESSAGE",XXY,8,0)=LINE K LINE,XLINE

 S ^TMP($J,"MESSAGE",XXY,9,0)="MESSAGE HEADER: "

 S LN2=10

 I $D(^HLMA(XXY,"MSH",0)) D

 .S LN1=.5

 .F  S LN1=$O(^HLMA(XXY,"MSH",LN1)) Q:LN1=""  D

 .. S ^TMP($J,"MESSAGE",XXY,LN2,0)=^HLMA(XXY,"MSH",LN1,0)

 .. ;HL*1.6*107 start: to fix the multiple lines per segment

 .. ;S LN2=LN2+1,LN1=LN1+1

 .. S LN2=LN2+1

 .. ;HL*1.6*107 end

 E  S ^TMP($J,"MESSAGE",XXY,LN2,0)=" No Header in MSG Admin File (#773)" S LN2=LN2+1

 S LN1=.5

 S ^TMP($J,"MESSAGE",XXY,LN2,0)="MESSAGE TEXT: ",LN2=LN2+1

 I $D(^HL(772,XXZ,"IN",0)) D

 .F  S LN1=$O(^HL(772,XXZ,"IN",LN1)) Q:(LN1="")  D

 .. S ^TMP($J,"MESSAGE",XXY,LN2,0)=^HL(772,XXZ,"IN",LN1,0)

 .. ;HL*1.6*107 start: to fix the multiple lines per segment

 .. ;S LN2=LN2+1,LN1=LN1+1

 .. S LN2=LN2+1

 .. ;HL*1.6*107 end

 ..Q

 E  S ^TMP($J,"MESSAGE",XXY,LN2,0)=" No Message in MSG Text File (#772)" S LN2=LN2+1

 S (YY1,YY2)=LN2-1

 S Y1Y2=YY1_"^"_YY2

 S $P(^TMP($J,"MESSAGE",XXY,0),U,3,4)=Y1Y2

 K LN1,LN2,Y1Y2,YY1,YY2

 Q

 ;

EXIT ;

 K I,J

 K HLCSER,HLCSER1,HLCSER2,HLCSI,HLCSJ,HLCSLN,HLCSN

 K HLCSST,HLCSTER1,HLCSTER2,HLCSERMS,HLCSX,HLCSY

 K ^TMP($J,"LIST",HLCSTITL_" ERR") ;HL*1.6*85

 I VERS22'="YES" S ^TMP("DDBPF1Z",$J)="D SHOWMSG^HLCSRPT Q"

 Q

 ;

HLCSBAR ; Center Title on Top Line of Screen

 W RVON,?(80-$L(HLCSHDR)\2),HLCSHDR,$E(SPACE,$X,77),RVOFF,!

 Q

 ;

TEST ;

 S HLCSJ=$O(^TMP("TLOG",$J,0))

 S HLCSJ=+$P(HLCSJ," ",1)

 S ^TMP($J,"MESSAGE",HLCSJ,0)="^^1^1"

 S ^TMP($J,"MESSAGE",HLCSJ,1,0)=" HEADER: "

 S HLCSRNO=HLCSJ

 Q

 ;

HLCSRPT2  ;ISC-SF/RAH-TRANS LOG ERROR LIST ;05/12/03  05:47 PM [ 12/23/2003  4:01 PM ]

 +1       ;;1.6;HEALTH LEVEL SEVEN;**50,85,107,1005**;Oct 13, 1995

 +2       ;Calls to SAVEDDB^DDBR2, USAVEDDB^DDBR2, PSR^DDBR0, and WP^DDBR2 supported by IA#2540 & IA#3594

 +3       ;

 +4        QUIT 

 +5       ;

EN        ; Entry point for reporting error messages.

 +1       ;

 +2       ; All NEWs below added by HL*1.6*85

 +3        NEW BLDOFF,BLDON,DY,ERRDTB,ERRDTE,HLCSCLNT,HLCSDTE,HLCSDTP

 +4        NEW HLCSEVN,HLCSEVN1,HLCSEVN2,HLCSHDR,HLCSK,HLCSLINK

 +5        NEW HLCSLNK,HLCSMID,HLCSMX,HLCSNREC,HLCSPTR,HLCSRNO,HLCSSRVR

 +6        NEW HLCSTITL,HLCSTYP,HLERR,IEN773,LAST773,LASTPDT

 +7        NEW LPIENS,NOREC,NUMERR,OLD773,OLDPDT,RVOFF,RVON,SPACE

 +8        NEW SPACE20,SPACE25,SPACE30,SPACE80,STOP,TYPEINFO,VERS22

 +9       ;

 +10      ;HL*1.6*85

           DO CLEANGBL

 +11      ;

 +12       SET (STOP,NOREC)=""

 +13       DO SCREEN^HLCSRPT

 +14       SET HLCSNREC=BLDON_" ===>>>  NO MATCHING RECORDS  <<<=== "_BLDOFF

 +15      ;HL*1.6*85

           SET HLCSTITL="#773-IEN      Message-ID       Procd     Log-Link   Msg:Evn IO Sndg-Apl Rcvr-Apl"

 +16       SET HLCSPTR=1

           SET HLCSRNO=1

 +17       SET VERS22=""

 +18      ;HL*1.6*85

           IF 22'>+$$VERSION^XPDUTL("DI")!($$PATCH^XPDUTL("DI*21.0*32"))

               SET VERS22="YES"

 +19       IF VERS22'="YES"

               Begin DoDot:1

 +20               SET ^TMP("DDBPF1Z",$JOB)="D SHOWMSG^HLCSRPT2 Q"

 +21               SET HLCSTITL=HLCSTITL_" ERR"

               End DoDot:1

 +22      IF '$TEST

               SET HLCSTITL=HLCSTITL_"    "

 +23       SET ^TMP($JOB,"LIST","MESSAGE")="^TMP($J,""MESSAGE"",HLCSRNO)"

 +24      ;HL*1.6*85

           SET ^TMP($JOB,"LIST",HLCSTITL_" ERR")="^TMP(""TLOG"",$J)"

 +25      ;

REEN      ; Internal Re-entry Point

 +1        SET STOP=""

 +2        DO WHATERR

           IF (+$GET(STOP))

               QUIT 

 +3       ;-> HL*1.6*85

           IF '$$SETUP^HLCSRPT4

               QUIT 

 +4       ;HL*1.6*85

           IF TYPEINFO=2

               SET HLCSTITL="#773-IEN      Message-ID       Procd     Log-Link   Error-type               "

 +5        DO ERRSRCH

 +6        IF ERRDTE[9999999

               SET ERRDTE=$$NOW^XLFDT

 +7        IF +$GET(STOP)

               DO EXIT

               QUIT 

 +8        IF +$GET(NOREC)

               WRITE !!,HLCSNREC,!!

               SET DIR(0)="E"

               DO ^DIR

               KILL DIR,X,Y

               DO EXIT

               QUIT 

 +9       ;HL*1.6*85

           DO DISPLAY^HLCSRPT

 +10      ;HL*1.6*85

           DO CLEANGBL

 +11       DO EXIT

 +12       SET STOP=1

 +13       QUIT 

 +14      ;

CLEANGBL  ; New subroutine added by HL*1.6*85 to clean up globals

 +1        NEW GBL

 +2        FOR GBL="LIST","MESSAGE"

               KILL ^TMP($JOB,GBL)

 +3        FOR GBL="DDBPF1Z","DDBLST","TLOG","TMPLOG"

               KILL ^TMP(GBL,$JOB)

 +4        QUIT 

 +5       ;

WHATERR   ; Ask for one error code; with default of all

 +1        WRITE @IOF,!

           SET HLCSHDR="Error Type Selection"

           DO HLCSBAR

 +2        SET X=""

           SET HLCSER="ALL"

 +3        SET DIR(0)="PAO^771.7:AEO"

           SET DIR("A")="Select Error Type:  ALL//"

 +4        DO ^DIR

           IF ($DATA(DTOUT)!($DATA(DUOUT)))

               SET STOP=1

 +5        IF +$GET(STOP)

               KILL DIR,X,Y

               QUIT 

 +6        IF X=""

               KILL DIR,X,Y

               QUIT 

 +7        IF Y=-1

               WRITE !,X_" NOT VALID "

               KILL DIR,X,Y

               GOTO WHATERR

 +8        SET HLCSTER1=$PIECE(Y,U,1)

           SET HLCSTER2=$PIECE(Y,U,2)

           KILL DIR,X,Y

 +9        SET HLCSER=1

 +10       QUIT 

 +11      ;

ERRSRCH   ; Find and report the 'errored' messages (Multiple HL*1.6*85 changes start here)

 +1       ; ERRDTB,ERRDTE,NUMERR -- req

 +2        NEW NEXT,CT

 +3        WRITE !!,"PLEASE WAIT, THIS CAN TAKE AWHILE..."

 +4       ;

 +5       ;HL*1.6*85 - LOADERR loads all errors, using the user-supplied 

 +6       ;            parameters, and places them in ^TMP.  Below, the code

 +7       ;            now loops thru ^TMP instead of ^HLMA (which happened

 +8       ;            in LOADERR.)

 +9        DO LOADERR^HLCSRPT4

 +10      ;

 +11      ; Looping starts here...

 +12       SET HLCSI=0

           SET HLCSST=0

           SET HLCSLN=0

 +13       FOR 

               SET HLCSI=$ORDER(^TMP("ERRLST",$JOB,HLCSI))

               IF HLCSI'>0

                   QUIT 

               Begin DoDot:1

 +14               SET HLCSN=HLCSI

                   SET HLCSJ=0

 +15               FOR 

                       SET HLCSJ=$ORDER(^TMP("ERRLST",$JOB,HLCSI,HLCSJ))

                       IF HLCSJ'>0

                           QUIT 

                       Begin DoDot:2

 +16      ;HL*1.6*85 changes end here, until noted otherwise below.

 +17  +18                  IF '$DATA(^HLMA(HLCSJ,0))

                               QUIT 

 +19                       SET HLCSX=^HLMA(HLCSJ,0)

                           SET HLCSDTE=$PIECE(HLCSX,U,1)

 +20                       IF $DATA(^HLMA(HLCSJ,"S"))

                               SET HLCSDTP=$PIECE(^HLMA(HLCSJ,"S"),U,1)

 +21                      IF '$TEST

                               SET HLCSDTP=""

 +22                       IF $DATA(^HLMA(HLCSJ,"P"))

                               SET HLCSY=^HLMA(HLCSJ,"P")

 +23                      IF '$TEST

                               SET HLCSY=""

 +24                       IF HLCSER=1

                               IF (HLCSTER1'=$PIECE(HLCSY,U,4))

                                   QUIT 

 +25                       SET HLCSER1=$PIECE(HLCSY,U,4)

                           SET HLCSER2=HLCSER1

 +26                       IF HLCSER1'=""

                               IF ($DATA(^HL(771.7,HLCSER1,0)))

                                   SET HLCSER1=$PIECE(^HL(771.7,HLCSER1,0),U,1)

 +27                       SET HLCSERMS=$PIECE(HLCSY,U,3)

 +28                       SET HLCSLINK=$PIECE(HLCSX,U,7)

                           SET HLCSLNK="          "

 +29                       IF HLCSLINK'=""

                               IF ($DATA(^HLCS(870,HLCSLINK,0)))

                                   SET HLCSLNK=$PIECE(^HLCS(870,HLCSLINK,0),U,1)

 +30                       SET HLCSEVN1=$PIECE(HLCSX,U,13)

                           IF HLCSEVN1'=""

                               IF ($DATA(^HL(771.2,HLCSEVN1,0)))

                                   SET HLCSEVN1=$PIECE(^HL(771.2,HLCSEVN1,0),U,1)

 +31                       SET HLCSEVN2=$PIECE(HLCSX,U,14)

                           IF HLCSEVN2'=""

                               IF ($DATA(^HL(779.001,HLCSEVN2,0)))

                                   SET HLCSEVN2=$PIECE(^HL(779.001,HLCSEVN2,0),U,1)

 +32      ;HL*1.6*85

                           IF HLCSEVN1=""

                               SET HLCSEVN1=$$MSGEVN^HLCSRPT5(HLCSJ,2)

 +33      ;HL*1.6*85

                           IF HLCSEVN2=""

                               SET HLCSEVN2=$$MSGEVN^HLCSRPT5(HLCSJ,2)

 +34                       IF $LENGTH(HLCSEVN1)<3

                               SET HLCSEVN1=HLCSEVN1_"   "

                               SET HLCSEVN1=$EXTRACT(HLCSEVN1,1,3)

 +35                       IF $LENGTH(HLCSEVN2)<3

                               SET HLCSEVN2=HLCSEVN2_"   "

                               SET HLCSEVN2=$EXTRACT(HLCSEVN2,1,3)

 +36                       SET HLCSEVN=HLCSEVN1_":"_HLCSEVN2

 +37      ;HL*1.6*85 - Code overrun moved

                           DO ERRRPT^HLCSRPT5

 +38                       QUIT 

                       End DoDot:2

 +39               QUIT 

               End DoDot:1

 +40      ;HL*1.6*85

           KILL ^TMP("ERRLST",$JOB)

 +41      ;HL*1.6*85 Reset ^TMP("TMPLOG",$J) to ^TMP("TLOG",$J)

           DO TMPLOG^HLCSRPT4

 +42       IF '$DATA(^TMP("TLOG",$JOB,1))

               SET NOREC=1

               QUIT 

 +43      ;HL*1.6*85 - HLCSTITL already set above ;S HLCSTITL="IEN Record #   MESSAGE ID #         Log Link   Msg:Evn IO Sndg Apl Rcvr Apl"

 +44       IF '$DATA(VERS22)

               SET HLCSTITL=HLCSTITL_" ERR"

 +45      IF '$TEST

               SET HLCSTITL=HLCSTITL_"    "

 +46       DO TEST

 +47       QUIT 

 +48      ;

SHOWMSG   ; Enable switching to specific message (used by PF1Z).

 +1       ; If FM version 22 installed, uses VERS22 code, instead.

 +2        WRITE @IOF

 +3        SET DIR(0)="F:AE"

           SET DIR("A")="Enter Record Number: "

 +4        DO ^DIR

           IF $DATA(DIRUT)

               QUIT 

 +5        IF Y=-1!(X="")

               QUIT 

 +6        SET HLCSRNO=X

           IF '$DATA(^HLMA(HLCSRNO,0))

               Begin DoDot:1

 +7                WRITE !!,BLDON,"  ==>  NO SUCH RECORD NUMBER <== ",BLDOFF

                   HANG 3

               End DoDot:1

               QUIT 

 +8        SET HLCSPTR=$PIECE(^HLMA(HLCSRNO,0),"^",1)

 +9        SET XXY=HLCSRNO

           SET XXZ=HLCSPTR

           DO VERS22(XXY,XXZ)

 +10       DO SWITCH

 +11       QUIT 

SWITCH    ; Non-standard Fileman Browser calls covered by IA# 2540.

 +1        NEW DDBLN,DDBZ,DIC,DIR,X,Y,DIRUT,DIROUT,DUOUT,DILN

 +2        SET DILN=DDBRSA(DDBRSA,"DDBSRL")-2

 +3        IF $GET(DDBLST)=""

               SET DDBLST="^TMP(""DDBLST"",$J)"

           SET DDBLN=$SELECT($DATA(@DDBLST@("A",DDBSA)):^(DDBSA),1:$ORDER(@DDBLST@(" "),-1)+1)

 +4        IF $DATA(@DDBLST)

               Begin DoDot:1

 +5                IF $ORDER(@DDBLST@(" "),-1)=1

                       IF $GET(@DDBLST@(1,"DDBSA"))=DDBSA

                           QUIT 

 +6                SET DDBZ=$GET(@DDBLST@("A",DDBSA),0)

 +7                SET Y=2

 +8                DO SAVEDDB^DDBR2(DDBLST,DDBLN)

                   DO USAVEDDB^DDBR2(DDBLST,+Y)

 +9                SET DIROUT=1

               End DoDot:1

 +10       NEW DDBLNA

 +11       IF $GET(DDBLNA,-1)=-1

               GOTO PS

 +12      ;if current doc re-selected

           IF $GET(DDBLNA(6))=DDBSA

               GOTO PS

 +13      ;on list

           IF $GET(DDBLNA(6))]""

               IF $DATA(@DDBLST@("APSA",DDBSA))

                   GOTO PS

 +14       IF DDBLNA>0

               DO SAVEDDB^DDBR2(DDBLST,DDBLN)

               DO WP^DDBR2(.DDBLNA)

PS         DO PSR^DDBR0(1)

 +1        QUIT 

 +2       ;

VERS22(XXY,XXZ) ; this is modified code from SHOWMSG^HLCSRPT1.

 +1       ; Each node, ^tmp($j,"message",record_ien), invokes this code

 +2       ; to compile a 'virtual w-p document' when a message is browsed.

 +3        IF $DATA(^HLMA(XXY,"MSH",0))

               Begin DoDot:1

 +4                SET ^TMP($JOB,"MESSAGE",XXY,0)=^HLMA(XXY,"MSH",0)

 +5                SET YY1=$PIECE(^HLMA(XXY,"MSH",0),U,3)

                   SET YY2=$PIECE(^HLMA(XXY,"MSH",0),U,4)

               End DoDot:1

 +6       IF '$TEST

               SET ^TMP($JOB,"MESSAGE",XXY,0)="^^1^1"

               SET (YY1,YY2)=1

 +7        SET XLINE=^HLMA(XXY,0)

 +8        SET LINE="Record #: "_XXY_"                    "

           SET LINE=$EXTRACT(LINE,1,30)

 +9        SET LINE=LINE_"Message #: "_$PIECE(XLINE,U,2)

 +10       SET ^TMP($JOB,"MESSAGE",XXY,1,0)=LINE

 +11       SET DTE=$PIECE(XLINE,U,1)

           IF $PIECE($GET(^HL(772,DTE,0)),U,1)'=""

               SET DTE=$PIECE(^HL(772,DTE,0),U,1)

               SET DTE=$EXTRACT(DTE,4,7)_$EXTRACT(DTE,2,3)_"."_$PIECE(DTE,".",2)_"      "

 +12       IF $DATA(^HLMA(XXY,"S"))

               IF $PIECE(^HLMA(XXY,"S"),U,1)'=""

                   SET DTP=$PIECE(^HLMA(XXY,"S"),U,1)

                   SET DTP=$EXTRACT(DTP,4,7)_$EXTRACT(DTP,2,3)_"."_$PIECE(DTP,".",2)

 +13      IF '$TEST

               SET DTP=" "

 +14       SET LINE="D/T Entered: "_DTE

           SET LINE=$EXTRACT(LINE,1,30)_"D/T Processed: "_DTP

 +15       SET ^TMP($JOB,"MESSAGE",XXY,2,0)=LINE

           KILL DTE,DTP

 +16       SET LINE="Logical Link: "

           IF $PIECE(XLINE,U,7)'=""

               IF ($GET(^HLCS(870,$PIECE(XLINE,U,7),0)))

                   SET LINE=LINE_$PIECE(^HLCS(870,$PIECE(XLINE,U,7),0),U,1)

 +17       SET LINE=LINE_"                "

           SET LINE=$EXTRACT(LINE,1,30)

 +18       SET LINE=LINE_"Ack To MSG#: "

           IF $PIECE(XLINE,U,6)'=""

               IF $GET(^HLMA($PIECE(XLINE,U,6),0))

                   SET LINE=LINE_$PIECE(^HLMA($PIECE(XLINE,U,6),0),U,2)

 +19       SET ^TMP($JOB,"MESSAGE",XXY,3,0)=LINE

 +20       SET DTS=""

           IF $PIECE($GET(^HLMA(XXY,"P")),U,2)'=""

               SET DTS=$PIECE(^HLMA(XXY,"P"),U,2)

               SET DTS=$EXTRACT(DTS,4,7)_$EXTRACT(DTS,2,3)_"."_$PIECE(DTS,".",2)

 +21       SET LINE="D/T STATUS: "_DTS_"                 "

           SET LINE=$EXTRACT(LINE,1,30)

           SET LINE=LINE_"STATUS: "

 +22       IF $PIECE(^HLMA(XXY,"P"),U,2)'=""

               IF ($GET(^HL(771.6,+$PIECE(^HLMA(XXY,"P"),U,1),0)))

                   SET LINE=LINE_$PIECE(^HL(771.6,+$PIECE(^HLMA(XXY,"P"),U,1),0),U,1)

 +23       SET ^TMP($JOB,"MESSAGE",XXY,4,0)=LINE

           KILL DTS

 +24       SET LINE="ERR MSG: "

           IF $PIECE(^HLMA(XXY,"P"),U,3)'=""

               SET LINE=LINE_$EXTRACT($PIECE(^HLMA(XXY,"P"),U,3),1,20)

 +25       SET LINE=LINE_"                      "

           SET LINE=$EXTRACT(LINE,1,30)_"ERR TYPE: "

 +26       IF $PIECE(^HLMA(XXY,"P"),U,4)'=""

               IF ($DATA(^HL(771.7,+$PIECE(^HLMA(XXY,"P"),U,4),0)))

                   SET LINE=LINE_$PIECE(^HL(771.7,+$PIECE(^HLMA(XXY,"P"),U,4),0),U,1)

 +27       SET ^TMP($JOB,"MESSAGE",XXY,5,0)=LINE

 +28       SET LINE="Sending Appl: "

           IF $PIECE(XLINE,U,11)'=""

               IF ($DATA(^HL(771,$PIECE(XLINE,U,11),0)))

                   SET LINE=LINE_$PIECE(^HL(771,$PIECE(XLINE,U,11),0),U,1)

 +29       SET ^TMP($JOB,"MESSAGE",XXY,6,0)=LINE

 +30       SET LINE="Receiving Appl: "

           IF $PIECE(XLINE,U,12)'=""

               IF ($DATA(^HL(771,$PIECE(XLINE,U,12),0)))

                   SET LINE=LINE_$PIECE(^HL(771,$PIECE(XLINE,U,12),0),U,1)

 +31       SET ^TMP($JOB,"MESSAGE",XXY,7,0)=LINE

 +32       SET LINE="Message Type: "