source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBFHLX1.m@ 1800

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

initial load of WorldVistAEHR

File size: 5.9 KB
Line 
1FBFHLX1 ;WOIFO/SAB-TRANSMIT HL7 MESSAGES TO FPPS (CON'T) ;9/9/2003
2 ;;3.5;FEE BASIS;**61**;JULY 18, 2003
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6CHKACK ; check for acknowledgements
7 ; input - none
8 ; output
9 ; FBCNT("ACKT") - count of previously transmitted invoices w/o ack
10 ; FBCNT("ACKA") - count of these that were accepted
11 ; FBCNT("ACKR") - count of these that were rejected
12 ; FBCNT("ACKW") - count of these that are still waiting for ack
13 ; ^TMP($J,"FBNA",invoice number)="" - list waiting for ack
14 ; update file 163.5
15 N FBAAIN,FBMSGID,FBQDA,FBQY,FBSTATUS,FBX
16 ;
17 ; initialize
18 K ^TMP($J,"FBNA")
19 F FBX="ACKA","ACKR","ACKW" S FBCNT(FBX)=0
20 ;
21 ; loop thru transmitted (not yet acknowledged entries)
22 S FBQDA=0 F S FBQDA=$O(^FBHL(163.5,"AC",1,FBQDA)) Q:'FBQDA D
23 . S FBQY=$G(^FBHL(163.5,FBQDA,0))
24 . S FBAAIN=$P(FBQY,U)
25 . Q:FBAAIN="" ; invalid invoice number
26 . S FBMSGID=$P(FBQY,U,4)
27 . Q:FBMSGID=""
28 . ;
29 . S FBSTATUS=$$MSGSTAT^HLUTIL(FBMSGID)
30 . ;
31 . I $P(FBSTATUS,U)=3 D Q
32 . . N FBFDA
33 . . S FBFDA(163.5,FBQDA_",",2)="2" ; set status = acknowledged
34 . . S FBFDA(163.5,FBQDA_",",8)="A" ; set ACK FLAG = ACCEPTED
35 . . S FBFDA(163.5,FBQDA_",",9)=$P(FBSTATUS,U,2) ; set ACK DATE/TIME
36 . . I $D(FBFDA) D FILE^DIE("","FBFDA")
37 . . S FBCNT("ACKA")=FBCNT("ACKA")+1
38 . ;
39 . I $P(FBSTATUS,U)=4 D Q
40 . . N FBFDA,FBTXT
41 . . S FBFDA(163.5,FBQDA_",",2)="2" ; set status = acknowledged
42 . . S FBFDA(163.5,FBQDA_",",8)="R" ; set ACK FLAG = rejected
43 . . S FBFDA(163.5,FBQDA_",",9)=$P(FBSTATUS,U,2) ; set ACK DATE/TIME
44 . . S FBFDA(163.5,FBQDA_",",10)="N" ; rej status = not reported
45 . . I $D(FBFDA) D FILE^DIE("","FBFDA")
46 . . S FBTXT(1)=$P(FBSTATUS,U,3)
47 . . I FBTXT(1)]"" D WP^DIE(163.5,FBQDA_",",11,"","FBTXT") ; error msg
48 . . S FBCNT("ACKR")=FBCNT("ACKR")+1
49 . ;
50 . ; don't report not acknowledged unless it is last entry for invoice
51 . Q:$$LAST^FBFHLU($P(FBQY,U))'=FBQDA
52 . ;
53 . ; last entry for invoice was not acknowledged yet
54 . S ^TMP($J,"FBNA",FBAAIN)=""
55 . S FBCNT("ACKW")=FBCNT("ACKW")+1
56 ;
57 S FBCNT("ACKT")=FBCNT("ACKA")+FBCNT("ACKR")+FBCNT("ACKW")
58 ;
59 Q
60 ;
61SUMMSG ; Summary Message (build and send)
62 ; input
63 ; ^TMP($J,"FBE",invoice number,seq number)=error text
64 ; ^TMP($J,"FBW",invoice number,seq number)=warning text
65 ; ^TMP($J,"FBNA",invoice number)="" for invoices not acknowledged
66 ; ^TMP($J,"FBX",seq number)=message text so far
67 ; FBXL = last line used in ^TMP($J,"FBX",seq number)
68 ; FBXMIT("START") = start process, FileMan date/time
69 ; FBXMIT("ACK") = start check for acks, FileMan date/time
70 ; FBXMIT("SEND") = start transmit, FileMan date/time
71 ; FBXMIT("END") = end process, FileMan date/time
72 ; FBCNT("PENDT")= count of pending invoices that were transmitted
73 ; FBCNT("PENDE")= count of pending invoices that had exception
74 ; FBCNT("ACKT") = count of previously transmitted invoices w/o ack
75 ; FBCNT("ACKA") = count of these that were accepted
76 ; FBCNT("ACKR") = count of these that were rejected
77 ; FBCNT("ACKW") = count of these that are still waiting for ack
78 ; output
79 ; ^TMP($J,"FBX",
80 ; mail message
81 ;
82 N XMDUZ,XMSUB,XMTEXT,XMY,XMZ
83 ;
84 ; add header text
85 S ^TMP($J,"FBX",1)=$$FMTE^XLFDT(FBXMIT("START"))_" Process Started."
86 S ^TMP($J,"FBX",2)=$$FMTE^XLFDT(FBXMIT("ACK"))_" Check transmitted messages for acknowledgement..."
87 S ^TMP($J,"FBX",3)=" "_FBCNT("ACKT")_" previously transmitted messages w/o ack."
88 S ^TMP($J,"FBX",4)=" "_FBCNT("ACKA")_" of these were accepted."
89 S ^TMP($J,"FBX",5)=" "_FBCNT("ACKR")_" of these were rejected."
90 S ^TMP($J,"FBX",6)=" "_FBCNT("ACKW")_" of these still waiting for ack."
91 S ^TMP($J,"FBX",7)=$$FMTE^XLFDT(FBXMIT("SEND"))_" Transmit pending invoices..."
92 S ^TMP($J,"FBX",8)=" "_FBCNT("PENDT")_" transmitted."
93 S ^TMP($J,"FBX",9)=" "_FBCNT("PENDE")_" not transmitted due to exception."
94 S ^TMP($J,"FBX",10)=$$FMTE^XLFDT(FBXMIT("END"))_" Process Complete."
95 I $D(ZTSTOP) S ^TMP($J,"FBX",11)=" Process (task) stopped due to user request."
96 ;
97 ; List Exceptions
98 I FBCNT("PENDE")>0 D
99 . N FBAAIN,FBL,FBX
100 . D PTXT(.FBXL," ")
101 . D PTXT(.FBXL,"List of Exceptions during Transmit of Pending Invoices")
102 . S FBAAIN="" F S FBAAIN=$O(^TMP($J,"FBE",FBAAIN)) Q:FBAAIN="" D
103 . . D PTXT(.FBXL,"Invoice: "_FBAAIN)
104 . . S FBL=0 F S FBL=$O(^TMP($J,"FBE",FBAAIN,FBL)) Q:'FBL D
105 . . . S FBX=$G(^TMP($J,"FBE",FBAAIN,FBL))
106 . . . I FBX]"" D PTXT(.FBXL," "_FBX)
107 ;
108 ; List Invoices Waiting for Ack
109 I FBCNT("ACKW")>0 D
110 . N FBAAIN
111 . D PTXT(.FBXL," ")
112 . D PTXT(.FBXL,"List of Invoices Waiting for Acknowledgement")
113 . S FBAAIN="" F S FBAAIN=$O(^TMP($J,"FBW",FBAAIN)) Q:FBAAIN="" D
114 . . D PTXT(.FBXL,"Invoice: "_FBAAIN)
115 ;
116 ; Report Rejected Acks
117 I $D(^FBHL(163.5,"ARS","N")) D
118 . N FBAAIN,FBFDA,FBI,FBQDA,FBTXT,FBWP,FBX
119 . D PTXT(.FBXL," ")
120 . D PTXT(.FBXL,"List of Rejected Invoices that have not been reported.")
121 . S FBQDA=0 F S FBQDA=$O(^FBHL(163.5,"ARS","N",FBQDA)) Q:'FBQDA D
122 . . S FBQY=$G(^FBHL(163.5,FBQDA,0))
123 . . S FBAAIN=$P(FBQY,U)
124 . . D PTXT(.FBXL,"Invoice: "_FBAAIN)
125 . . ;
126 . . K FBWP
127 . . S FBX=$$GET1^DIQ(163.5,FBQDA_",",11,"","FBWP")
128 . . S FBI=0 F S FBI=$O(FBWP(FBI)) Q:'FBI D
129 . . . S FBTXT=FBWP(FBI)
130 . . . D PTXT(.FBXL," "_FBTXT)
131 . . ;
132 . . K FBFDA
133 . . S FBFDA(163,FBQDA_",",10)="R" ; set reject status = reported
134 . . I $D(FBFDA) D FILE^DIE("","FBFDA")
135 ;
136 D PTXT(.FBXL," ")
137 D PTXT(.FBXL,"END OF SUMMARY MESSAGE")
138 ;
139 ; send message
140 S XMSUB="FEE BASIS FPPS Transmit "_$$FMTE^XLFDT(FBXMIT("START"),"DF")
141 S XMDUZ="FEE BASIS"
142 S XMY("G.FEE")=""
143 S XMTEXT="^TMP($J,""FBX"","
144 D ^XMD
145 Q
146 ;
147PTXT(FBXL,FBTXT) ; Post line of text in global array for summary message
148 ; input
149 ; FBXL - last line number used, passed by reference
150 ; FBTXT - line of text
151 ; output
152 ; FBXL - increments value by 1
153 ; ^TMP($J,"FBX",input line+1)=text
154 ;
155 S FBXL=FBXL+1
156 S ^TMP($J,"FBX",FBXL)=FBTXT
157 ;
158 Q
159 ;
160 ;FBFHLX1
Note: See TracBrowser for help on using the repository browser.