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"
Q
;
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 Oct 16, 2024@17:57:49 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
