source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCDXMSG.m@ 656

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1SCDXMSG ;ALB/JRP - AMB CARE TRANSMISSION BUILDER;06-MAY-1996 ; 12/20/01 4:46pm
2 ;;5.3;Scheduling;**44,56,70,77,85,96,121,128,66,247,245,387,466**;AUG 13, 1993;Build 2
3 ;
4SNDZ00 ;Main entry point for the sending of ADT-Z00 batch messages to
5 ; the National Patient Care Database
6 ;
7 ;Input : None
8 ;Output : None
9 ;
10SD70 ; added w/ patch SD*5.3*70 to reset transmit flags if needed
11 N SDEND,SDSTA D EN^SCDXUTL5
12 ;
13 ;Declare variables
14 N X,X1,X2,%H
15 N XMITPTR,NOACKBY,XMITDATE,SCDXEVNT,MAXBATCH,MAXLINE,BATCHCNT,MSGNUM
16 N LINECNT,MSHLINE,XMITLIST,XMITERR,HL7XMIT,ERROR,IPCNT
17 N HLEID,HL,HLECH,HLFS,HLQ,HLMID,HLMTIEN,HLDT,HLDT1,MSGID,HLRESLT,HLP
18 ;Set message count limit for batch message
19 S MAXBATCH=100
20 ;Set line count limit for batch message Note max 160K char. MM Message
21 S MAXLINE=$P($G(^SD(404.91,1,"AMB")),U,8) S:'MAXLINE MAXLINE=2000
22 ;Initialize global locations
23 S XMITERR="^TMP(""SCDX-XMIT-BLD"","_$J_",""ERRORS"")"
24 S HL7XMIT="^TMP(""HLS"","_$J_")"
25 K @XMITERR,@HL7XMIT
26 ;Get lag time for acks from NPCDB (default to T-LAG)
27 S NOACKBY=+$P($G(^SD(404.91,1,"AMB")),"^",4)
28 S:('NOACKBY) NOACKBY=2
29 ;Determine T-LAG @ 11:59:59 PM
30 S X1=$$DT^XLFDT()
31 S X2=0-NOACKBY
32 S NOACKBY=$$FMADD^XLFDT(X1,X2)_".235959"
33 ;Flag transmissions that haven't been acked by T-LAG for retransmission
34 S XMITDATE=""
35 F S XMITDATE=+$O(^SD(409.73,"AACNOACK",XMITDATE)) Q:(('XMITDATE)!(XMITDATE>NOACKBY)) D
36 .S XMITPTR=""
37 .F S XMITPTR=+$O(^SD(409.73,"AACNOACK",XMITDATE,XMITPTR)) Q:('XMITPTR) D
38 ..;Mark entry with retransmit event (POSTMASTER is causer of event)
39 ..D STREEVNT^SCDXFU01(XMITPTR,0,"",.5)
40 ..;Can no longer receive database credit - delete x-ref and quit
41 ..I +$$XMIT4DBC^SCDXFU04(XMITPTR)>3 K ^SD(409.73,"AACNOACK",XMITDATE,XMITPTR) Q ;SD*5.3*247
42 ..;Turn transmission flag on
43 ..D XMITFLAG^SCDXFU01(XMITPTR)
44 ;Get pointer to sending event
45 S HLEID=+$O(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",0))
46 ;Sending event not found - send error bulletin - done
47 I ('HLEID) D ERRBULL^SCDXMSG2("Unable to initialize HL7 variables - protocol not found") Q
48 ;Initialze HL7 variables
49 D INIT^HLFNC2(HLEID,.HL)
50 ;Unable to initialize HL7 variables - send error bulletin - done
51 I ($O(HL(""))="") D ERRBULL^SCDXMSG2($P(HL,"^",2)) Q
52 ;Create batch message
53 D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
54 ;Unable to create batch message - send error bulletin - done
55 I ('HLMTIEN) D ERRBULL^SCDXMSG2("Unable to create batch HL7 message") Q
56 ;Initialize message count
57 S BATCHCNT=0,IPCNT=0
58 ;Initialize message number
59 S MSGNUM=1
60 ;Initialize line count
61 S LINECNT=1
62 N VALER,VALERR
63 ;this global contains the validation errors if any.
64 S VALER="^TMP(""SCDXVALID"",$J)"
65 ;Loop through list of [deleted] encounters requiring transmission
66 S SCDXEVNT=""
67 F S SCDXEVNT=+$O(^SD(409.73,"AACXMIT",SCDXEVNT)) Q:('SCDXEVNT) D
68 .S XMITPTR=""
69 .F S XMITPTR=+$O(^SD(409.73,"AACXMIT",SCDXEVNT,XMITPTR)) Q:('XMITPTR) D
70 ..N OENODE,PARENT,FILERR
71 ..S VALERR="^TMP(""SCDXVALID"",$J,"_XMITPTR_")"
72 ..;Bad entry in cross reference - delete cross reference and quit
73 ..I ('$D(^SD(409.73,XMITPTR))) K ^SD(409.73,"AACXMIT",SCDXEVNT,XMITPTR) Q
74 ..;Make sure entry points to an existing encounter - delete entry
75 ..; and quit if it doesn't
76 ..S X=^SD(409.73,XMITPTR,0)
77 ..S X1=+$P(X,"^",2)
78 ..S X2=+$P(X,"^",3)
79 ..S OENODE=$S($G(^SCE(+X1,0)):^(0),1:$G(^SD(409.74,+X2,1))),PARENT=$P(OENODE,"^",6)
80 ..I (((X1)&('$D(^SCE(X1))))!((X2)&('$D(^SD(409.74,X2))))) S ERROR=$$DELXMIT^SCDXFU03(XMITPTR) Q
81 ..; if SD*5.3*70 cleanup not complete, recheck date of encounter for range
82 ..I $G(SDEND) Q:$$CHKD(X1,X2)
83 ..;If inpatient appointment, delete entry and quit
84 ..;Commented to allow transmission of inpatient to NPCD; SD*5.3*387
85 ..;I ($$INPATENC^SCDXUTL(XMITPTR)) S ERROR=$$DELXMIT^SCDXFU03(XMITPTR) Q
86 ..;If test patient, delete entry and quit
87 ..I $$TESTPAT^VADPT($P($$EZN4XMIT^SCDXFU11(XMITPTR),"^",2)) S ERROR=$$DELXMIT^SCDXFU03(XMITPTR) Q
88 ..;If child encounter, delete entry, flag parent for xmit, and quit
89 ..I PARENT D Q
90 ...S ERROR=$$DELXMIT^SCDXFU03(XMITPTR)
91 ..;NPCD will not accept for database credit - clean up and quit
92 ..I +$$XMIT4DBC^SCDXFU04(XMITPTR)>3 D Q ;SD*5.3*247
93 ...;Past database close-out date - delete previously reported errors
94 ...D DELAERR^SCDXFU02(XMITPTR)
95 ...;Turn off transmission flag
96 ...D XMITFLAG^SCDXFU01(XMITPTR,1)
97 ..;Calculate message control ID
98 ..S MSGID=HLMID_"-"_MSGNUM
99 ..;Put [deleted] encounter into transmission
100 ..S ERROR=$$BUILDHL7^SCDXMSG0(XMITPTR,.HL,MSGID,HL7XMIT,LINECNT,VALERR)
101 ..;[Deleted] encounter not added to transmission
102 ..I ERROR<0,$O(@VALERR@(0))']"" D VALIDATE^SCMSVUT0("INTERNAL","","V900",VALERR,0)
103 ..D DELAERR^SCDXFU02(XMITPTR,0)
104 ..I $O(@VALERR@(0))]"" S FILERR=$$FILEVERR^SCMSVUT2(XMITPTR,VALERR)
105 ..I ERROR<0 Q
106 ..;Increment line count
107 ..S LINECNT=LINECNT+ERROR
108 ..;Increment message count
109 ..S BATCHCNT=BATCHCNT+1
110 ..;Increment message number
111 ..S MSGNUM=MSGNUM+1
112 ..;Increment inpatient count
113 ..I $$INPATENC^SCDXUTL(XMITPTR) S IPCNT=IPCNT+1
114 ..;Create entry in ACRP Transmission History file (#409.77)
115 ..S X=$$CRTHIST^SCDXFU10(XMITPTR,HLDT,MSGID,HLMID)
116 ..;Update transmission info for [deleted] encounter
117 ..D XMITDATA^SCDXFU03(XMITPTR,HLDT,MSGID,HLMID)
118 ..;Turn off transmission flag for [deleted] encounter
119 ..D XMITFLAG^SCDXFU01(XMITPTR,1)
120 ..;Delete all errors previously reported for [deleted] encounter
121 ..D DELAERR^SCDXFU02(XMITPTR)
122 ..;Reached max size for batch
123 ..I ((MSGNUM>MAXBATCH)!(LINECNT>MAXLINE)) D
124 ...;Send batch message - immediate priority
125 ...S HLP("PRIORITY")="I"
126 ...D GENERATE^HLMA(HLEID,"GB",1,.HLRESLT,HLMTIEN,.HLP)
127 ...;Re-initialize HL7 message
128 ...K @HL7XMIT
129 ...;Re-initialize HL7 variables
130 ...K HL,HLRESLT,HLP,HLMID,HLMTIEN,HLDT,HLDT1
131 ...S HLEID=+$O(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",0))
132 ...D INIT^HLFNC2(HLEID,.HL)
133 ...;Create new batch message
134 ...D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
135 ...;Re-initialize line count
136 ...S LINECNT=1
137 ...;Re-initialize message number
138 ...S MSGNUM=1
139 ;Check for unsent batch message
140 I ($O(@HL7XMIT@(0))) D
141 .;Send batch message - immediate priority
142 .S HLP("PRIORITY")="I"
143 .D GENERATE^HLMA(HLEID,"GB",1,.HLRESLT,HLMTIEN,.HLP)
144 N ERRCNT,IPERR
145 S ERRCNT=$$COUNT^SCMSVUT2(VALER)
146 S IPERR=$$IPERR^SCMSVUT2(VALER)
147 ;Send completion bulletin
148 D CMPLBULL^SCDXMSG2(BATCHCNT,ERRCNT,IPCNT,IPERR)
149 ;Clean up global arrays used
150 K @XMITERR,@HL7XMIT,@VALER
151 ;Determine if updating of Hospital Location file hasn't completed AND
152 ; if today is past the OPC to HL7 cut over date
153 I ('$P($G(^SD(404.91,1,"AMB")),"^",7)) I ($$DATE^SCDXUTL(DT)) D
154 .;Task updating of Hospital Location file
155 .N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK
156 .S ZTRTN="HOPUP^SCMSP"
157 .S ZTDESC="REQUIRE PROVIDER AND DIAGNOSIS FOR CHECKOUT FROM CLINICS"
158 .S ZTDTH="NOW"
159 .S ZTIO=""
160 .D ^%ZTLOAD
161 ;Done
162 Q
163 ;
164CHKD(X1,X2) ; if clean-up still in progress for SD*5.3*70, check date
165 N SDELE
166 I X1,+$G(^SCE(X1,0))>SDEND Q 1
167 I X2 S SDELE=+$G(^SD(409.74,X2,1)) I SDELE>SDSTA D:SDELE<SDEND Q 1
168 . D KILL^SCDXUTL5("^SD(409.74,",X2)
169 . D KILL^SCDXUTL5("^SD(409.73,",XMITPTR)
170 Q 0
Note: See TracBrowser for help on using the repository browser.