source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCHLR9.m@ 1147

Last change on this file since 1147 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1SCMCHLR9 ;ALB/KCL - PCMM HL7 Reject Transmission Report Con't; 22-FEB-2000
2 ;;5.3;Scheduling;**210,284,297**;AUG 13,1993
3 ;
4PRINT ; Description: Used to print report.
5 ;
6 ;Init variables
7 N CRT,QUIT,PAGE,SUBSCRPT,SCARRAY
8 K SCARRAY
9 S SCARRAY="SCERRSRT"
10 K ^TMP(SCARRAY,$J)
11 S (QUIT,PAGE)=0
12 S CRT=$S($E(IOST,1,2)="C-":1,1:0)
13 ;
14 ;Get PCMM HL7 Transmission Log errors
15 D GET^SCMCHLR2(SCARRAY,$G(SCRP("BEGIN")),$G(SCRP("END")),$G(SCRP("EPS")),$G(SCRP("SORT")))
16 ;
17 U IO
18 I CRT,PAGE=0 W @IOF
19 S PAGE=1
20 D HEADER
21 D PRINTERR($G(SCRP("SORT")),$G(SCRP("EPS")))
22 I CRT,'QUIT D PAUSE
23 I $D(ZTQUEUED) S ZTREQ="@"
24 D ^%ZISC
25 ;
26 K ^TMP(SCARRAY,$J)
27 Q
28 ;
29LINE(LINE) ;
30 ; Description: Prints a line. First prints header if at end of page.
31 ;
32 I CRT,($Y>(IOSL-4)) D
33 .D PAUSE
34 .Q:QUIT
35 .W @IOF
36 .D HEADER
37 .W LINE
38 ;
39 E I ('CRT),($Y>(IOSL-2)) D
40 .W @IOF
41 .D HEADER
42 .W LINE
43 ;
44 E W !,LINE
45 Q
46 ;
47 ;
48HEADER ; Description: Prints the report header.
49 ;
50 N LINE,X
51 I $Y>1 W @IOF
52 W !,"PCMM Transmission Error Report"
53 W ?33,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")
54 W ?70,"Page ",PAGE
55 S PAGE=PAGE+1
56 W !
57 S X=$G(SCRP("SORT"))
58 W !,"Sort By: "_$S(X="N":"Patient Name",X="D":"Date Error Received",X="P":"Provider",1:"Unknown")
59 I SCRP("BEGIN") D
60 .W ?40,"Date Range: "_$$FMTE^XLFDT(SCRP("BEGIN"))_" to "_$$FMTE^XLFDT($G(SCRP("END")))
61 E D
62 .W ?40,"Date Range: "_$$DRMSG^SCMCHLR1
63 S X=$G(SCRP("EPS"))
64 W !,"Error Processing Status: "_$S(X=1:"New",X=2:"Checked",X=3:"New/Checked",1:"Unknown")
65 W ?40,$$MRKMSG^SCMCHLR1
66 W !
67 ;
68 W !?2,"Patient Name",?23,"PATID",?31,"Date Rec",?42,"Provider",?63,"Type",?70,"EP Status"
69 S $P(LINE,"-",80)="-"
70 W !,LINE,!
71 Q
72 ;
73 ;
74PAUSE ; Description: Screen pause. Sets QUIT=1 if user decides to quit.
75 ;
76 N DIR,X,Y
77 F Q:$Y>(IOSL-3) W !
78 S DIR(0)="E"
79 D ^DIR
80 I ('(+Y))!$D(DIRUT) S QUIT=1
81 Q
82 ;
83 ;
84PRINTERR(SCSORTBY,SCEPS) ; Description: Print list of errors.
85 ;
86 ; Input:
87 ; SCSORTBY - Sort by criteria
88 ; N -> Patient Name
89 ; D -> Date/Time Ack Received
90 ; P -> Provider
91 ; SCEPS - Error processing status
92 ;
93 ; Output: None
94 ;
95 N DFN,SCSUB,SCLINE,SCTXT,SCTLIEN,SCERIEN,SCTLOG,SCPROV,SCTYPE
96 ;
97 ;Loop thru sort array by pat name, OR date ack rec'd, OR provider
98 S SCSUB=$S(SCSORTBY="N":"",SCSORTBY="P":"",1:0)
99 F S SCSUB=$O(^TMP("SCERRSRT",$J,SCSORTBY,SCSUB)) Q:SCSUB="" D Q:QUIT
100 .;loop through PCMM HL7 Transmission Log ien(s)
101 .S SCTLIEN=0
102 .F S SCTLIEN=$O(^TMP("SCERRSRT",$J,SCSORTBY,SCSUB,SCTLIEN)) Q:'SCTLIEN D Q:QUIT
103 ..;loop through Error Code subfile ien(s)
104 ..S SCERIEN=0
105 ..F S SCERIEN=$O(^TMP("SCERRSRT",$J,SCSORTBY,SCSUB,SCTLIEN,SCERIEN)) Q:'SCERIEN D Q:QUIT
106 ...;
107 ...;get data for PCMM HL7 Trans Log entry
108 ...I $$GETLOG^SCMCHLA(SCTLIEN,SCERIEN,.SCTLOG) D
109 ....;
110 ....;set retransmit flag in line
111 ....S SCLINE=$S($G(SCTLOG("STATUS"))="M":"*",1:" ")
112 ....;
113 ....;set patient name in line
114 ....S SCTXT=$$LOWER^VALM1($S($G(SCTLOG("WORK")):"WORKLOAD",$G(SCTLOG("DFN")):$P($G(^DPT(SCTLOG("DFN"),0)),"^",1),1:"UNKNOWN"))
115 ....S SCLINE=SCLINE_" "_$$LJ(SCTXT,18)
116 ....;
117 ....;set patient id in line
118 ....S DFN=+SCTLOG("DFN") D PID^VADPT
119 ....;D SET(SCARY,SCLINE,VA("BID"),SCCOL("PATID"),SCWID("PATID"),SCNUM,,,,.SCCNT)
120 ....S SCLINE=SCLINE_" "_$$LJ(VA("BID"),5)
121 ....;
122 ....;set date ack received in line
123 ....S SCTXT=$$LOWER^VALM1($S($G(SCTLOG("ACK DT/TM")):$E($$FDATE^VALM1(SCTLOG("ACK DT/TM")),1,8),1:"UNKNOWN"))
124 ....S SCLINE=SCLINE_" "_$$LJ(SCTXT,8)
125 ....;
126 ....;set provider in display in line
127 ....K SCHL
128 ....S SCPROV=""
129 ....;only get provider if ZPC segment error
130 ....I $G(SCTLOG("WORK")) S SCPROV=$P($G(^SCPT(404.471,SCTLIEN,0)),U,8)
131 ....I $G(SCTLOG("ERR","SEG"))="ZPC" D
132 .....I $$GETHL7ID^SCMCHLA2($G(SCTLOG("ERR","ZPCID")),.SCHL)
133 .....S SCPTR=$P($G(SCHL("HL7ID")),"-",2)
134 .....I '$G(SCTLOG("WORK")) S SCPROV=$P($G(^SCTM(404.52,+$G(SCPTR),0)),"^",3)
135 ....S SCTXT=$$LOWER^VALM1($S($G(SCPROV)'="":$$EXTERNAL^DILFD(404.52,.03,,SCPROV),1:"N/A"))
136 ....S SCLINE=SCLINE_" "_$$LJ(SCTXT,18)
137 ....;
138 ....;set provider type in line
139 ....S SCTYPE=$P($G(SCHL("HL7ID")),"-",4)
140 ....S SCTXT=$S(SCTYPE'="":SCTYPE,1:"N/A")
141 ....S SCLINE=SCLINE_" "_$$LJ(SCTXT,4)
142 ....;
143 ....;set error processing status in line
144 ....S SCTXT=$$LOWER^VALM1($S($G(SCTLOG("ERR","EPS")):$$EXTERNAL^DILFD(404.47142,.06,,SCTLOG("ERR","EPS")),1:"UNKNOWN"))
145 ....S SCLINE=SCLINE_" "_$$LJ(SCTXT,7)
146 ....;
147 ....D LINE(SCLINE) Q:QUIT
148 ....;
149 ....;set error code/desc in line
150 ....I $$GETEC^SCMCHLA2($G(SCTLOG("ERR","CODE")),.SCERR)
151 ....S SCTXT=" Error: "_$S($G(SCERR("CODE"))'="":SCERR("CODE")_"-"_$G(SCERR("SHORT")),1:$$LOWER^VALM1("UNKNOWN"))
152 ....S SCLINE=$$LJ(SCTXT,80)
153 ....D LINE(SCLINE) Q:QUIT
154 ;
155 Q
156 ;
157 ;
158LJ(STRING,LENGTH) ;
159 ;
160 Q $$LJ^XLFSTR($E(STRING,1,LENGTH),LENGTH)
Note: See TracBrowser for help on using the repository browser.