source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPFLMT4.m@ 1672

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1DGPFLMT4 ;ALB/RBS - PRF TRANSMIT VIEW MESSAGE BUILD LIST AREA ; 10/19/06 10:59am
2 ;;5.3;Registration;**650**;Aug 13, 1993;Build 3
3 ;
4 ;no direct entry
5 QUIT
6 ;
7 ;
8EN(DGARY,DGPFIEN,DGCNT) ;Entry point to build error detail list area.
9 ;
10 ; Input:
11 ; DGARY - subscript name for temp global
12 ; DGPFIEN - IEN of record
13 ;
14 ; Output:
15 ; DGCNT - number of display lines, pass by reference (VALMCNT)
16 ;
17 ;quit if required input paramater not passed
18 Q:'$G(DGPFIEN)
19 ;
20 S:$G(DGARY)="" DGARY="DGPFVDET"
21 ;
22 N DGAIEN ;assignment ien
23 N DGCOD ;error code
24 N DGLI ;dialog text line number
25 N DGPFA ;assignment array
26 N DGPFAH ;assignment history data array
27 N DGPFL ;HL7 transmission log data array
28 N DGLINE ;line counter
29 N DGSUB ;subscript var
30 N DGPFL ;HL7 transmission log data array
31 N DIERR ;var returned from BLD^DIALOG
32 N DGTBL ;error code table array
33 N DGTEMP ;array returned from BLD^DIALOG with error msg text
34 ;
35 ;init variables
36 S DGLINE=0
37 K DGPFA,DGPFAH,DGPFL,DGTBL
38 ;
39 ;retrieve HL7 log data
40 Q:'$$GETLOG^DGPFHLL(DGPFIEN,.DGPFL)
41 Q:'+DGPFL("ASGNHIST")
42 ;retrieve assignment history data to get PRF Assignment ien
43 Q:'$$GETHIST^DGPFAAH(+DGPFL("ASGNHIST"),.DGPFAH)
44 S DGAIEN=$P($G(DGPFAH("ASSIGN")),U,1)
45 Q:'DGAIEN
46 Q:'$$GETASGN^DGPFAA(DGAIEN,.DGPFA)
47 ;
48 ;set Error Received D/T
49 S DGLINE=DGLINE+1
50 D SET^DGPFLMT1(DGARY,DGLINE,"Error Received D/T: "_$$FDTTM^VALM1($P($G(DGPFL("ACKDT")),U,1)),10,,,.DGCNT)
51 ;
52 ;set Message Control ID
53 S DGLINE=DGLINE+1
54 D SET^DGPFLMT1(DGARY,DGLINE,"Message Control ID: "_$P($G(DGPFL("MSGID")),U,2),10,,,.DGCNT)
55 ;
56 ;set Flag Name
57 S DGLINE=DGLINE+1
58 D SET^DGPFLMT1(DGARY,DGLINE,"Flag Name: "_$P($G(DGPFA("FLAG")),U,2),19,,,.DGCNT)
59 ;
60 ;set Owner Site
61 S DGLINE=DGLINE+1
62 D SET^DGPFLMT1(DGARY,DGLINE,"Owner Site: "_$P($G(DGPFA("OWNER")),U,2),18,,,.DGCNT)
63 ;
64 ;set Assignment Transmitted To
65 S DGLINE=DGLINE+1
66 D SET^DGPFLMT1(DGARY,DGLINE,"Assignment Transmitted To: "_$P($G(DGPFL("SITE")),U,2),3,,,.DGCNT)
67 ;
68 ;set Assignment Transmission Date/Time
69 S DGLINE=DGLINE+1
70 D SET^DGPFLMT1(DGARY,DGLINE,"Assignment Transmission D/T: "_$$FDTTM^VALM1($P($G(DGPFL("TRANSDT")),U,1)),1,,,.DGCNT)
71 ;
72 ;set blank line
73 S DGLINE=DGLINE+1
74 D SET^DGPFLMT1(DGARY,DGLINE," ",1,,,.DGCNT)
75 ;
76 ;set Rejection Reason
77 S DGLINE=DGLINE+1
78 D SET^DGPFLMT1(DGARY,DGLINE,"Rejection Reason(s): ",1,,,.DGCNT)
79 ;
80 ;set underline
81 S DGLINE=DGLINE+1
82 D SET^DGPFLMT1(DGARY,DGLINE,"--------------------",1,,,.DGCNT)
83 ;
84 ;set no error code message
85 I $O(DGPFL("ERROR",""))="" D Q
86 . S DGLINE=DGLINE+1
87 . D SET^DGPFLMT1(DGARY,DGLINE,">>> There are no Rejection Reason codes on file.",1,,,.DGCNT)
88 ;
89 ;load error code table
90 D BLDVA086^DGPFHLU3(.DGTBL)
91 ;
92 ;loop and set error msg text lines
93 S DGSUB=0
94 F S DGSUB=$O(DGPFL("ERROR",DGSUB)) Q:'DGSUB D
95 . Q:$G(DGPFL("ERROR",DGSUB))']""
96 . K DGTEMP
97 . S DGCOD=DGPFL("ERROR",DGSUB)
98 . ;assume numeric error code is a DIALOG
99 . I DGCOD?1N.N D BLD^DIALOG(DGCOD,"","","DGTEMP")
100 . I $D(DGTEMP) D FORMAT(.DGTEMP,70)
101 . ;if not a DIALOG, then is it a table entry?
102 . I '$D(DGTEMP),DGCOD]"",$D(DGTBL(DGCOD,"DESC")) S DGTEMP(1)=DGTBL(DGCOD,"DESC") D FORMAT(.DGTEMP,70)
103 . ;not a DIALOG or table entry - then error is unknown
104 . I '$D(DGTEMP) S DGTEMP(1)="Unknown Error code: '"_DGCOD_"'"
105 . ;
106 . F DGLI=1:1 Q:'$D(DGTEMP(DGLI)) S DGLINE=DGLINE+1 D
107 . . I DGLI=1 D SET^DGPFLMT1(DGARY,DGLINE,DGSUB_". "_DGTEMP(DGLI),1,,,.DGCNT)
108 . . E D SET^DGPFLMT1(DGARY,DGLINE," "_DGTEMP(DGLI),1,,,.DGCNT)
109 ;
110 Q
111 ;
112FORMAT(DGTEXT,DGMAX) ;format text lines to length
113 ;This procedure formats an array of text lines to be less than a
114 ;given maximum length.
115 ;
116 ; Supported DBIA: #10104 - $$TRIM^XLFSTR Kernel api to trim spaces
117 ;
118 ; Input:
119 ; DGTEXT - (required) array of text lines (passed by reference)
120 ; DGMAX - (optional) maximum line length (default = 75)
121 ;
122 ; Output:
123 ; DGTEXT - re-formatted array of text lines
124 ;
125 Q:'$D(DGTEXT)
126 ;
127 N DGARRY ;temp array for re-formatting
128 N DGI ;loop var
129 N DGLN ;line counter var
130 N DGMORE ;leftover words
131 N DGNEWLN ;new text line
132 N DGOLDLN ;original text line
133 N DGSPOT ;position of text line to break at
134 ;
135 S:'+$G(DGMAX) DGMAX=75
136 ;
137 S (DGI,DGLN,DGMORE,DGNEWLN,DGOLDLN,DGSPOT)=""
138 ;
139 F DGI=1:1 S DGOLDLN=$G(DGTEXT(DGI)) Q:'$L(DGOLDLN)&'$L(DGMORE) D
140 . I DGOLDLN'?1.P S DGOLDLN=$$TRIM^XLFSTR(DGOLDLN)
141 . I $L(DGOLDLN)'>DGMAX,'$L(DGMORE) D Q
142 . . S DGLN=DGLN+1,DGARRY(DGLN)=DGOLDLN
143 . ;
144 . I $L(DGMORE),(DGOLDLN?1.P!('$L(DGOLDLN))) D Q
145 . . S DGLN=DGLN+1,DGARRY(DGLN)=DGMORE,DGMORE=""
146 . . S:$L(DGOLDLN) DGLN=DGLN+1,DGARRY(DGLN)=DGOLDLN
147 . ;
148 . S:$L(DGMORE) DGOLDLN=DGMORE_" "_DGOLDLN,DGMORE=""
149 . ;
150 . I $L(DGOLDLN)>DGMAX F D Q:'$L(DGOLDLN)
151 . . S DGSPOT=$L($E(DGOLDLN,1,DGMAX)," ")
152 . . S DGNEWLN=$P(DGOLDLN," ",1,$S(DGSPOT>1:DGSPOT-1,1:1))
153 . . S DGLN=DGLN+1,DGARRY(DGLN)=DGNEWLN,DGNEWLN=""
154 . . S DGMORE=$P(DGOLDLN," ",$S(DGSPOT>1:DGSPOT,1:DGSPOT+1),$L(DGOLDLN," "))
155 . . I $L(DGMORE)>DGMAX S DGOLDLN=DGMORE,DGMORE=""
156 . . E S DGOLDLN=""
157 . E D
158 . . S DGLN=DGLN+1,DGARRY(DGLN)=DGOLDLN
159 ;
160 I $D(DGARRY) K DGTEXT M DGTEXT=DGARRY
161 Q
Note: See TracBrowser for help on using the repository browser.