source: FOIAVistA/tag/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGADT2.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1RGADT2 ;HIRMFO/GJC-TFL FILE SEEDING ROUTINE (PD-MPI LOAD) ;09/21/99
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**4,17,20**;30 Apr 99
3 Q ; quit if called from the top
4 ;
5EN ; entry point to check the TREATING FACILITY LIST (TFL-391.91) file
6 ; for the proper LAST TREATMENT DATE. This code is part of the post
7 ; init for RG*1*4. This can also be called from the EN1 entry point
8 ; to determine the LAST TREATMENT DATE for a specific patient.
9 ; Closely linked to the MFU event message broadcasts used to update
10 ; the TFL (#391.91) file.
11 ;
12 ;IA: 2053 - FILE^DIE
13 ;IA: 2070 - check for national ICN, 1st piece "MPI" node (global read)
14 ;IA: 2701 - $$IFLOCAL^MPIF001
15 ;IA: 2546 - GETGEN/PARSE^SDOE
16 ;IA: 2988 - FILE^VAFCTFU
17 ;IA: 2541 - $$KSP^XUPARAM
18 ;IA: 2953 - ^SCE("ADFN"
19 ;IA: 10061 - IN5^VADPT
20 ;IA: 10103 - $$FMDIFF/$$NOW^XLFDT
21 ;IA: 10104 - $$STRIP^XLFSTR
22 ;IA: 10070 - ^XMD
23 ;IA: 10141 - $$PARCP/$$UPCP^XPDUTL
24 ;
25 Q:$P($G(^RGSITE(991.8,1,1)),"^",2) ; seeding process ran in the past
26 ;
27 S:$D(ZTQUEUED) ZTREQ="@"
28 S U="^",RGSITE=$$KSP^XUPARAM("INST") ;defines the local facility
29 S RGSTRT=$$NOW^XLFDT(),RGCNT=0
30 ; check to see if software is part of an KIDS install. If not, no
31 ; checkpoints needed.
32 S RGICN=$S($D(XPDNM):+$$PARCP^XPDUTL("POST2"),1:0)
33 ; check ALL patients with an Integration Control Number (ICN) for a
34 ; given facility, make sure the DATE LAST TREATED field in the TFL
35 ; file is correct.
36 F S RGICN=$O(^DPT("AICN",RGICN)) Q:RGICN'>0 D
37 . S RGDFN=0
38 . F S RGDFN=$O(^DPT("AICN",RGICN,RGDFN)) Q:RGDFN'>0 D EN1(RGDFN)
39 . S RGCNT=RGCNT+1 ; increment record counter
40 . S:$D(XPDNM) RGSAVE=$$UPCP^XPDUTL("POST2",RGICN)
41 . Q
42 S RGFIN=$$NOW^XLFDT() D EMAIL^RGADT2 ; send completion message to user
43 ; populate the 'MPI/PD SEEDING COMP DATE/TIME' (#12) field in the CIRN
44 ; SITE PARAMETER FILE (#991.8) (do not re-seed a facility)
45 K RGFDA S RGFDA(991.8,"1,",12)=$$NOW^XLFDT()
46 D FILE^DIE("K","RGFDA"),KILL
47 QUIT
48 ;
49EN1(RGDFN,RGSUP) ; determine the LAST TREATMENT DATE for a single
50 ; patient called from our seeding process above.
51 ; input: RGDFN - the dfn of the patient
52 ; RGSUP - if 1, suppress add entries to the ADT HL7 PIVOT
53 ; (#391.71) file for TF messaging - VAFCTFMF (optional)
54 ; output: RGDATE - patient's DATE LAST TREATED
55 ; RGENVR - event reason
56 ;
57 Q:$$LOCICN(RGDFN,$G(RGICN)) ; local ICN
58 S U="^"
59 S RGSITE=$$KSP^XUPARAM("INST") ;defines the local facility
60 S (RGLAST,RGADMDIS)=$$ADMDIS(RGDFN) ; dt_"^"_event type or ""
61 S RGADMDIS=$S(RGADMDIS]"":$P(RGADMDIS,"^"),1:"") ; event dt or null
62 S:$P(RGLAST,"^",2)=3!(RGLAST="") RGENCDT=$$ENCDT(RGDFN,RGADMDIS)
63 ; patient has been discharged or has never been admitted. Has this
64 ; individual been checked out of a clinic?
65 I $D(RGENCDT)#2,($P(RGLAST,U)) S RGLAST=$S(+RGENCDT>+RGLAST:RGENCDT,1:RGLAST)
66 I $D(RGENCDT)#2,('$P(RGLAST,U)) S RGLAST=RGENCDT
67 S RGTYPE=$P(RGLAST,"^",2),RGDATE=+RGLAST
68 ; input variables to FILE^VAFCTFU
69 ; RGDFN - patient ien ; RGSITE - treating facility
70 ; RGDATE - date last treated ; RGENVR - event reason
71 ;
72 I RGDATE D SETMSG,FILE^VAFCTFU(RGDFN,RGSITE_U_RGDATE_U_RGENVR,$G(RGSUP))
73 ; update the TFL file for the site running the seeding process,
74 ; then build the HL7 message with the new DATE LAST TREATED &
75 ; ADT/HL7 EVENT REASON values & send them to our CMOR/subscribers.
76 ;
77 D:$G(XPDNM)'="RG*1.0*4" KILL ; single patient operation, kill all
78 ; variables (EN1 re-entrant when running post-install for RG*1.0*4)
79 Q
80 ;
81KILL ; kill and quit
82 K DFN,RGADMDIS,RGCNT,RGDATE,RGDFN,RGENCDT,RGENVR,RGFDA,RGFIN,RGICN
83 K RGLAST,RGSAVE,RGSITE,RGSTRT,RGTYPE
84 Q
85 ;
86ADMDIS(DFN) ; find the patient's last admission and discharge dates if
87 ; they exist.
88 ; Input: DFN - ien of the patient (file 2)
89 ;Output: a valid discharge/admission date/time concatenated with
90 ; the event type (1=admission, 3=discharge) -or- null
91 N %,VAERR,VAIP S VAIP("D")="LAST" D IN5^VADPT
92 I '+$G(VAIP(17,1)),('+$G(VAIP(13,1))) Q ""
93 ; no discharge date, no admission date, return null
94 I '+$G(VAIP(17,1)) Q $P($G(VAIP(13,1)),U)_"^1"
95 ; no discharge date, return admission date
96 I '+$G(VAIP(13,1)) Q $P($G(VAIP(17,1)),U)_"^3"
97 ; no admission date, return discharge date
98 I +$G(VAIP(17,1))>(+$G(VAIP(13,1))) Q +$G(VAIP(17,1))_"^3"
99 ; return discharge date
100 Q +$G(VAIP(13,1))_"^1" ; return admission date
101 ;
102ENCDT(DFN,INPDT) ; find the last patient check out date/time. 'ADFN'
103 ; cross-reference accessed through DBIA: 2953
104 ; Input: DFN - ien of the patient (file 2)
105 ; INPDT - date (if any) returned from the inpatient admission/
106 ; discharge subroutine
107 ;Output: a valid discharge/admission date/time concatenated with
108 ; the event type (5=check out) -or- null
109 Q:'DFN "" ; we need dfn defined
110 K RGDATA,RGPURGE,RGX,RGX1,RGX2 N RGX3
111 S RGX=9999999.9999999,RGX2=0,RGX3=""
112 F S RGX=$O(^SCE("ADFN",DFN,RGX),-1) Q:'RGX!(INPDT>RGX) D Q:RGX2
113 . S RGX1=0 F S RGX1=$O(^SCE("ADFN",DFN,RGX,RGX1)) Q:'RGX1 D Q:RGX2
114 .. D GETGEN^SDOE(RGX1,"RGDATA")
115 .. D PARSE^SDOE(.RGDATA,"EXTERNAL","RGPARSE")
116 .. I $G(RGPARSE(.12))="CHECKED OUT" S RGX2=1,RGX3=RGX
117 .. K RGDATA,RGPARSE
118 .. Q
119 . Q
120 K RGDATA,RGPURGE,RGX,RGX1,RGX2
121 Q RGX3_"^5" ; X is either null or the date/time of the check out
122 ;
123SETMSG ; define the variables used to build a HL7 message (RGADT1)
124 S DFN=RGDFN
125 S RGENVR=$S(RGTYPE=1:"A1",RGTYPE=3:"A2",1:"A3") ;A1=adm;A2=dis;A3=CO
126 Q
127 ;
128EMAIL ; Send a completion email message to the user who installed this patch,
129 ; RG*1*4. Show the number of records processed, elapsed time and the
130 ; number of records processed per minute.
131 N RGELAPS,RGARY,RGMIN
132 S XMDUZ=.5,XMY(DUZ)="",XMTEXT="RGARY(1,"
133 S XMSUB="CIRN-CPRS DATE LAST TREATED seeding (#391.91 ; .03) results"
134 S RGMIN=$$FMDIFF^XLFDT(RGFIN,RGSTRT,2)/60 ; # of sec x (1 min/60 sec)
135 S:RGMIN=0 RGMIN=1 ; avoid a possible divide by zero
136 S RGELAPS=$$FMDIFF^XLFDT(RGFIN,RGSTRT,3)
137 S RGARY(1,1)="# of processed patients, in the PATIENT (#2) file"
138 S RGARY(1,2)="with an ICN: "_RGCNT
139 S RGARY(1,3)="TFL seeding process run time: "_RGELAPS_" (DD HH:MM:SS format)"
140 S RGARY(1,4)="# of records processed per minute: "_$$STRIP^XLFSTR($J((RGCNT/RGMIN),8,2)," ")
141 D ^XMD K XMDUZ,XMSUB,XMTEXT,XMY
142 Q
143 ;
144LOCICN(DFN,ICN) ; check if this patient has a national ICN without having a
145 ; local ICN. This function is used when an entire site (all patients)
146 ; is seeding, or for individual patient seeding.
147 ; note: IA 2070 covers the hit on the 'MPI' node
148 ; IA 2701 covers the call to $$IFLOCAL^MPIF001
149 ;input variables:
150 ; DFN(required)-Patient ien (PATIENT file #2)
151 ; ICN(optional)-Integration Control Number(fld: 991.01, file 2)
152 ;output variable:
153 ; FLAG-0 if the patient has a national ICN and not a local ICN, else 1
154 N FLAG S FLAG=1
155 I +$G(ICN) D
156 . I $P($G(^DPT(DFN,"MPI")),"^")=ICN,('$$IFLOCAL^MPIF001(DFN)) S FLAG=0
157 . Q
158 E D
159 . I $P($G(^DPT(DFN,"MPI")),"^"),('$$IFLOCAL^MPIF001(DFN)) S FLAG=0
160 . Q
161 Q FLAG
Note: See TracBrowser for help on using the repository browser.