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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1VAFCTFPR ;ALB/JLU,CML-MFU PROCESSING ROUTINE ;06/25/98
2 ;;5.3;Registration;**149,261,255,307,414,474,520**;Aug 13, 1993
3 ;Reference to EXC^RGHLLOG and START^RGHLLOG supported by IA #2796
4 ;
5EN ;This entry point is used to process the Master File Update Message.
6 ;It is called by the VAFC MFU-TFL ClIENT when a MFU message is received
7 ;There are no inputs or outputs
8 ;
9 ;quit if Master Patient Index (MPI) is not installed
10 S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
11 S X="MPIFQ0" X ^%ZOSF("TEST") Q:'$T
12 S X="RGRSBUL1" X ^%ZOSF("TEST") Q:'$T
13 S X="RGRSBULL" X ^%ZOSF("TEST") Q:'$T
14 K X N ICN,PDFN,TYPE,VAFCER,VAFCARR,SG
15 N VAFC,MFNQUIT,VAFCI,MSG,MFUPT,INST,PDLT,VAFCTFT
16MFN ;Read Treating Facility MFN M05 (PROCESS LOGIC) msg into VAFC()
17 F VAFCI=1:1 X HLNEXT Q:HLQUIT'>0 S VAFC(VAFCI)=HLNODE
18MFNP ;Process in the TF updates messages
19 S VAFCI="" F S VAFCI=$O(VAFC(VAFCI)) Q:'VAFCI!($G(MFNQUIT)=1) S MSG=VAFC(VAFCI),SG=$E(MSG,1,3) D:SG?2A1(1A,1N) PICK
20 Q
21INIT ;Process in the ADT A04/A08 (routing logic)
22 F VAFCI=1:1 X HLNEXT Q:HLQUIT'>0 S (MSG,VAFC(VAFCI))=HLNODE,SG=$E(HLNODE,1,3) D:SG?2A1(1A,1N) PICK
23 Q
24PICK ;check routine for segment entry point
25 I $T(@SG)]"" D @SG
26 I $T(@SG)="" Q
27 Q
28MSH ;;MSH
29 ;process the MSH segment
30 D START^RGHLLOG($G(HLMTIENS))
31 S (HLFS,HL("FS"))=$E(MSG,4),(HLECH,HL("ECH"))=$E(MSG,5,8)
32 S VAFCARR("SENDING SITE")=$P(MSG,HL("FS"),4)
33 Q
34EVN ;;EVN
35 ;process the EVN segment
36 S STATN=+$$SITE^VASITE()_"^"_$$FMDATE^HLFNC($P(MSG,HL("FS"),3))
37 Q
38PID ;;PID
39 ;process the PID segment
40 S PDFN=+$P(MSG,HL("FS"),4)
41 Q
42MFI ;;MFI
43 ;process the MFI segment
44 N NXTSGMT,VAFCMPI
45 S MFUPT=$P(MSG,HL("FS"),2)
46 ;master file update type is not TFL SET quit flag
47 I MFUPT'="TFL" S MFNQUIT=1 Q
48 N HLCOMP
49 S HLCOMP=$E(HL("ECH"),1)
50 S TYPE=$P(MSG,HL("FS"),4)
51 ;is this coming from the CMOR if so pass a '1' to FILE to end transmission
52 S VAFCTFT=0 I TYPE="REP" S VAFCTFT=1
53 S VAFCARR("CMOR")=$P($P(MSG,HL("FS"),8),HLCOMP,1)
54 S NXTSGMT=$G(VAFC(+$O(VAFC(VAFCI))))
55 I $P(NXTSGMT,HL("FS"))="MFE" S ICN=$P($P(NXTSGMT,HL("FS"),5),HLCOMP,4) I $G(ICN)="" S MFNQUIT=1 D EXC^RGHLLOG(210,"Msg#"_$G(HL("MID"))_" failed to Update TF from "_$G(VAFCARR("SENDING SITE"))_". ICN not sent.",$G(PDFN)) Q
56 ;check for CMOR mismatch
57 S PDFN=$$GETDFN^MPIF001(ICN)
58 I +$G(PDFN)<0 S MFNQUIT=1 D EXC^RGHLLOG(210,"Msg#"_$G(HL("MID"))_" failed to update TF from "_$G(VAFCARR("SENDING SITE"))_" for ICN#"_$G(ICN)) Q
59 S VAFCMPI=$$MPINODE^MPIFAPI(PDFN)
60 ;if from CMOR delete all TF's and replace with CMOR's list (need to log exception if problems deleting TF's)
61 I TYPE="REP" D
62 . ;if CMOR mismatch quit the exception will be logged in MFE subroutine
63 . I $P($G(VAFCMPI),"^",3)'=$G(VAFCARR("CMOR")) Q
64 . S VAFCER=$$DELALLTF^VAFCTFU(ICN) I VAFCER S MFNQUIT=1 D EXC^RGHLLOG(212,"Msg#"_$G(HL("MID"))_" failed to Delete ALL TF's for ICN#"_$G(ICN),$G(PDFN)) Q
65 Q
66MFE ;;MFE
67 ;process the MFE segment
68 N HLCOMP,NXTSGMT
69 S HLCOMP=$E(HL("ECH"),1)
70 S PDLT=$$FMDATE^HLFNC($P(MSG,HL("FS"),4))
71 S INST=$P($P(MSG,HL("FS"),5),HLCOMP) ; **520 REMOVE + AND GET PIECE
72 S INST=$$LKUP^XUAF4(INST) ; **520 REMOVE +
73 I INST="" S MFNQUIT=1 Q ; log exception, set MFNQUIT flag and quit
74 S PDFN=$$GETDFN^MPIF001(ICN)
75 D Q:$G(MFNQUIT)=1
76 .;if unable to get DFN from ICN set MFNQUIT flag and quit
77 .I +$G(PDFN)<0 S MFNQUIT=1 D EXC^RGHLLOG(210,"Msg#"_$G(HL("MID"))_" failed to update TF from "_$G(VAFCARR("SENDING SITE"))_" for ICN#"_$G(ICN)) Q
78 .N VAFCDATA,LOCNAME,LASTNAME,LOCSSN,LOCICN,LOCCMOR
79 .S LOCNAME=$$GET1^DIQ(2,+PDFN_",",.01)
80 .S LASTNAME=$P(LOCNAME,",",1)
81 .S LOCSSN=$$GET1^DIQ(2,+PDFN_",",.09)
82 .S LOCICN=+$$GETICN^MPIF001(PDFN)
83 .S LOCCMOR=$$GETVCCI^MPIF001(PDFN)
84 .;CMOR MISMATCH or CMOR = null log exception, set MFNQUIT flag and quit
85 .I LOCCMOR'=VAFCARR("CMOR")!(VAFCARR("CMOR")="") D Q
86 ..D EXC^RGHLLOG(211,"Msg#"_$G(HL("MID"))_" failed to update from "_$G(VAFCARR("SENDING SITE"))_" for "_$G(LOCNAME)_" ICN#"_$G(ICN)_" due to mismatch CMOR "_$G(VAFCARR("CMOR"))_"/"_$G(LOCCMOR)_" (local)",$G(PDFN)) S MFNQUIT=1
87 ;check next segment, if it exist and it is a ZET segment quit and let the ZET module add the TF
88 S NXTSGMT=$G(VAFC(+$O(VAFC(VAFCI)))) I $P($G(NXTSGMT),HL("FS"))="ZET" Q
89 D FILE^VAFCTFU(PDFN,INST_"^"_$G(PDLT),$G(VAFCTFT))
90 Q
91ZET ;;ZET
92 ;process Patient's Date Last Treated Event Type, ZET segment
93 K PDLTET
94 S PDLTET=$P(MSG,HL("FS"),2)
95 D FILE^VAFCTFU(PDFN,INST_"^"_PDLT_"^"_PDLTET,$G(VAFCTFT))
96 Q
97TFPRQ Q
98 ;
99POPQ Q
100 ;
101UP ;entry point to process local A04 messages.
102 ;This is call by the VAFC TFL-UPDATE CLIENT
103 N STATN,PDFN,VAFCARR,HLFS,HLECH,SG,VAFCI
104 N VAFC
105 D INIT
106 ;file the TF and trigger the TF update
107 D FILE^VAFCTFU(PDFN,+$$SITE^VASITE,1)
108UPQ Q
Note: See TracBrowser for help on using the repository browser.