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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1VAFCTFIN ;BIR/DR-TREATING FACILTIY MFU PROCESSING ROUTINE ;11/09/01
2 ;;5.3;Registration;**428,474,520,639,707**;Aug 13, 1993;Build 14
3 ;Reference to EXC, START, and STOP^RGHLLOG supported by IA #2796
4 ;
5IN ;This entry point is used to process the Treating Facility Master File Update Message.
6 ;It is called by the VAFC MFN-M05 CLIENT processing routine when a MFN
7 ;message is received.
8 ;There are no inputs or outputs
9 ;
10 I HL("MTN")="MFK" D RSP Q
11 N VAFC,STATN,VAFCI,MSG,SG,VAFCARR,PDFN,INST,MFUPT,PDLT,TFIEN
12 N ICN,MFI,MFE,MFA,HLCOMP,CNT,X,VAFCERR,VAFCX
13 ;quit if Master Patient Index (MPI) is not installed
14 S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
15 S X="MPIFQ0" X ^%ZOSF("TEST") Q:'$T
16 S X="RGRSBUL1" X ^%ZOSF("TEST") Q:'$T
17 S X="RGRSBULL" X ^%ZOSF("TEST") Q:'$T
18INIT ;Process in the Treating Facility MFN msg
19 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
20 ;reconcil the inbound TF list from the MPI to the local TF list
21 D RECONCIL
22 ;create response message
23 S CNT=1
24 S HLA("HLA",1)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")_HL("FS") S CNT=CNT+1
25 S HLA("HLA",CNT)=MFI S CNT=CNT+1
26 S VAFCX=0 F S VAFCX=$O(MFE(VAFCX)) Q:'VAFCX S HLA("HLA",CNT)=MFE(VAFCX),CNT=CNT+1,HLA("HLA",CNT)=MFA(VAFCX),CNT=CNT+1
27 ;generate an application level ack (MFK) identifying the status of the adds/edits/deletes of TF's passed in
28 D ROUTE
29 D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.VAFCERR,"",.HLP)
30 Q
31PICK ;check routine for segment entry point
32 I $T(@SG)]"" D @SG
33 I $T(@SG)="" Q
34 Q
35MSH ;;MSH
36 ;process the MSH segment
37 S (HLFS,HL("FS"))=$E(MSG,4),(HLECH,HL("ECH"))=$E(MSG,5,8)
38 S HLCOMP=$E(HL("ECH"),1)
39 S VAFCARR("SENDING SITE")=$P(MSG,HL("FS"),4)
40 Q
41EVN ;;EVN
42 ;process the EVN segment
43 S STATN=+$$SITE^VASITE()_"^"_$$FMDATE^HLFNC($P(MSG,HL("FS"),3))
44 Q
45PID ;;PID
46 ;process the PID segment
47 S PDFN=+$P(MSG,HL("FS"),4)
48 Q
49MFI ;;MFI
50 ;process the MFI segment
51 S MFI=MSG
52 S MFUPT=$P(MSG,HL("FS"),4)
53 S VAFCARR("CMOR")=$P($P(MSG,HL("FS"),8),$E(HL("ECH"),1))
54 Q
55MFE ;;MFE
56 ;process the MFE segment
57 N HLCOMP,NXTSGMT,TYPE
58 S HLCOMP=$E(HL("ECH"),1)
59 S PDLT=$$FMDATE^HLFNC($P(MSG,HL("FS"),4))
60 S ICN=$P($P(MSG,HL("FS"),5),HLCOMP,4)
61 S INST=$P($P(MSG,HL("FS"),5),HLCOMP)
62 S TYPE=$P(MSG,HL("FS"),2)
63 S MFE(INST)=MSG
64 S MFI(ICN,INST)=PDLT_"^^"_TYPE
65 Q
66ZET ;;ZET
67 ;process Patient's Date Last Treated Event Type, ZET segment
68 N PDLTET
69 S PDLTET=$P(MSG,HL("FS"),2)
70 S $P(MFI(ICN,INST),"^",2)=PDLTET
71 Q
72RSP ;response process logic entry point
73 Q
74ROUTE ;routing logic entry point
75 N MPI
76 S MPI=$$MPILINK^MPIFAPI() D
77 .I $P($G(MPI),U)'=-1 S HLL("LINKS",1)="VAFC MFN-M05 CLIENT"_"^"_MPI
78 .I $P($G(MPI),U)=-1 D
79 .. N RGLOG D START^RGHLLOG(HLMTIEN,"","")
80 .. D EXC^RGHLLOG(224,"No MPI link identified in CIRN SITE PARAMETER file (#991.8)",$G(PDFN))
81 .. D STOP^RGHLLOG(0)
82 Q
83TEST ;
84 W $$REPROC^HLUTIL(39266,"D IN^VAFCTFIN")
85 Q
86RECONCIL ;
87 N DFN,MFIC,VAFCX,VAFCY,TFL,CNFLT,LOCCMOR,VAFCTYPE
88 S CNFLT=0
89 S DFN=$$GETDFN^MPIF001(ICN)
90 I DFN'>0 S CNFLT=1_"^"_$P($G(DFN),"^",2)
91 I MFUPT="REP" I +CNFLT=0 D TFL^VAFCTFU1(.TFL,DFN) S VAFCX=0 F S VAFCX=$O(TFL(VAFCX)) Q:'VAFCX D
92 . S MFIC($P(TFL(VAFCX),"^"))=TFL(VAFCX) I '$D(MFI(ICN,$P(TFL(VAFCX),"^"))) D DEL(ICN,$P(TFL(VAFCX),"^"))
93 ;VAFCX=ICN and VAFCY=INSTITUTION
94 S VAFCX=0 F S VAFCX=$O(MFI(VAFCX)) Q:'VAFCX D
95 . S VAFCY=0 F S VAFCY=$O(MFI(VAFCX,VAFCY)) Q:'VAFCY D
96 ..S VAFCTYPE=$P(MFI(VAFCX,VAFCY),"^",3)
97 ..I +CNFLT=1 S MFA(VAFCY)="MFA"_HL("FS")_VAFCTYPE_HL("FS")_VAFCY_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")_"U"_HLCOMP_$S(VAFCTYPE="MDL":"Delete of ",1:"Update of ")_VAFCY_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to "_$P(CNFLT,"^",2)
98 ..I +CNFLT=0 I VAFCTYPE="MAD"!(VAFCTYPE="MUP") D ADDUPD(DFN,VAFCY,$P(MFI(VAFCX,VAFCY),"^"),$P(MFI(VAFCX,VAFCY),"^",2))
99 ..I +CNFLT=0 I VAFCTYPE="MDL" D DEL(ICN,VAFCY)
100 Q
101ADDUPD(DFN,INST,PDLT,PDLRTET) ;add or update TF entry
102 N ERROR,STA
103 S STA=INST
104 S INST=$$LKUP^XUAF4(INST)
105 D FILE^VAFCTFU(DFN,INST_"^"_$G(PDLT)_"^"_$G(PDLRTET),1,1,.ERROR)
106 S MFA(STA)="MFA"_HL("FS")_"MUP"_HL("FS")_STA_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")
107 I '$D(ERROR(STA)) S MFA(STA)=MFA(STA)_"S"
108 I $D(ERROR(STA)) S MFA(STA)=MFA(STA)_"U"_HLCOMP_ERROR(STA)_HL("FS")
109 Q
110DEL(ICN,INST) ;delete a TF entry
111 N ERROR,STA
112 S STA=INST
113 S INST=$$LKUP^XUAF4(INST)
114 S ERROR=$$DELETETF^VAFCTFU(ICN,INST)
115 S MFA(STA)="MFA"_HL("FS")_"MDL"_HL("FS")_STA_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")
116 I +ERROR'=1 S MFA(STA)=MFA(STA)_"S"
117 I +ERROR=1 S MFA(STA)=MFA(STA)_"U"_HLCOMP_"Delete Failed: "_$P(ERROR,"^",2)
118 Q
Note: See TracBrowser for help on using the repository browser.