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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1VAFCTFMF ;ALB/JLU,LTL-Broadcast Master File Update for Treating Facility ;09/03/98
2 ;;5.3;Registration;**149,261,255,307,361,428,697**;Aug 13, 1993
3 ;
4 ;Reference to ^ORD(101 supported by IA #872
5BCKTFMFU ;
6 ;This entry point is used to generate a Master File update
7 ;for each patient that is in the "AXMIT" cross reference in the PIVOT
8 ;file.
9 ;INPUTS NONE
10 ;OUTPUTS Sending of MFU messages
11 ;
12 ;IA: 2056 - $$GET1^DIQ
13 ;IA: 10106 - $$HLDATE^HLFNC
14 ;IA: 2161 - INIT^HLFNC2
15 ;IA: 2164 - GENERATE^HLMA
16 ;IA: 2270 - GET^HLSUB
17 ;IA: 2701 - $$GETICN/$$HL7CMOR/$$IFVCCI^MPIF001
18 ;IA: 2702 - $$MPINODE^MPIFAPI
19 ;IA: 3073 - EN1^RGADT2
20 ;IA: 2796 - EXC/STOP^RGHLLOG
21 ;IA: 10141 - $$PATCH^XPDUTL
22 ;IA: 2171 - $$WHAT^XUAF4
23 ;
24 ;quit if CIRN is not installed
25 N X S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
26 N PDFN,LP,EVTDATE,EVTR,SUBSCN,VAFCMPI
27 I '$D(^VAT(391.71,"AXMIT",5)) G BCKQ
28 F LP=0:0 S LP=$O(^VAT(391.71,"AXMIT",5,LP)) Q:'LP D
29 .S PDFN=$P($G(^VAT(391.71,LP,0)),U,3)
30 .I PDFN="" D EXC^RGHLLOG(212,"Unable to send TF update due to unknown patient for IEN#"_$G(LP)) D STOP^RGHLLOG(1) Q ; log exception
31 .I PDFN'=""&'$D(^DPT(PDFN,0)) D EXC^RGHLLOG(212,"Unable to send TF update due to unknown patient for IEN#"_$G(LP)) D STOP^RGHLLOG(1) Q ; log exception
32 .;making sure that your site is added or updated before continuing, FILE will also add CMOR
33 . I '$$PATCH^XPDUTL("RG*1.0*4") D FILE^VAFCTFU(PDFN,+$$SITE^VASITE,1)
34 .S SUBSCN=$$MPINODE^MPIFAPI(PDFN) I +$G(SUBSCN)<1 D XMITFLAG^VAFCDD01(LP,0,1) Q
35 .; if no subscribers (piece 5) and no CMOR (piece 3), turn off xmit flag for Pivot file.
36 .I +$P(SUBSCN,"^",3)<1,(+$P(SUBSCN,"^",5)<1) D XMITFLAG^VAFCDD01(LP,0,1)
37 .;Removed section to create a new subscription as it is no longer used.
38 .;1/23/06
39 .I +$P($G(SUBSCN),"^",5)<1 D XMITFLAG^VAFCDD01(LP,0,1) Q
40 .K HLL D GET^HLSUB($P(SUBSCN,"^",5),"","VAFC MFU-TFL CLIENT",.HLL) I '$D(HLL("LINKS")) D XMITFLAG^VAFCDD01(LP,0,1) Q
41 .K HLL
42 .;Update last treatment date and event reason
43 .I $$PATCH^XPDUTL("RG*1.0*4") D EN1^RGADT2(PDFN,1)
44 .I PDFN DO
45 ..K VAFCERR
46 ..I $D(^DGCN(391.91,"APAT",PDFN)) D TFMFU(PDFN)
47 ..;CALL TAG TO FLIP TRANSMIT FIELD IN VAT(391.71
48 ..D:$G(RESLT) XMITFLAG^VAFCDD01(LP,0,1)
49 ..;store resulting message in ADT/HL7 PIVOT file
50 ..S RESLT=$S($G(RESLT)]"":RESLT,1:$P($G(ER),U,2))
51 ..D FILERM^VAFCUTL(LP,RESLT)
52 ..K ER,RESLT,VAFCERR Q
53BCKQ Q
54 ;
55TFMFU(PDFN) ;
56 ;sends a MFU message for a single patient
57 N HLEID
58 S ER=$$INIT
59 I ER G TFMFUQ
60 D BLDTFMFU(PDFN)
61 ;if error from build don't send
62 I '$D(VAFCERR) D SEND
63 D KILLHL7
64TFMFUQ Q
65 ;
66INIT() ;
67 ;initialize HL7 variables
68 S ER=0
69 S HLEID=+$O(^ORD(101,"B","VAFC MFU-TFL SERVER",0))
70 I 'HLEID S ER="1^Unable to initialize HL7 variables - Protocol not found." G INITQ
71 S HL=""
72 D INIT^HLFNC2(HLEID,.HL)
73 I $O(HL(""))="" S ER="1^"_$P(HL,U,2) G INITQ
74 I $G(HL)]"" S ER=$G(HL)
75INITQ Q ER
76 ;
77 ;
78BLDTFMFU(PDFN) ;
79 ;builds the segments and formats the HL7 MFU message
80 N CTR,INST,ICN,INSTNUM,IEN,TF,EC,INSTNAM,PPF,CMOR
81 S PPF=$$IFVCCI^MPIF001(PDFN)
82 S EC=$E(HL("ECH"),1,1)
83 S CTR=1
84 S TFMF(1)="TFL",TFMF(2)="",TFMF(3)=$S(PPF>0:"REP",1:"UPD"),TFMF(4)="",TFMF(5)="",TFMF(6)="NE"
85 S CMOR=$$HL7CMOR^MPIF001(PDFN,EC)
86 I CMOR'>0 K CMOR
87 S HLA("HLS",CTR)=$$EN^VAFHLMFI(HL("ECH"),HL("FS"),HL("Q"),"TFMF")_HL("FS")_$G(CMOR)
88 K TFMF
89 S ICN=$$GETICN^MPIF001(PDFN)
90 S TFMF(1)="MAD",TFMF(2)=""
91 I PPF>0 DO
92 .F INST=0:0 S INST=$O(^DGCN(391.91,"APAT",PDFN,INST)) Q:'INST S IEN=$O(^(INST,0)),TF=^DGCN(391.91,IEN,0) DO
93 ..S INSTNAM=$$WHAT^XUAF4(+$P(TF,U,2),.01)
94 ..S INSTNUM=$$WHAT^XUAF4(+$P(TF,U,2),99)
95 ..S TFMF(3)=$$HLDATE^HLFNC($P(TF,U,3))
96 ..S TFMF(4)=INSTNUM_EC_INSTNAM_EC_"VA"_EC_+ICN_EC_"ICN"_EC_"VA"
97 ..D SETMFE
98 ..D SETZET(IEN)
99 ..Q
100 E DO ;NOT THE PRIMARY FACILITY
101 .S INSTNAM=$$SITE^VASITE(),INST=+INSTNAM
102 .S IEN=$O(^DGCN(391.91,"APAT",PDFN,INST,0))
103 .;if there was a subscription but no TF add it, quit and don't send
104 .I +IEN'>0 D FILE^VAFCTFU(PDFN,INST,1) S VAFCERR=1 Q
105 .S TF=$G(^DGCN(391.91,IEN,0))
106 .S TFMF(3)=$$HLDATE^HLFNC($P(TF,"^",3))
107 .S TFMF(4)=$P(INSTNAM,U,3)_EC_$P(INSTNAM,U,2)_EC_"VA"_EC_+ICN_EC_"ICN"_EC_"VA"
108 .D SETMFE
109 .D SETZET(IEN)
110 .Q
111BLDTFMFQ K TFMF
112 Q
113 ;
114SETMFE S CTR=CTR+1
115 S HLA("HLS",CTR)=$$EN^VAFHLMFE(HL("ECH"),HL("FS"),HL("Q"),"TFMF")
116 Q
117SETZET(IEN) ;Date of Last Treatment event type ZET segment
118 S CTR=CTR+1
119 S HLA("HLS",CTR)="ZET"_HL("FS")_$$GET1^DIQ(391.91,+IEN_",",.07)
120 Q
121 ;
122SEND ;
123 ;sends the MFU message
124 D GENERATE^HLMA(HLEID,"LM",1,.HLRESLT,"","")
125 S RESLT=$S(+HLRESLT:HLRESLT,1:$P(HLRESLT,U,3))
126 Q
127 ;
128KILLHL7 ;
129 ;kills off the variables from the HL7 package.
130 K HL,HLA,HLECH,HLEID,HLFS,HLMTIEN,HLMTIENA,HLQ,HLRESLT,HLN,HLSAN
131 Q
Note: See TracBrowser for help on using the repository browser.