SCMCHLR3 ;ALB/KCL - PCMM HL7 Reject Processing - Build List Area con't; 10-JAN-2000
;;5.3;Scheduling;**210,272,505,1015**;AUG 13, 1993;Build 21
;
BLDLIST(SCSORTBY,SCEPS,SCCNT) ; Description: Build list area for for PCMM Transmission errors.
;
; Input:
; SCSORTBY - Sort by criteria
; N -> Patient Name
; D -> Date/Time Ack Received
; P -> Provider
; I -> Institution
; SCEPS - Error processing status
;
; Output:
; SCCNT - Number of lines in the list
;
N DFN,SCSUB,SCTEXT,SCTLIEN,SCERIEN,SCTLOG,SCHL
;
;Init line counter and selection number
S (SCLINE,SCNUM)=0
;
;Quit if unable to determine col/width for caption flds in List Template
Q:'$$CAPFLD(.SCCOL,.SCWID)
;
;Loop thru sort array by pat name, OR date ack rec'd, OR provider, OR Institution
S SCSUB=$S(SCSORTBY="N":"",SCSORTBY="P":"",SCSORTBY="I":"",1:0)
F S SCSUB=$O(^TMP("SCERRSRT",$J,SCSORTBY,SCSUB)) Q:SCSUB="" D
.;loop through PCMM HL7 Transmission Log ien(s)
.S SCTLIEN=0
.F S SCTLIEN=$O(^TMP("SCERRSRT",$J,SCSORTBY,SCSUB,SCTLIEN)) Q:'SCTLIEN D
..;loop through Error Code subfile ien(s)
..S SCERIEN=0
..F S SCERIEN=$O(^TMP("SCERRSRT",$J,SCSORTBY,SCSUB,SCTLIEN,SCERIEN)) Q:'SCERIEN D
...;
...;write dot to screen as list is being built (every 50 lines)
...W:'(SCLINE#50) "."
...;
...;get data for PCMM HL7 Trans Log entry
...I $$GETLOG^SCMCHLA(SCTLIEN,SCERIEN,.SCTLOG) D
....;
....;increment selection number
....S SCNUM=SCNUM+1
....;
....;increment line counter
....S SCLINE=SCLINE+1
....;
....;set selection number in display array
....D SET(SCARY,SCLINE,SCNUM,SCCOL("NUM"),SCWID("NUM"),SCNUM,SCTLIEN,SCTLOG("DFN"),SCERIEN,.SCCNT)
....;
....;set retransmit flag in display array
....S SCTEXT=$S($G(SCTLOG("STATUS"))="M":"*",1:" ")
....D SET(SCARY,SCLINE,SCTEXT,SCCOL("RET"),SCWID("RET"),SCNUM,,,,.SCCNT)
....;set patient name in display array
....S SCTEXT=$$LOWER^VALM1($S($G(SCTLOG("WORK")):"WORKLOAD",$G(SCTLOG("DFN")):$P($G(^DPT(SCTLOG("DFN"),0)),"^",1),1:"UNKNOWN"))
....D SET(SCARY,SCLINE,SCTEXT,SCCOL("PAT"),SCWID("PAT"),SCNUM,,,,.SCCNT)
....;
....;set patient id in display array
....S DFN=+SCTLOG("DFN") D PID^VADPT
....D SET(SCARY,SCLINE,VA("BID"),SCCOL("PATID"),SCWID("PATID"),SCNUM,,,,.SCCNT)
....;
....;set date ack received in display array
....S SCTEXT=$$LOWER^VALM1($S($G(SCTLOG("ACK DT/TM")):$E($$FDATE^VALM1(SCTLOG("ACK DT/TM")),1,8),1:"UNKNOWN"))
....D SET(SCARY,SCLINE,SCTEXT,SCCOL("DTR"),SCWID("DTR"),SCNUM,,,,.SCCNT)
....;
....;set provider in display array
....S SCPROV=""
....K SCHL
....;I workload get provider
....I $G(SCTLOG("WORK")) S SCPROV=$$PROV^SCMCHLP(SCTLOG("WORK"))
....;get provider if ZPC segment error
....I $G(SCTLOG("ERR","SEG"))="ZPC" D
.....I $$GETHL7ID^SCMCHLA2($G(SCTLOG("ERR","ZPCID")),.SCHL)
.....S SCPTR=$P($G(SCHL("HL7ID")),"-",2)
.....S SCPROV=$P($G(^SCTM(404.52,+$G(SCPTR),0)),"^",3)
....S SCTEXT=$$LOWER^VALM1($S($G(SCPROV)'="":$$EXTERNAL^DILFD(404.52,.03,,SCPROV),1:"N/A"))
....D SET(SCARY,SCLINE,SCTEXT,SCCOL("PROV"),SCWID("PROV"),SCNUM,,,,.SCCNT)
....;
....;set provider type in display array
....S SCTYPE=$P($G(SCHL("HL7ID")),"-",4)
....I $G(SCTLOG("WORK")) S SCTYPE="PC"
....S SCTEXT=$S(SCTYPE'="":SCTYPE,1:"N/A")
....D SET(SCARY,SCLINE,SCTEXT,SCCOL("TYPE"),SCWID("TYPE"),SCNUM,,,,.SCCNT)
....;
....;set error processing status in display array
....S SCTEXT=$$LOWER^VALM1($S($G(SCTLOG("ERR","EPS")):$$EXTERNAL^DILFD(404.47142,.06,,SCTLOG("ERR","EPS")),1:"UNKNOWN"))
....D SET(SCARY,SCLINE,SCTEXT,SCCOL("STA"),SCWID("STA"),SCNUM,,,,.SCCNT)
....;
....;set INSTITUTION in display array
....I SCSORTBY="I" D
.....;numeric version of institution SD*5.3*505
.....S SCTEXT=$G(SCSUB)
.....D SET(SCARY,SCLINE,SCTEXT,SCCOL("INST"),SCWID("INST"),SCNUM,,,,.SCCNT)
....;increment line counter
....S SCLINE=SCLINE+1
....;
....;set error code/desc in display array
....I $$GETEC^SCMCHLA2($G(SCTLOG("ERR","CODE")),.SCERR)
....S SCTEXT="Error: "_$S($G(SCERR("CODE"))'="":SCERR("CODE")_" - "_$G(SCERR("SHORT")),1:$$LOWER^VALM1("UNKNOWN"))
....K X S $P(X," ",160)=""
....S SCTEXT=$E(SCTEXT_X,1,150)
....D SET(SCARY,SCLINE,SCTEXT,10,$L(SCTEXT),SCNUM,,,,.SCCNT)
;
Q
;
;
SET(SCARY,SCLINE,SCTEXT,SCCOL,SCWID,SCNUM,SCTLIEN,SCDFN,SCERIEN,SCCNT) ;
; Description: Set display array.
;
; Input:
; SCARY - Global array subscript
; SCLINE - Line number
; SCTEXT - Text
; SCCOL - Column to start at
; SCWID - Column or text width
; SCNUM - Selection number
; SCTLIEN - PCMM HL7 Transmission Log IEN
; SCERIEN - IEN of record in Error Code (#404.47142) multiple
; SCDFN Patient IEN
;
; Output:
; SCCNT - Number of lines in the list
;
N X
S:SCLINE>SCCNT SCCNT=SCLINE
S X=$S($D(^TMP(SCARY,$J,SCLINE,0)):^(0),1:"")
S ^TMP(SCARY,$J,SCLINE,0)=$$SETSTR^VALM1(SCTEXT,X,SCCOL,SCWID)
S ^TMP(SCARY,$J,"IDX",SCLINE,SCNUM)=""
;
;Set special index used in retransmitting patient
I $G(SCTLIEN),$G(SCERIEN) D
.I '$G(SCTLOG("WORK")) Q:'SCDFN
.S ^TMP(SCARY_"IDX",$J,SCNUM)=SCLINE_"^"_SCTLIEN_"^"_SCERIEN
.S ^TMP(SCARY_"IDX",$J,"PT",$S(SCDFN:SCDFN,1:"W"),SCLINE)=SCTLIEN_"^"_SCERIEN
Q
;
;
CAPFLD(SCCOL,SCWID) ; Description: Used to determine column/width of caption fields in the List Template.
;
; Input:
; VALMDDF - Array available at run-time of list template. This array
; is subscripted by caption field name of List Template.
;
; Output:
; Function value: Returns 1 on success, 0 on failure
; SCCOL - array subscripted by abbreviation of caption field name containing the column number where the data/caption starts, pass by reference
; SCWID - array subscripted by abbreviation of caption field name containing the number of charaters the data/caption will use, pass by reference
;
;Quit if VALMDDF array is not defined
Q:'$D(VALMDDF) 0
;
N X
S X=VALMDDF("NUMBER"),SCCOL("NUM")=$P(X,"^",2),SCWID("NUM")=$P(X,"^",3)
S X=VALMDDF("RETRANS"),SCCOL("RET")=$P(X,"^",2),SCWID("RET")=$P(X,"^",3)
S X=VALMDDF("PATIENT"),SCCOL("PAT")=$P(X,"^",2),SCWID("PAT")=$P(X,"^",3)
S X=VALMDDF("PATID"),SCCOL("PATID")=$P(X,"^",2),SCWID("PATID")=$P(X,"^",3)
S X=VALMDDF("DATE"),SCCOL("DTR")=$P(X,"^",2),SCWID("DTR")=$P(X,"^",3)
S X=VALMDDF("PROV"),SCCOL("PROV")=$P(X,"^",2),SCWID("PROV")=$P(X,"^",3)
S X=VALMDDF("TYPE"),SCCOL("TYPE")=$P(X,"^",2),SCWID("TYPE")=$P(X,"^",3)
S X=VALMDDF("STATUS"),SCCOL("STA")=$P(X,"^",2),SCWID("STA")=$P(X,"^",3)
S X=VALMDDF("INST"),SCCOL("INST")=$P(X,"^",2),SCWID("INST")=$P(X,"^",3)
Q 1
SCMCHLR3 ;ALB/KCL - PCMM HL7 Reject Processing - Build List Area con't; 10-JAN-2000
+1 ;;5.3;Scheduling;**210,272,505,1015**;AUG 13, 1993;Build 21
+2 ;
BLDLIST(SCSORTBY,SCEPS,SCCNT) ; Description: Build list area for for PCMM Transmission errors.
+1 ;
+2 ; Input:
+3 ; SCSORTBY - Sort by criteria
+4 ; N -> Patient Name
+5 ; D -> Date/Time Ack Received
+6 ; P -> Provider
+7 ; I -> Institution
+8 ; SCEPS - Error processing status
+9 ;
+10 ; Output:
+11 ; SCCNT - Number of lines in the list
+12 ;
+13 NEW DFN,SCSUB,SCTEXT,SCTLIEN,SCERIEN,SCTLOG,SCHL
+14 ;
+15 ;Init line counter and selection number
+16 SET (SCLINE,SCNUM)=0
+17 ;
+18 ;Quit if unable to determine col/width for caption flds in List Template
+19 IF '$$CAPFLD(.SCCOL,.SCWID)
QUIT
+20 ;
+21 ;Loop thru sort array by pat name, OR date ack rec'd, OR provider, OR Institution
+22 SET SCSUB=$SELECT(SCSORTBY="N":"",SCSORTBY="P":"",SCSORTBY="I":"",1:0)
+23 FOR
SET SCSUB=$ORDER(^TMP("SCERRSRT",$JOB,SCSORTBY,SCSUB))
IF SCSUB=""
QUIT
Begin DoDot:1
+24 ;loop through PCMM HL7 Transmission Log ien(s)
+25 SET SCTLIEN=0
+26 FOR
SET SCTLIEN=$ORDER(^TMP("SCERRSRT",$JOB,SCSORTBY,SCSUB,SCTLIEN))
IF 'SCTLIEN
QUIT
Begin DoDot:2
+27 ;loop through Error Code subfile ien(s)
+28 SET SCERIEN=0
+29 FOR
SET SCERIEN=$ORDER(^TMP("SCERRSRT",$JOB,SCSORTBY,SCSUB,SCTLIEN,SCERIEN))
IF 'SCERIEN
QUIT
Begin DoDot:3
+30 ;
+31 ;write dot to screen as list is being built (every 50 lines)
+32 IF '(SCLINE#50)
WRITE "."
+33 ;
+34 ;get data for PCMM HL7 Trans Log entry
+35 IF $$GETLOG^SCMCHLA(SCTLIEN,SCERIEN,.SCTLOG)
Begin DoDot:4
+36 ;
+37 ;increment selection number
+38 SET SCNUM=SCNUM+1
+39 ;
+40 ;increment line counter
+41 SET SCLINE=SCLINE+1
+42 ;
+43 ;set selection number in display array
+44 DO SET(SCARY,SCLINE,SCNUM,SCCOL("NUM"),SCWID("NUM"),SCNUM,SCTLIEN,SCTLOG("DFN"),SCERIEN,.SCCNT)
+45 ;
+46 ;set retransmit flag in display array
+47 SET SCTEXT=$SELECT($GET(SCTLOG("STATUS"))="M":"*",1:" ")
+48 DO SET(SCARY,SCLINE,SCTEXT,SCCOL("RET"),SCWID("RET"),SCNUM,,,,.SCCNT)
+49 ;set patient name in display array
+50 SET SCTEXT=$$LOWER^VALM1($SELECT($GET(SCTLOG("WORK")):"WORKLOAD",$GET(SCTLOG("DFN")):$PIECE($GET(^DPT(SCTLOG("DFN"),0)),"^",1),1:"UNKNOWN"))
+51 DO SET(SCARY,SCLINE,SCTEXT,SCCOL("PAT"),SCWID("PAT"),SCNUM,,,,.SCCNT)
+52 ;
+53 ;set patient id in display array
+54 SET DFN=+SCTLOG("DFN")
DO PID^VADPT
+55 DO SET(SCARY,SCLINE,VA("BID"),SCCOL("PATID"),SCWID("PATID"),SCNUM,,,,.SCCNT)
+56 ;
+57 ;set date ack received in display array
+58 SET SCTEXT=$$LOWER^VALM1($SELECT($GET(SCTLOG("ACK DT/TM")):$EXTRACT($$FDATE^VALM1(SCTLOG("ACK DT/TM")),1,8),1:"UNKNOWN"))
+59 DO SET(SCARY,SCLINE,SCTEXT,SCCOL("DTR"),SCWID("DTR"),SCNUM,,,,.SCCNT)
+60 ;
+61 ;set provider in display array
+62 SET SCPROV=""
+63 KILL SCHL
+64 ;I workload get provider
+65 IF $GET(SCTLOG("WORK"))
SET SCPROV=$$PROV^SCMCHLP(SCTLOG("WORK"))
+66 ;get provider if ZPC segment error
+67 IF $GET(SCTLOG("ERR","SEG"))="ZPC"
Begin DoDot:5
+68 IF $$GETHL7ID^SCMCHLA2($GET(SCTLOG("ERR","ZPCID")),.SCHL)
+69 SET SCPTR=$PIECE($GET(SCHL("HL7ID")),"-",2)
+70 SET SCPROV=$PIECE($GET(^SCTM(404.52,+$GET(SCPTR),0)),"^",3)
End DoDot:5
+71 SET SCTEXT=$$LOWER^VALM1($SELECT($GET(SCPROV)'="":$$EXTERNAL^DILFD(404.52,.03,,SCPROV),1:"N/A"))
+72 DO SET(SCARY,SCLINE,SCTEXT,SCCOL("PROV"),SCWID("PROV"),SCNUM,,,,.SCCNT)
+73 ;
+74 ;set provider type in display array
+75 SET SCTYPE=$PIECE($GET(SCHL("HL7ID")),"-",4)
+76 IF $GET(SCTLOG("WORK"))
SET SCTYPE="PC"
+77 SET SCTEXT=$SELECT(SCTYPE'="":SCTYPE,1:"N/A")
+78 DO SET(SCARY,SCLINE,SCTEXT,SCCOL("TYPE"),SCWID("TYPE"),SCNUM,,,,.SCCNT)
+79 ;
+80 ;set error processing status in display array
+81 SET SCTEXT=$$LOWER^VALM1($SELECT($GET(SCTLOG("ERR","EPS")):$$EXTERNAL^DILFD(404.47142,.06,,SCTLOG("ERR","EPS")),1:"UNKNOWN"))
+82 DO SET(SCARY,SCLINE,SCTEXT,SCCOL("STA"),SCWID("STA"),SCNUM,,,,.SCCNT)
+83 ;
+84 ;set INSTITUTION in display array
+85 IF SCSORTBY="I"
Begin DoDot:5
+86 ;numeric version of institution SD*5.3*505
+87 SET SCTEXT=$GET(SCSUB)
+88 DO SET(SCARY,SCLINE,SCTEXT,SCCOL("INST"),SCWID("INST"),SCNUM,,,,.SCCNT)
End DoDot:5
+89 ;increment line counter
+90 SET SCLINE=SCLINE+1
+91 ;
+92 ;set error code/desc in display array
+93 IF $$GETEC^SCMCHLA2($GET(SCTLOG("ERR","CODE")),.SCERR)
+94 SET SCTEXT="Error: "_$SELECT($GET(SCERR("CODE"))'="":SCERR("CODE")_" - "_$GET(SCERR("SHORT")),1:$$LOWER^VALM1("UNKNOWN"))
+95 KILL X
SET $PIECE(X," ",160)=""
+96 SET SCTEXT=$EXTRACT(SCTEXT_X,1,150)
+97 DO SET(SCARY,SCLINE,SCTEXT,10,$LENGTH(SCTEXT),SCNUM,,,,.SCCNT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+98 ;
+99 QUIT
+100 ;
+101 ;
SET(SCARY,SCLINE,SCTEXT,SCCOL,SCWID,SCNUM,SCTLIEN,SCDFN,SCERIEN,SCCNT) ;
+1 ; Description: Set display array.
+2 ;
+3 ; Input:
+4 ; SCARY - Global array subscript
+5 ; SCLINE - Line number
+6 ; SCTEXT - Text
+7 ; SCCOL - Column to start at
+8 ; SCWID - Column or text width
+9 ; SCNUM - Selection number
+10 ; SCTLIEN - PCMM HL7 Transmission Log IEN
+11 ; SCERIEN - IEN of record in Error Code (#404.47142) multiple
+12 ; SCDFN Patient IEN
+13 ;
+14 ; Output:
+15 ; SCCNT - Number of lines in the list
+16 ;
+17 NEW X
+18 IF SCLINE>SCCNT
SET SCCNT=SCLINE
+19 SET X=$SELECT($DATA(^TMP(SCARY,$JOB,SCLINE,0)):^(0),1:"")
+20 SET ^TMP(SCARY,$JOB,SCLINE,0)=$$SETSTR^VALM1(SCTEXT,X,SCCOL,SCWID)
+21 SET ^TMP(SCARY,$JOB,"IDX",SCLINE,SCNUM)=""
+22 ;
+23 ;Set special index used in retransmitting patient
+24 IF $GET(SCTLIEN)
IF $GET(SCERIEN)
Begin DoDot:1
+25 IF '$GET(SCTLOG("WORK"))
IF 'SCDFN
QUIT
+26 SET ^TMP(SCARY_"IDX",$JOB,SCNUM)=SCLINE_"^"_SCTLIEN_"^"_SCERIEN
+27 SET ^TMP(SCARY_"IDX",$JOB,"PT",$SELECT(SCDFN:SCDFN,1:"W"),SCLINE)=SCTLIEN_"^"_SCERIEN
End DoDot:1
+28 QUIT
+29 ;
+30 ;
CAPFLD(SCCOL,SCWID) ; Description: Used to determine column/width of caption fields in the List Template.
+1 ;
+2 ; Input:
+3 ; VALMDDF - Array available at run-time of list template. This array
+4 ; is subscripted by caption field name of List Template.
+5 ;
+6 ; Output:
+7 ; Function value: Returns 1 on success, 0 on failure
+8 ; SCCOL - array subscripted by abbreviation of caption field name containing the column number where the data/caption starts, pass by reference
+9 ; SCWID - array subscripted by abbreviation of caption field name containing the number of charaters the data/caption will use, pass by reference
+10 ;
+11 ;Quit if VALMDDF array is not defined
+12 IF '$DATA(VALMDDF)
QUIT 0
+13 ;
+14 NEW X
+15 SET X=VALMDDF("NUMBER")
SET SCCOL("NUM")=$PIECE(X,"^",2)
SET SCWID("NUM")=$PIECE(X,"^",3)
+16 SET X=VALMDDF("RETRANS")
SET SCCOL("RET")=$PIECE(X,"^",2)
SET SCWID("RET")=$PIECE(X,"^",3)
+17 SET X=VALMDDF("PATIENT")
SET SCCOL("PAT")=$PIECE(X,"^",2)
SET SCWID("PAT")=$PIECE(X,"^",3)
+18 SET X=VALMDDF("PATID")
SET SCCOL("PATID")=$PIECE(X,"^",2)
SET SCWID("PATID")=$PIECE(X,"^",3)
+19 SET X=VALMDDF("DATE")
SET SCCOL("DTR")=$PIECE(X,"^",2)
SET SCWID("DTR")=$PIECE(X,"^",3)
+20 SET X=VALMDDF("PROV")
SET SCCOL("PROV")=$PIECE(X,"^",2)
SET SCWID("PROV")=$PIECE(X,"^",3)
+21 SET X=VALMDDF("TYPE")
SET SCCOL("TYPE")=$PIECE(X,"^",2)
SET SCWID("TYPE")=$PIECE(X,"^",3)
+22 SET X=VALMDDF("STATUS")
SET SCCOL("STA")=$PIECE(X,"^",2)
SET SCWID("STA")=$PIECE(X,"^",3)
+23 SET X=VALMDDF("INST")
SET SCCOL("INST")=$PIECE(X,"^",2)
SET SCWID("INST")=$PIECE(X,"^",3)
+24 QUIT 1