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

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

initial load of FOIAVistA 6/30/08 version
File size: 7.1 KB
Line 
1VAFCTFU ;ALB/JLU-UTILITIES FOR THE TREATING FACILITY FILE 391.91 ;10/10/02 15:55
2 ;;5.3;Registration;**149,240,261,255,316,392,440,428,474,520,697**;Aug 13, 1993
3 ;
4 ;Reference to EXC^RGHLLOG and STOP^RGHLLOG supported by IA #2796
5 ;Reference to $$UPDATE^ MPIFAPI supported by IA #2706
6 ;
7 ;CHKSUB & GETSCN line tags removed, patch DG*5.3*697
8 ;Subscriptions are no longer used and errors are being
9 ;generated when attempting to add a subscription.
10 ;
11FILETF(PAT,INST) ;programmer entry point.
12 ;INPUT PAT - This is the patient's ICN
13 ; INST - This is the IEN of the institution or Treating Facility
14 ;it also contains the date of treatment in FM format. It is to be
15 ;stored in an array structure to allow for multiple treating
16 ;facilities.
17 ; EX. X(1)=500^2960101
18 ; x(2)=425^2960202
19 ;
20 ;OUTPUT 0 (ZERO) If no errors
21 ; 1^error description if there was an error.
22 ;
23 N PDFN,LP,VAFCER,X
24 S VAFCER=0
25 I '$G(PAT)!('$D(INST)) S VAFCER="1^Parameter missing." G FILETFQ
26 I $D(@INST)<10 S VAFCER="1^Institution array not populated." G FILETFQ
27 S X="MPIF001" X ^%ZOSF("TEST") I '$T G FILETFQ
28 S PDFN=$$GETDFN^MPIF001(PAT)
29 I PDFN<0 S VAFCER="1^No patient DFN." G FILETFQ
30 N FSTRG
31 F LP=0:0 S LP=$O(@INST@(LP)) Q:'LP D FILE(PDFN,@INST@(LP))
32 ;
33FILETFQ Q VAFCER
34 ;
35 ; both the SET & QUERYTF subroutines have been moved to VAFCTFU1 as
36 ; the result of DG*5.3*261 *261 gjc@120899
37 ;
38FILE(PDFN,FSTRG,TICN,VAFCSLT,ERROR) ;this module files the individual entry
39 ;PDFN is the patient's DFN
40 ;FSTRG = institution or treating facility^Date of treatment^Event reason
41 ;TICN - if 1 suppress add entries to ADT HL7 PIVOT (#391.71) file
42 ;VAFCSLT - (optional) if 1 suppress exception logging and return error in the ERROR array
43 ;ERROR - (optional)
44 ;Ex 500^2960202^A1
45 ;
46 N X,Y
47 I $G(VAFCSLT)="" S VAFCSLT=0
48 S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
49 S X="MPIFQ0" X ^%ZOSF("TEST") Q:'$T
50 N TFIEN,PDLT,FAC,EVNTR,VAFCER,CMOR,ICN,STA,ECNT
51 S ECNT=1
52 S FAC=$P(FSTRG,U,1),PDLT=$P(FSTRG,U,2),EVNTR=$P(FSTRG,U,3)
53 S STA=$$STA^XUAF4(FAC)
54 ;
55 I '$$FIND1^DIC(4,"","MX","`"_FAC) D Q
56 . I 'VAFCSLT D EXC^RGHLLOG(212,"Msg#"_$G(HL("MID"))_" unknown Institution IEN "_FAC_" passed into TF update.",PDFN) D STOP^RGHLLOG(1) Q
57 . I VAFCSLT S ERROR(STA)="Update of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to unknown Institution IEN "_FAC_" passed into TF update."
58 I PDLT'="" K %DT S %DT="T" S X=PDLT D ^%DT K %DT I Y<0 S VAFCER="1^Not a FM date." D Q
59 .I 'VAFCSLT D EXC^RGHLLOG(212,"TF updated in msg#"_$G(HL("MID"))_" for Institution IEN "_FAC_" but with invalid date "_PDLT_" for DFN "_PDFN,PDFN)
60 .I VAFCSLT S ERROR(STA)="Update of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to invalid date "_PDLT_" for DFN "_PDFN
61 ;removed code for adding local ICN's
62 S ICN=+$$MPINODE^MPIFAPI(PDFN)
63 S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,FAC,0)) D
64 .;TFIEN is used in other places so quit after adding new entry
65 .I 'TFIEN D FILENEW(PDFN,FAC,PDLT,EVNTR,VAFCSLT,.ERROR) Q
66 .I TFIEN D FILEDIT(TFIEN,PDLT,PDFN,FAC,EVNTR,VAFCSLT,.ERROR)
67 ;look to see if CMOR is in TF list if not add
68 S CMOR=$$GETVCCI^MPIF001(PDFN)
69 S CMOR=$$LKUP^XUAF4(CMOR) ; **520 REMOVED +
70 ;check to see if CMOR exist if not add it
71 I +$G(CMOR)>0 D:'$D(^DGCN(391.91,"APAT",PDFN,CMOR)) FILENEW^VAFCTFU(PDFN,CMOR)
72 ;create the entry in the pivot to broadcast the MFU.
73 ; Note: we will not broadcast to the MFU if the TFL record
74 ; has an event reason. See comments in FILEDIT. *261 gjc@120199
75 I $G(TICN)'=1,$P($$SEND^VAFHUTL,"^",2)>0 D SETSND(PDFN)
76FILEQ Q
77 ;
78FILENEW(PDFN,FAC,PDLT,EVNTR,VAFCSLT,ERROR) ;
79 N DGSENFLG ;**240 added y
80 K DD,DO,DIC,DA,RESULT
81 S DGSENFLG=""
82 N FDA,FDAIEN,ERR S ERR=""
83 I $G(EVNTR)'="" D CHK^DIE(391.91,.07,"",EVNTR,.RESULT) I +RESULT>0 S EVNTR=RESULT
84 S FDA(1,391.91,"+1,",.01)=PDFN
85 S FDA(1,391.91,"+1,",.02)=FAC
86 S FDA(1,391.91,"+1,",.03)=$G(PDLT)
87 S FDA(1,391.91,"+1,",.07)=$G(EVNTR)
88 L +^DGCN(391.91,0):30
89 I '$D(^DGCN(391.91,"APAT",PDFN,FAC)) D UPDATE^DIE("","FDA(1)","FDAIEN","ERR") I $D(ERR("DIERR",1)) S ERROR(STA)="Add of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to "_$G(ERR("DIERR",1,"TEXT",1))
90 ;removed code to add a subscription
91 L -^DGCN(391.91,0)
92 K DIC,DD,DO,DA
93 Q
94 ;
95SETSND(PDFN) ;sets the pivot file entry to send MFU
96 ;
97 N ANS,X
98 S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
99 ; check if other facilities other than CMOR in TF list
100 N SIT,CMOR,STOP
101 S CMOR=$$GETVCCI^MPIF001(PDFN)
102 S CMOR=$$LKUP^XUAF4(CMOR) ; **520 REMOVED +
103 I CMOR=$P($$SITE^VASITE,"^") D
104 .S SIT=0
105 .S SIT=$O(^DGCN(391.91,"APAT",PDFN,SIT))
106 .I SIT=CMOR S SIT=$O(^DGCN(391.91,"APAT",PDFN,SIT)) I SIT="" S STOP=""
107 I $D(STOP) QUIT
108 S ANS=$$PIVNW^VAFHPIVT(PDFN,DT,5,PDFN_";DPT(")
109 I 'ANS QUIT
110 D XMITFLAG^VAFCDD01(0,+ANS,0)
111SETSNDQ Q
112 ;
113FILEDIT(TFIEN,PDLT,PDFN,FAC,EVNTR,VAFCSLT,ERROR) ;
114 N DGSENFLG,FDA,FDAIEN,ERR,RESULT S DGSENFLG="",ERR=""
115 I $G(PDLT)'="" D
116 .S TFIEN(0)=$G(^DGCN(391.91,TFIEN,0))
117 .I $G(EVNTR)'="" D CHK^DIE(391.91,.07,"",EVNTR,.RESULT) I +RESULT>0 S EVNTR=RESULT
118 .S FDA(1,391.91,+TFIEN_",",.03)=$G(PDLT)
119 .S FDA(1,391.91,+TFIEN_",",.07)=$G(EVNTR)
120 .D FILE^DIE("K","FDA(1)","ERR") I VAFCSLT I $D(ERR("DIERR",1)) S ERROR(STA)="Edit of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to "_$G(ERR("DIERR",1,"TEXT",1))
121 ;remove code to add a subscription
122 Q
123 ;
124DELETETF(PAT,INST) ;deletion entry point
125 ;This entry point is used to delete a single Treating Facility from
126 ;the Treating Facility list.
127 ;INPUT PAT - the ICN of the patient.
128 ; INST - the IEN of the institution to be deleted.
129 ;
130 ;OUTPUT 0 (zero) - If no errors
131 ; 1^error description if there was a problem
132 ;
133 N VAFCER,PDFN,TFIEN,X,VAFCSCN,LINK,VAFCLLN,IEN
134 S VAFCER=0
135 I '$G(PAT)!('$G(INST)) S VAFCER="1^Parameter missing." S ERROR(INST)="212"_"^"_$G(HL("MID"))_"^"_"Delete Failed: "_$P(VAFCER,"^") G DELTFQ
136 S X="MPIF001" X ^%ZOSF("TEST") I '$T G FILETFQ
137 S PDFN=$$GETDFN^MPIF001(+PAT)
138 I PDFN<0 S VAFCER="1^No patient DFN." G FILETFQ
139 I '$$FIND1^DIC(4,"","MX","`"_INST) S VAFCER="1^Not an Institution IEN." G DELTFQ
140 S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,INST,0))
141 I 'TFIEN S VAFCER="1^Could not find Treating Facility." G DELTFQ
142 D DELETE(TFIEN)
143 S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,INST,0))
144 I TFIEN S VAFCER="1^DIK failed to delete entry" G DELTFQ
145 ;terminate the subscription if there is one
146 S VAFCSCN=+$P($$MPINODE^MPIFAPI(PDFN),"^",5) I +$G(VAFCSCN)>0 D
147 .;get logical link
148 . D LINK^HLUTIL3(INST,.LINK) S VAFCLLN=$O(LINK(0)) I +$G(VAFCLLN)>0 S VAFCLLN=LINK(VAFCLLN) D UPD^HLSUB(VAFCSCN,VAFCLLN,0,,$$NOW^XLFDT,,.HLER)
149 D RETPDR^VAFCEHU2(PDFN,INST) ;**474 retire pdr when deleting tf
150DELTFQ Q VAFCER
151 ;
152DELETE(TFIEN) ;the actual deletion code
153 ;
154 K DIK,DA
155 S DIK="^DGCN(391.91,"
156 S DA=TFIEN
157 D ^DIK K DIK,DA
158 Q
159 ;
160DELALLTF(PAT) ;Entry point to delete all Treating Facilities for a single
161 ;patient.
162 ;INPUT PAT - The patient's ICN
163 ;OUTPUT 0 (zero) - If no errors
164 ; 1^error description if an error
165 ;
166 N VAFCER,PDFN,LP,TFIEN,X
167 S VAFCER=0
168 I '$G(PAT) Q "1^Parameter missing."
169 S X="MPIF001" X ^%ZOSF("TEST") I '$T Q 0
170 S PDFN=$$GETDFN^MPIF001(PAT)
171 I PDFN<0 Q "1^No patient DFN."
172 F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PDFN,LP)) Q:LP'>0 D
173 . S TFIEN=0
174 . F S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,LP,TFIEN)) Q:TFIEN'>0 D DELETE(TFIEN)
175 ;
176 Q VAFCER
177 ;
Note: See TracBrowser for help on using the repository browser.