source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCHLRR.m@ 1705

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

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1SCMCHLRR ;BP/DJB - PCMM HL7 Rejects - Resubmit ; 3/6/00 12:14pm
2 ;;5.3;Scheduling;**210,224,272**;AUG 13, 1993
3 ;
4EN(SCLIM) ;Entry point for retransmitting "M"arked messages
5 ;
6 ;Input:
7 ; SCLIM - maximum messages allowed per batch passed by reference
8 ;
9 ;Output: none
10 ;
11 Q:'$D(SCLIM)
12 ;
13 NEW DFN,SCDELETE,VARPTR
14 NEW MSGCNT,SCFAC,SCSEQ
15 ;
16 ;Send notification msg if new HL7 reject transmissions received
17 D NOTIFY^SCMCHLM
18 ;
19 ;Initialize variables needed by GENERATE^SCMCHLG
20 S SCFAC=+$P($$SITE^VASITE(),"^",3) ;..Facility number
21 S MSGCNT=0 ;..........................Message count
22 ;
23 ;Loop thru PCMM HL7 TRANSMISSION LOG and resubmit items
24 D LOOP
25 ;
26EXIT ;
27 Q
28 ;
29 ;
30LOOP ;Loop thru PCMM HL7 TRANSMISSION LOG file and find every entry
31 ;with STATUS="M", and re-transmit.
32 ;
33 NEW TRANI
34 S TRANI=0
35 F S TRANI=$O(^SCPT(404.471,"ASTAT","M",TRANI)) Q:'TRANI!(SCLIM<1) D
36 . N WORK S (WORK,VARPTR)=$P($G(^SCPT(404.471,+TRANI,0)),U,7)
37 . I '$G(WORK) D GETDATA(TRANI) ;..Get DFN,VARPTR,SCDELETE
38 . ;alb/rpm - Missing ZPC segment messages will not retransmit.
39 . ; Clear the entry by setting status to "RT".
40 . I VARPTR="" D STATUS(TRANI,"RT") Q
41 . D RETRAN ;.......................Re-transmit message
42 Q
43GETDATA(TRANI) ;Get DFN & VARPTR from PCMM HL7 TRANSMISSION LOG file
44 ; Input:
45 ; TRANI - IEN to file PCMM HL7 TRANSMISSION LOG file (#404.471)
46 ;Output:
47 ; DFN - Patient IEN
48 ; VARPTR - Variable pointer to 404.43 (ex: "2404;SCPT(404.43,")
49 ; SCDELETE - Flag to process a delete
50 ;
51 NEW IDI,IDLONG,ND,PTPI
52 ;
53 ;Initialize return variables
54 S (DFN,VARPTR)=""
55 S SCDELETE=0
56 ;
57 S IDI=$O(^SCPT(404.471,TRANI,"ZPC","C",0)) Q:'IDI
58 S ND=$G(^SCPT(404.49,IDI,0)) ;............PCMM HL7 ID zero node
59 S IDLONG=$P(ND,U,1) ;.....................Get long form of ID
60 ;alb/rpm;Patch 224;Fix DFN retrieval to prevent missing PID/EVN segments
61 S DFN=$P($G(^SCPT(404.471,TRANI,0)),U,2) Q:'DFN
62 S PTPI=$P(IDLONG,"-",1) ;.................File 404.43 IEN
63 Q:'PTPI
64 I '$D(^SCPT(404.43,PTPI)) S SCDELETE=1 ;..Flag to process a delete
65 S VARPTR=PTPI_";SCPT(404.43," ;...........Create event pointer
66 Q
67 ;
68RETRAN ;Re-transmit messages.
69 ;
70 NEW PT,PTPI,RESULT,XMITARRY
71 NEW HL,HLECH,HLEID,HLFS,HLQ
72 ;
73 ;Initialize array
74 S XMITARRY="^TMP(""PCMM"",""HL7"","_$J_")" ;..Segments
75 KILL @XMITARRY
76 ;
77 ;Get pointer to sending event
78 S HLEID=$$HLEID^SCMCHL()
79 I 'HLEID D Q
80 . Q:$D(ZTQUEUED)
81 . W "Unable to initialize HL7 variables - protocol not found"
82 ;
83 ;Initialize HL7 variables
84 D INIT^HLFNC2(HLEID,.HL)
85 I $G(WORK) S RESULT=$$BUILD^SCMCHLP(VARPTR,.HL,.XMITARRY,$G(TRANI)) D GEN Q
86 I $O(HL(""))="" W:'$D(ZTQUEUED) $P(HL,"^",2) Q
87 ;
88 ;Build segment array
89 I $G(SCDELETE) D I 1 ;....................Process a deletion
90 . S PTPI=$P(VARPTR,";",1)
91 . D PTPD^SCMCHLB2(PTPI)
92 E D I +RESULT<0 W $P(RESULT,"^",2) Q ;..Process a normal entry
93 . S RESULT=$$BUILD^SCMCHLB(VARPTR,.HL,.XMITARRY)
94 . I +RESULT<0,'$D(ZTQUEUED) W $P(RESULT,"^",2)
95 ;
96 ;Generate message
97GEN S RESULT=$$GENERATE^SCMCHLG()
98 ;
99 KILL @XMITARRY
100 Q:'$G(RESULT) ;No messages generated
101 D STATUS(TRANI,"RT") ;..Change STATUS to RT
102 W:'$D(ZTQUEUED) !,"Message re-transmitted..."
103 Q
104 ;
105STATUS(TRANI,STATUS) ;Update STATUS field in PCMM HL7 TRANSMISSION LOG file.
106 ; Input: TRANI - IEN of PCM HL7 TRANSMISSION LOG file
107 ; STATUS - A=Accepted, M=Marked for re-transmit, RJ=Rejected
108 ;
109 NEW SCERR,SCFDA,SCIENS
110 Q:'$G(TRANI)
111 Q:($G(STATUS)']"")
112 S SCIENS=TRANI_","
113 S SCFDA(404.471,SCIENS,.04)=STATUS ;..Status
114 D FILE^DIE("I","SCFDA","SCERR")
115 Q
116 ;
117AUTO(SCLIM) ;Auto retransmit messages that have not received an ACK.
118 ;Check all messages with a STATUS of "Transmitted" and see if
119 ;they've received an ACK. Then compare their transmit date to the
120 ;date in PCMM PARAMETER file HL7 TRANSMIT PERIOD field.
121 ;
122 ;Input:
123 ; SCLIM - maximum messages allowed to transmit passed by reference
124 ;
125 ;Output: none
126 ;
127 Q:'$D(SCLIM)
128 ;
129 NEW DAYSMAX,DAYSDIFF,ND,TODAY,TRANDT,TRANI
130 NEW DFN,SCDELETE,VARPTR
131 NEW MSGCNT,SCFAC,SCSEQ
132 ;
133 ;Initialize variables needed by GENERATE^SCMCHLG
134 S SCFAC=+$P($$SITE^VASITE(),"^",3) ;..Facility number
135 S MSGCNT=0 ;..........................Message count
136 ;
137 S TODAY=$$DT^XLFDT()
138 ;Get max days from HL7 PARAMETER file
139 S DAYSMAX=$P($G(^SCTM(404.44,1,1)),U,6)
140 I DAYSMAX="" S DAYSMAX=7 ;Default of 7 days
141 ;
142 S TRANI=0
143 F S TRANI=$O(^SCPT(404.471,"ASTAT","T",TRANI)) Q:'TRANI!(SCLIM<1) D
144 . S ND=$G(^SCPT(404.471,TRANI,0))
145 . Q:$P(ND,U,5) ;........ACK already received
146 . S TRANDT=$P(ND,U,3) ;..Date Transmitted
147 . ;
148 . ;Get number of days between Today and Transmit Date.
149 . S DAYSDIFF=$$FMDIFF^XLFDT(TODAY,TRANDT,1)
150 . ;
151 . ;Quit if required number of days hasn't passed
152 . Q:(DAYSDIFF<DAYSMAX)
153 . ;
154 . D GETDATA(TRANI) Q:VARPTR="" ;..Get DFN,VARPTR,SCDELETE
155 . N WORK S WORK=$P($G(^SCPT(404.471,+TRANI,0)),U,7)
156 . D RETRAN ;.......................Re-transmit message
157 Q
Note: See TracBrowser for help on using the repository browser.