Routine: HLCSRPT5

HLCSRPT5 ;OIFO-O/LJA - Error Listing code ;3/18/02 10:19

 ;;1.6;HEALTH LEVEL SEVEN;**85**;Oct 13, 1995

ERRRPT ; Format a report line (Moved here by HL*1.6*85 from HLCSRPT2)

 N PROCDT ;HL*1.6*85

 S HLCSY=""

 S HLCSRNO=HLCSJ,SPACE20="                    "

 I VERS22'="" D

 .S HLCSRNO="$.%$CREF$^TMP($J,""MESSAGE"","_HLCSRNO_")$CREF$^"_HLCSRNO_"$.%"

 .S Y=$L(HLCSJ),X=$E(SPACE20,1,13-Y) S HLCSRNO=HLCSRNO_X K X,Y ;HL*1.6*85

 E  S HLCSRNO=HLCSRNO_SPACE20 S HLCSRNO=$E(HLCSRNO,1,13) ;HL*1.6*85

 S HLCSY=HLCSRNO_" "

 ; Major HL*1.6*85 modifications begin here (to print date/time)

 ; Just add Processed Date/Time to message ID field cow bird fashion

 S HLCSMX=$P(HLCSX,U,2)

 N PROCDT

 S PROCDT=$$PROCDT(+HLCSJ)

 S PROCDT=$$DTORTM(ERRDTB,ERRDTE,PROCDT)

 S PROCDT=$S(PROCDT]"":PROCDT,1:" ") ; Can't be null!! (subscript error)

 I $L(HLCSMX)<17 D

 .  S HLCSMX=$E(HLCSMX_SPACE20,1,16)_" "_PROCDT

 S HLCSMID=HLCSMX_SPACE25 S HLCSMID=$E(HLCSMID,1,25)_" "

 ;End HL*1.6*85 modifications

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

 S HLCSY=HLCSY_HLCSMID_" "

 S HLCSY=HLCSY_$E(HLCSLNK_SPACE20,1,10)_" "

 S HLCSY=HLCSY_HLCSEVN_" "

 S HLCSTYP=$P(HLCSX,U,3) S:HLCSTYP="O" HLCSTYP="OT" S:HLCSTYP="I" HLCSTYP="IN"

 S HLCSY=HLCSY_$E(HLCSTYP_SPACE20,1,2)_" "

 S HLCSSRVR=$P(HLCSX,U,11) I HLCSSRVR'="",($D(^HL(771,HLCSSRVR,0))) S HLCSSRVR=$P(^HL(771,HLCSSRVR,0),U,1)

 S HLCSY=HLCSY_$E(HLCSSRVR_SPACE20,1,8)_" "

 S HLCSCLNT=$P(HLCSX,U,12) I HLCSCLNT'="",($D(^HL(771,HLCSCLNT,0))) S HLCSCLNT=$P(^HL(771,HLCSCLNT,0),U,1)

 S HLCSY=HLCSY_$E(HLCSCLNT_SPACE20,1,8)

 S HLCSER1=HLCSER1_SPACE80,HLCSER1=$E(HLCSER1,1,39)_" "

 S HLCSERMS=HLCSERMS_SPACE80,HLCSERMS=$E(HLCSERMS,1,39)

 S HLCSLN=HLCSLN+1

 I VERS22="" S HLCSY=HLCSY_" "_HLCSER1_HLCSERMS

 D INFO ;HL*1.6*85

 S ^TMP("TMPLOG",$J,PROCDT,+HLCSJ)=HLCSY

 I VERS22'="" S ^TMP($J,"MESSAGE",HLCSJ)="$XC$^D VERS22^HLCSRPT2("_HLCSJ_","_HLCSPTR_")$XC$^MESSAGE"

PROCDT(IEN773) ; Return 773'S processing date (1st), or if not available

 ; return the 772 creation date/time. ;HL*1.6*85

 N PROCDT

 S PROCDT=$P($G(^HLMA(+IEN773,"S")),U) QUIT:PROCDT?7N.E PROCDT ;->

 QUIT $P($G(^HL(772,+$G(^HLMA(+IEN773,0)),0)),U)

DTORTM(DTB,DTE,PDT) ; Show date or time?

 QUIT $S($E(DTB,1,7)=$E(DTE,1,7):$$TM(PDT),1:$$DT(PDT))

TM(PDT) ; Show the 5 character hh:mm time

 QUIT $E($P($$FMTE^XLFDT(+PDT),"@",2),1,5)

DT(PDT) ; Show the 8 character mm/dd/yy date

 QUIT $E(PDT,4,5)_"/"_$E(PDT,6,7)_"/"_$E(PDT,2,3)

INFO ; If TYPEINFO=Error Type, reset HLCSY. (Called from ERRRPT^HLCSRPT4) - HL*1.6*85

 ; HLCSJ,HLCSRNO -- req

 N DATA,ET,ETYPE,I7717

 QUIT:TYPEINFO'=2  ;->

 S DATA=$P(HLCSY,HLCSRNO_" ",2,99) QUIT:DATA']""  ;->

 S I7717=$P($G(^HLMA(+HLCSJ,"P")),U,4)

 S ETYPE=$P($G(^HL(771.7,+I7717,0)),U)

 I ETYPE="Duplicate Message" D

 .  S ET=$P(^HLMA(+HLCSJ,"P"),U,3) ; Free text

 .  QUIT:ET'["Duplicate with ien"  ;->

 .  S ET=$P(ET,"Duplicate with ien ",2) QUIT:ET'?1.N  ;->

 .  S ETYPE="Duplicate w/# "_ET

 I ETYPE="Incorrect Message Received" D

 .  S ET=$P(^HLMA(+HLCSJ,"P"),U,3) ; Free text

 .  QUIT:ET'["Incorrect msg. Id"  ;->

 .  S ETYPE="Incorrect message ID"

 S $E(DATA,39,999)=$E(ETYPE_SPACE80,1,41)

 S HLCSY=HLCSRNO_" "_DATA

 QUIT

MSGEVN(IEN773,PCE) ; Return MSG~EVN piece (PCE)...

 N DEL,MSGEVN,MSH

 S MSH=$G(^HLMA(+IEN773,"MSH",1,0)) QUIT:MSH']"" "   " ;->

 S DEL=$E(MSH,4) QUIT:DEL']"" "   " ;->

 S MSGEVN=$P(MSH,DEL,9) QUIT:MSGEVN'?1.E1"~"1.E "   " ;->

 QUIT $P(MSGEVN,"~",+PCE)

EOR ;HLCSRPT5 - Error Listing code ;3/18/02 10:19

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSRPT5   3543     printed  Apr 23, 2025@18:11:31                                                                                                                                                                                                    Page 2

HLCSRPT5  ;OIFO-O/LJA - Error Listing code ;3/18/02 10:19

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

 +2       ;

ERRRPT    ; Format a report line (Moved here by HL*1.6*85 from HLCSRPT2)

 +1       ;HL*1.6*85

           NEW PROCDT

 +2        SET HLCSY=""

 +3        SET HLCSRNO=HLCSJ

           SET SPACE20="                    "

 +4        IF VERS22'=""

               Begin DoDot:1

 +5                SET HLCSRNO="$.%$CREF$^TMP($J,""MESSAGE"","_HLCSRNO_")$CREF$^"_HLCSRNO_"$.%"

 +6       ;HL*1.6*85

                   SET Y=$LENGTH(HLCSJ)

                   SET X=$EXTRACT(SPACE20,1,13-Y)

                   SET HLCSRNO=HLCSRNO_X

                   KILL X,Y

               End DoDot:1

 +7       ;HL*1.6*85

          IF '$TEST

               SET HLCSRNO=HLCSRNO_SPACE20

               SET HLCSRNO=$EXTRACT(HLCSRNO,1,13)

 +8        SET HLCSY=HLCSRNO_" "

 +9       ;

 +10      ; Major HL*1.6*85 modifications begin here (to print date/time)

 +11      ; Just add Processed Date/Time to message ID field cow bird fashion

 +12       SET HLCSMX=$PIECE(HLCSX,U,2)

 +13       NEW PROCDT

 +14       SET PROCDT=$$PROCDT(+HLCSJ)

 +15       SET PROCDT=$$DTORTM(ERRDTB,ERRDTE,PROCDT)

 +16      ; Can't be null!! (subscript error)

           SET PROCDT=$SELECT(PROCDT]"":PROCDT,1:" ")

 +17       IF $LENGTH(HLCSMX)<17

               Begin DoDot:1

 +18               SET HLCSMX=$EXTRACT(HLCSMX_SPACE20,1,16)_" "_PROCDT

               End DoDot:1

 +19       SET HLCSMID=HLCSMX_SPACE25

           SET HLCSMID=$EXTRACT(HLCSMID,1,25)_" "

 +20      ;End HL*1.6*85 modifications

 +21      ;

 +22       SET HLCSPTR=$PIECE(^HLMA(HLCSJ,0),"^",1)

 +23       SET HLCSY=HLCSY_HLCSMID_" "

 +24       SET HLCSY=HLCSY_$EXTRACT(HLCSLNK_SPACE20,1,10)_" "

 +25       SET HLCSY=HLCSY_HLCSEVN_" "

 +26       SET HLCSTYP=$PIECE(HLCSX,U,3)

           if HLCSTYP="O"

               SET HLCSTYP="OT"

           if HLCSTYP="I"

               SET HLCSTYP="IN"

 +27       SET HLCSY=HLCSY_$EXTRACT(HLCSTYP_SPACE20,1,2)_" "

 +28       SET HLCSSRVR=$PIECE(HLCSX,U,11)

           IF HLCSSRVR'=""

               IF ($DATA(^HL(771,HLCSSRVR,0)))

                   SET HLCSSRVR=$PIECE(^HL(771,HLCSSRVR,0),U,1)

 +29       SET HLCSY=HLCSY_$EXTRACT(HLCSSRVR_SPACE20,1,8)_" "

 +30       SET HLCSCLNT=$PIECE(HLCSX,U,12)

           IF HLCSCLNT'=""

               IF ($DATA(^HL(771,HLCSCLNT,0)))

                   SET HLCSCLNT=$PIECE(^HL(771,HLCSCLNT,0),U,1)

 +31       SET HLCSY=HLCSY_$EXTRACT(HLCSCLNT_SPACE20,1,8)

 +32       SET HLCSER1=HLCSER1_SPACE80

           SET HLCSER1=$EXTRACT(HLCSER1,1,39)_" "

 +33       SET HLCSERMS=HLCSERMS_SPACE80

           SET HLCSERMS=$EXTRACT(HLCSERMS,1,39)

 +34       SET HLCSLN=HLCSLN+1

 +35       IF VERS22=""

               SET HLCSY=HLCSY_" "_HLCSER1_HLCSERMS

 +36      ;HL*1.6*85

           DO INFO

 +37       SET ^TMP("TMPLOG",$JOB,PROCDT,+HLCSJ)=HLCSY

 +38       IF VERS22'=""

               SET ^TMP($JOB,"MESSAGE",HLCSJ)="$XC$^D VERS22^HLCSRPT2("_HLCSJ_","_HLCSPTR_")$XC$^MESSAGE"

 +39       QUIT

 +40      ;

PROCDT(IEN773) ; Return 773'S processing date (1st), or if not available

 +1       ; return the 772 creation date/time. ;HL*1.6*85

 +2        NEW PROCDT

 +3       ;->

           SET PROCDT=$PIECE($GET(^HLMA(+IEN773,"S")),U)

           if PROCDT?7N.E

               QUIT PROCDT

 +4        QUIT $PIECE($GET(^HL(772,+$GET(^HLMA(+IEN773,0)),0)),U)

 +5       ;

DTORTM(DTB,DTE,PDT) ; Show date or time?

 +1        QUIT $SELECT($EXTRACT(DTB,1,7)=$EXTRACT(DTE,1,7):$$TM(PDT),1:$$DT(PDT))

 +2       ;

TM(PDT)   ; Show the 5 character hh:mm time

 +1        QUIT $EXTRACT($PIECE($$FMTE^XLFDT(+PDT),"@",2),1,5)

 +2       ;

DT(PDT)   ; Show the 8 character mm/dd/yy date

 +1        QUIT $EXTRACT(PDT,4,5)_"/"_$EXTRACT(PDT,6,7)_"/"_$EXTRACT(PDT,2,3)

 +2       ;

INFO      ; If TYPEINFO=Error Type, reset HLCSY. (Called from ERRRPT^HLCSRPT4) - HL*1.6*85

 +1       ; HLCSJ,HLCSRNO -- req

 +2        NEW DATA,ET,ETYPE,I7717

 +3       ;->

           if TYPEINFO'=2

               QUIT

 +4       ;->

           SET DATA=$PIECE(HLCSY,HLCSRNO_" ",2,99)

           if DATA']""

               QUIT

 +5        SET I7717=$PIECE($GET(^HLMA(+HLCSJ,"P")),U,4)

 +6        SET ETYPE=$PIECE($GET(^HL(771.7,+I7717,0)),U)

 +7        IF ETYPE="Duplicate Message"

               Begin DoDot:1

 +8       ; Free text

                   SET ET=$PIECE(^HLMA(+HLCSJ,"P"),U,3)

 +9       ;->

                   if ET'["Duplicate with ien"

                       QUIT

 +10      ;->

                   SET ET=$PIECE(ET,"Duplicate with ien ",2)

                   if ET'?1.N

                       QUIT

 +11               SET ETYPE="Duplicate w/# "_ET

               End DoDot:1

 +12       IF ETYPE="Incorrect Message Received"

               Begin DoDot:1

 +13      ; Free text

                   SET ET=$PIECE(^HLMA(+HLCSJ,"P"),U,3)

 +14      ;->

                   if ET'["Incorrect msg. Id"

                       QUIT

 +15               SET ETYPE="Incorrect message ID"

               End DoDot:1

 +16       SET $EXTRACT(DATA,39,999)=$EXTRACT(ETYPE_SPACE80,1,41)

 +17       SET HLCSY=HLCSRNO_" "_DATA

 +18       QUIT

 +19      ;

MSGEVN(IEN773,PCE) ; Return MSG~EVN piece (PCE)...

 +1        NEW DEL,MSGEVN,MSH

 +2       ;->

           SET MSH=$GET(^HLMA(+IEN773,"MSH",1,0))

           if MSH']""

               QUIT "   "

 +3       ;->

           SET DEL=$EXTRACT(MSH,4)

           if DEL']""

               QUIT "   "

 +4       ;->

           SET MSGEVN=$PIECE(MSH,DEL,9)

           if MSGEVN'?1.E1"~"1.E

               QUIT "   "

 +5        QUIT $PIECE(MSGEVN,"~",+PCE)

 +6       ;

EOR       ;HLCSRPT5 - Error Listing code ;3/18/02 10:19

HLCSRPT5.m