SCMCHLR9 ;ALB/KCL - PCMM HL7 Reject Transmission Report Con't; 22-FEB-2000
;;5.3;Scheduling;**210,284,297**;AUG 13,1993
;
PRINT ; Description: Used to print report.
;
;Init variables
N CRT,QUIT,PAGE,SUBSCRPT,SCARRAY
K SCARRAY
S SCARRAY="SCERRSRT"
K ^TMP(SCARRAY,$J)
S (QUIT,PAGE)=0
S CRT=$S($E(IOST,1,2)="C-":1,1:0)
;
;Get PCMM HL7 Transmission Log errors
D GET^SCMCHLR2(SCARRAY,$G(SCRP("BEGIN")),$G(SCRP("END")),$G(SCRP("EPS")),$G(SCRP("SORT")))
;
U IO
I CRT,PAGE=0 W @IOF
S PAGE=1
D HEADER
D PRINTERR($G(SCRP("SORT")),$G(SCRP("EPS")))
I CRT,'QUIT D PAUSE
I $D(ZTQUEUED) S ZTREQ="@"
D ^%ZISC
;
K ^TMP(SCARRAY,$J)
Q
;
LINE(LINE) ;
; Description: Prints a line. First prints header if at end of page.
;
I CRT,($Y>(IOSL-4)) D
.D PAUSE
.Q:QUIT
.W @IOF
.D HEADER
.W LINE
;
E I ('CRT),($Y>(IOSL-2)) D
.W @IOF
.D HEADER
.W LINE
;
E W !,LINE
Q
;
;
;
N LINE,X
I $Y>1 W @IOF
W !,"PCMM Transmission Error Report"
W ?33,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")
W ?70,"Page ",PAGE
S PAGE=PAGE+1
W !
S X=$G(SCRP("SORT"))
W !,"Sort By: "_$S(X="N":"Patient Name",X="D":"Date Error Received",X="P":"Provider",1:"Unknown")
I SCRP("BEGIN") D
.W ?40,"Date Range: "_$$FMTE^XLFDT(SCRP("BEGIN"))_" to "_$$FMTE^XLFDT($G(SCRP("END")))
E D
.W ?40,"Date Range: "_$$DRMSG^SCMCHLR1
S X=$G(SCRP("EPS"))
W !,"Error Processing Status: "_$S(X=1:"New",X=2:"Checked",X=3:"New/Checked",1:"Unknown")
W ?40,$$MRKMSG^SCMCHLR1
W !
;
W !?2,"Patient Name",?23,"PATID",?31,"Date Rec",?42,"Provider",?63,"Type",?70,"EP Status"
S $P(LINE,"-",80)="-"
W !,LINE,!
Q
;
;
PAUSE ; Description: Screen pause. Sets QUIT=1 if user decides to quit.
;
N DIR,X,Y
F Q:$Y>(IOSL-3) W !
S DIR(0)="E"
D ^DIR
I ('(+Y))!$D(DIRUT) S QUIT=1
Q
;
;
PRINTERR(SCSORTBY,SCEPS) ; Description: Print list of errors.
;
; Input:
; SCSORTBY - Sort by criteria
; N -> Patient Name
; D -> Date/Time Ack Received
; P -> Provider
; SCEPS - Error processing status
;
; Output: None
;
N DFN,SCSUB,SCLINE,SCTXT,SCTLIEN,SCERIEN,SCTLOG,SCPROV,SCTYPE
;
;Loop thru sort array by pat name, OR date ack rec'd, OR provider
S SCSUB=$S(SCSORTBY="N":"",SCSORTBY="P":"",1:0)
F S SCSUB=$O(^TMP("SCERRSRT",$J,SCSORTBY,SCSUB)) Q:SCSUB="" D Q:QUIT
.;loop through PCMM HL7 Transmission Log ien(s)
.S SCTLIEN=0
.F S SCTLIEN=$O(^TMP("SCERRSRT",$J,SCSORTBY,SCSUB,SCTLIEN)) Q:'SCTLIEN D Q:QUIT
..;loop through Error Code subfile ien(s)
..S SCERIEN=0
..F S SCERIEN=$O(^TMP("SCERRSRT",$J,SCSORTBY,SCSUB,SCTLIEN,SCERIEN)) Q:'SCERIEN D Q:QUIT
...;
...;get data for PCMM HL7 Trans Log entry
...I $$GETLOG^SCMCHLA(SCTLIEN,SCERIEN,.SCTLOG) D
....;
....;set retransmit flag in line
....S SCLINE=$S($G(SCTLOG("STATUS"))="M":"*",1:" ")
....;
....;set patient name in line
....S SCTXT=$$LOWER^VALM1($S($G(SCTLOG("WORK")):"WORKLOAD",$G(SCTLOG("DFN")):$P($G(^DPT(SCTLOG("DFN"),0)),"^",1),1:"UNKNOWN"))
....S SCLINE=SCLINE_" "_$$LJ(SCTXT,18)
....;
....;set patient id in line
....S DFN=+SCTLOG("DFN") D PID^VADPT
....;D SET(SCARY,SCLINE,VA("BID"),SCCOL("PATID"),SCWID("PATID"),SCNUM,,,,.SCCNT)
....S SCLINE=SCLINE_" "_$$LJ(VA("BID"),5)
....;
....;set date ack received in line
....S SCTXT=$$LOWER^VALM1($S($G(SCTLOG("ACK DT/TM")):$E($$FDATE^VALM1(SCTLOG("ACK DT/TM")),1,8),1:"UNKNOWN"))
....S SCLINE=SCLINE_" "_$$LJ(SCTXT,8)
....;
....;set provider in display in line
....K SCHL
....S SCPROV=""
....;only get provider if ZPC segment error
....I $G(SCTLOG("WORK")) S SCPROV=$P($G(^SCPT(404.471,SCTLIEN,0)),U,8)
....I $G(SCTLOG("ERR","SEG"))="ZPC" D
.....I $$GETHL7ID^SCMCHLA2($G(SCTLOG("ERR","ZPCID")),.SCHL)
.....S SCPTR=$P($G(SCHL("HL7ID")),"-",2)
.....I '$G(SCTLOG("WORK")) S SCPROV=$P($G(^SCTM(404.52,+$G(SCPTR),0)),"^",3)
....S SCTXT=$$LOWER^VALM1($S($G(SCPROV)'="":$$EXTERNAL^DILFD(404.52,.03,,SCPROV),1:"N/A"))
....S SCLINE=SCLINE_" "_$$LJ(SCTXT,18)
....;
....;set provider type in line
....S SCTYPE=$P($G(SCHL("HL7ID")),"-",4)
....S SCTXT=$S(SCTYPE'="":SCTYPE,1:"N/A")
....S SCLINE=SCLINE_" "_$$LJ(SCTXT,4)
....;
....;set error processing status in line
....S SCTXT=$$LOWER^VALM1($S($G(SCTLOG("ERR","EPS")):$$EXTERNAL^DILFD(404.47142,.06,,SCTLOG("ERR","EPS")),1:"UNKNOWN"))
....S SCLINE=SCLINE_" "_$$LJ(SCTXT,7)
....;
....D LINE(SCLINE) Q:QUIT
....;
....;set error code/desc in line
....I $$GETEC^SCMCHLA2($G(SCTLOG("ERR","CODE")),.SCERR)
....S SCTXT=" Error: "_$S($G(SCERR("CODE"))'="":SCERR("CODE")_"-"_$G(SCERR("SHORT")),1:$$LOWER^VALM1("UNKNOWN"))
....S SCLINE=$$LJ(SCTXT,80)
....D LINE(SCLINE) Q:QUIT
;
Q
;
;
LJ(STRING,LENGTH) ;
;
Q $$LJ^XLFSTR($E(STRING,1,LENGTH),LENGTH)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCHLR9 4913 printed Nov 22, 2024@17:50:37 Page 2
SCMCHLR9 ;ALB/KCL - PCMM HL7 Reject Transmission Report Con't; 22-FEB-2000
+1 ;;5.3;Scheduling;**210,284,297**;AUG 13,1993
+2 ;
PRINT ; Description: Used to print report.
+1 ;
+2 ;Init variables
+3 NEW CRT,QUIT,PAGE,SUBSCRPT,SCARRAY
+4 KILL SCARRAY
+5 SET SCARRAY="SCERRSRT"
+6 KILL ^TMP(SCARRAY,$JOB)
+7 SET (QUIT,PAGE)=0
+8 SET CRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)
+9 ;
+10 ;Get PCMM HL7 Transmission Log errors
+11 DO GET^SCMCHLR2(SCARRAY,$GET(SCRP("BEGIN")),$GET(SCRP("END")),$GET(SCRP("EPS")),$GET(SCRP("SORT")))
+12 ;
+13 USE IO
+14 IF CRT
IF PAGE=0
WRITE @IOF
+15 SET PAGE=1
+16 DO HEADER
+17 DO PRINTERR($GET(SCRP("SORT")),$GET(SCRP("EPS")))
+18 IF CRT
IF 'QUIT
DO PAUSE
+19 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+20 DO ^%ZISC
+21 ;
+22 KILL ^TMP(SCARRAY,$JOB)
+23 QUIT
+24 ;
LINE(LINE) ;
+1 ; Description: Prints a line. First prints header if at end of page.
+2 ;
+3 IF CRT
IF ($Y>(IOSL-4))
Begin DoDot:1
+4 DO PAUSE
+5 if QUIT
QUIT
+6 WRITE @IOF
+7 DO HEADER
+8 WRITE LINE
End DoDot:1
+9 ;
+10 IF '$TEST
IF ('CRT)
IF ($Y>(IOSL-2))
Begin DoDot:1
+11 WRITE @IOF
+12 DO HEADER
+13 WRITE LINE
End DoDot:1
+14 ;
+15 IF '$TEST
WRITE !,LINE
+16 QUIT
+17 ;
+18 ;
+1 ;
+2 NEW LINE,X
+3 IF $Y>1
WRITE @IOF
+4 WRITE !,"PCMM Transmission Error Report"
+5 WRITE ?33,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")
+6 WRITE ?70,"Page ",PAGE
+7 SET PAGE=PAGE+1
+8 WRITE !
+9 SET X=$GET(SCRP("SORT"))
+10 WRITE !,"Sort By: "_$SELECT(X="N":"Patient Name",X="D":"Date Error Received",X="P":"Provider",1:"Unknown")
+11 IF SCRP("BEGIN")
Begin DoDot:1
+12 WRITE ?40,"Date Range: "_$$FMTE^XLFDT(SCRP("BEGIN"))_" to "_$$FMTE^XLFDT($GET(SCRP("END")))
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 WRITE ?40,"Date Range: "_$$DRMSG^SCMCHLR1
End DoDot:1
+15 SET X=$GET(SCRP("EPS"))
+16 WRITE !,"Error Processing Status: "_$SELECT(X=1:"New",X=2:"Checked",X=3:"New/Checked",1:"Unknown")
+17 WRITE ?40,$$MRKMSG^SCMCHLR1
+18 WRITE !
+19 ;
+20 WRITE !?2,"Patient Name",?23,"PATID",?31,"Date Rec",?42,"Provider",?63,"Type",?70,"EP Status"
+21 SET $PIECE(LINE,"-",80)="-"
+22 WRITE !,LINE,!
+23 QUIT
+24 ;
+25 ;
PAUSE ; Description: Screen pause. Sets QUIT=1 if user decides to quit.
+1 ;
+2 NEW DIR,X,Y
+3 FOR
if $Y>(IOSL-3)
QUIT
WRITE !
+4 SET DIR(0)="E"
+5 DO ^DIR
+6 IF ('(+Y))!$DATA(DIRUT)
SET QUIT=1
+7 QUIT
+8 ;
+9 ;
PRINTERR(SCSORTBY,SCEPS) ; Description: Print list of errors.
+1 ;
+2 ; Input:
+3 ; SCSORTBY - Sort by criteria
+4 ; N -> Patient Name
+5 ; D -> Date/Time Ack Received
+6 ; P -> Provider
+7 ; SCEPS - Error processing status
+8 ;
+9 ; Output: None
+10 ;
+11 NEW DFN,SCSUB,SCLINE,SCTXT,SCTLIEN,SCERIEN,SCTLOG,SCPROV,SCTYPE
+12 ;
+13 ;Loop thru sort array by pat name, OR date ack rec'd, OR provider
+14 SET SCSUB=$SELECT(SCSORTBY="N":"",SCSORTBY="P":"",1:0)
+15 FOR
SET SCSUB=$ORDER(^TMP("SCERRSRT",$JOB,SCSORTBY,SCSUB))
if SCSUB=""
QUIT
Begin DoDot:1
+16 ;loop through PCMM HL7 Transmission Log ien(s)
+17 SET SCTLIEN=0
+18 FOR
SET SCTLIEN=$ORDER(^TMP("SCERRSRT",$JOB,SCSORTBY,SCSUB,SCTLIEN))
if 'SCTLIEN
QUIT
Begin DoDot:2
+19 ;loop through Error Code subfile ien(s)
+20 SET SCERIEN=0
+21 FOR
SET SCERIEN=$ORDER(^TMP("SCERRSRT",$JOB,SCSORTBY,SCSUB,SCTLIEN,SCERIEN))
if 'SCERIEN
QUIT
Begin DoDot:3
+22 ;
+23 ;get data for PCMM HL7 Trans Log entry
+24 IF $$GETLOG^SCMCHLA(SCTLIEN,SCERIEN,.SCTLOG)
Begin DoDot:4
+25 ;
+26 ;set retransmit flag in line
+27 SET SCLINE=$SELECT($GET(SCTLOG("STATUS"))="M":"*",1:" ")
+28 ;
+29 ;set patient name in line
+30 SET SCTXT=$$LOWER^VALM1($SELECT($GET(SCTLOG("WORK")):"WORKLOAD",$GET(SCTLOG("DFN")):$PIECE($GET(^DPT(SCTLOG("DFN"),0)),"^",1),1:"UNKNOWN"))
+31 SET SCLINE=SCLINE_" "_$$LJ(SCTXT,18)
+32 ;
+33 ;set patient id in line
+34 SET DFN=+SCTLOG("DFN")
DO PID^VADPT
+35 ;D SET(SCARY,SCLINE,VA("BID"),SCCOL("PATID"),SCWID("PATID"),SCNUM,,,,.SCCNT)
+36 SET SCLINE=SCLINE_" "_$$LJ(VA("BID"),5)
+37 ;
+38 ;set date ack received in line
+39 SET SCTXT=$$LOWER^VALM1($SELECT($GET(SCTLOG("ACK DT/TM")):$EXTRACT($$FDATE^VALM1(SCTLOG("ACK DT/TM")),1,8),1:"UNKNOWN"))
+40 SET SCLINE=SCLINE_" "_$$LJ(SCTXT,8)
+41 ;
+42 ;set provider in display in line
+43 KILL SCHL
+44 SET SCPROV=""
+45 ;only get provider if ZPC segment error
+46 IF $GET(SCTLOG("WORK"))
SET SCPROV=$PIECE($GET(^SCPT(404.471,SCTLIEN,0)),U,8)
+47 IF $GET(SCTLOG("ERR","SEG"))="ZPC"
Begin DoDot:5
+48 IF $$GETHL7ID^SCMCHLA2($GET(SCTLOG("ERR","ZPCID")),.SCHL)
+49 SET SCPTR=$PIECE($GET(SCHL("HL7ID")),"-",2)
+50 IF '$GET(SCTLOG("WORK"))
SET SCPROV=$PIECE($GET(^SCTM(404.52,+$GET(SCPTR),0)),"^",3)
End DoDot:5
+51 SET SCTXT=$$LOWER^VALM1($SELECT($GET(SCPROV)'="":$$EXTERNAL^DILFD(404.52,.03,,SCPROV),1:"N/A"))
+52 SET SCLINE=SCLINE_" "_$$LJ(SCTXT,18)
+53 ;
+54 ;set provider type in line
+55 SET SCTYPE=$PIECE($GET(SCHL("HL7ID")),"-",4)
+56 SET SCTXT=$SELECT(SCTYPE'="":SCTYPE,1:"N/A")
+57 SET SCLINE=SCLINE_" "_$$LJ(SCTXT,4)
+58 ;
+59 ;set error processing status in line
+60 SET SCTXT=$$LOWER^VALM1($SELECT($GET(SCTLOG("ERR","EPS")):$$EXTERNAL^DILFD(404.47142,.06,,SCTLOG("ERR","EPS")),1:"UNKNOWN"))
+61 SET SCLINE=SCLINE_" "_$$LJ(SCTXT,7)
+62 ;
+63 DO LINE(SCLINE)
if QUIT
QUIT
+64 ;
+65 ;set error code/desc in line
+66 IF $$GETEC^SCMCHLA2($GET(SCTLOG("ERR","CODE")),.SCERR)
+67 SET SCTXT=" Error: "_$SELECT($GET(SCERR("CODE"))'="":SCERR("CODE")_"-"_$GET(SCERR("SHORT")),1:$$LOWER^VALM1("UNKNOWN"))
+68 SET SCLINE=$$LJ(SCTXT,80)
+69 DO LINE(SCLINE)
if QUIT
QUIT
End DoDot:4
End DoDot:3
if QUIT
QUIT
End DoDot:2
if QUIT
QUIT
End DoDot:1
if QUIT
QUIT
+70 ;
+71 QUIT
+72 ;
+73 ;
LJ(STRING,LENGTH) ;
+1 ;
+2 QUIT $$LJ^XLFSTR($EXTRACT(STRING,1,LENGTH),LENGTH)
