RGADT2 ;HIRMFO/GJC-TFL FILE SEEDING ROUTINE (PD-MPI LOAD) ;09/21/99
;;1.0;CLINICAL INFO RESOURCE NETWORK;**4,17,20**;30 Apr 99
Q ; quit if called from the top
;
EN ; entry point to check the TREATING FACILITY LIST (TFL-391.91) file
; for the proper LAST TREATMENT DATE. This code is part of the post
; init for RG*1*4. This can also be called from the EN1 entry point
; to determine the LAST TREATMENT DATE for a specific patient.
; Closely linked to the MFU event message broadcasts used to update
; the TFL (#391.91) file.
;
;IA: 2053 - FILE^DIE
;IA: 2070 - check for national ICN, 1st piece "MPI" node (global read)
;IA: 2701 - $$IFLOCAL^MPIF001
;IA: 2546 - GETGEN/PARSE^SDOE
;IA: 2988 - FILE^VAFCTFU
;IA: 2541 - $$KSP^XUPARAM
;IA: 2953 - ^SCE("ADFN"
;IA: 10061 - IN5^VADPT
;IA: 10103 - $$FMDIFF/$$NOW^XLFDT
;IA: 10104 - $$STRIP^XLFSTR
;IA: 10070 - ^XMD
;IA: 10141 - $$PARCP/$$UPCP^XPDUTL
;
Q:$P($G(^RGSITE(991.8,1,1)),"^",2) ; seeding process ran in the past
;
S:$D(ZTQUEUED) ZTREQ="@"
S U="^",RGSITE=$$KSP^XUPARAM("INST") ;defines the local facility
S RGSTRT=$$NOW^XLFDT(),RGCNT=0
; check to see if software is part of an KIDS install. If not, no
; checkpoints needed.
S RGICN=$S($D(XPDNM):+$$PARCP^XPDUTL("POST2"),1:0)
; check ALL patients with an Integration Control Number (ICN) for a
; given facility, make sure the DATE LAST TREATED field in the TFL
; file is correct.
F S RGICN=$O(^DPT("AICN",RGICN)) Q:RGICN'>0 D
. S RGDFN=0
. F S RGDFN=$O(^DPT("AICN",RGICN,RGDFN)) Q:RGDFN'>0 D EN1(RGDFN)
. S RGCNT=RGCNT+1 ; increment record counter
. S:$D(XPDNM) RGSAVE=$$UPCP^XPDUTL("POST2",RGICN)
. Q
S RGFIN=$$NOW^XLFDT() D EMAIL^RGADT2 ; send completion message to user
; populate the 'MPI/PD SEEDING COMP DATE/TIME' (#12) field in the CIRN
; SITE PARAMETER FILE (#991.8) (do not re-seed a facility)
K RGFDA S RGFDA(991.8,"1,",12)=$$NOW^XLFDT()
D FILE^DIE("K","RGFDA"),KILL
QUIT
;
EN1(RGDFN,RGSUP) ; determine the LAST TREATMENT DATE for a single
; patient called from our seeding process above.
; input: RGDFN - the dfn of the patient
; RGSUP - if 1, suppress add entries to the ADT HL7 PIVOT
; (#391.71) file for TF messaging - VAFCTFMF (optional)
; output: RGDATE - patient's DATE LAST TREATED
; RGENVR - event reason
;
Q:$$LOCICN(RGDFN,$G(RGICN)) ; local ICN
S U="^"
S RGSITE=$$KSP^XUPARAM("INST") ;defines the local facility
S (RGLAST,RGADMDIS)=$$ADMDIS(RGDFN) ; dt_"^"_event type or ""
S RGADMDIS=$S(RGADMDIS]"":$P(RGADMDIS,"^"),1:"") ; event dt or null
S:$P(RGLAST,"^",2)=3!(RGLAST="") RGENCDT=$$ENCDT(RGDFN,RGADMDIS)
; patient has been discharged or has never been admitted. Has this
; individual been checked out of a clinic?
I $D(RGENCDT)#2,($P(RGLAST,U)) S RGLAST=$S(+RGENCDT>+RGLAST:RGENCDT,1:RGLAST)
I $D(RGENCDT)#2,('$P(RGLAST,U)) S RGLAST=RGENCDT
S RGTYPE=$P(RGLAST,"^",2),RGDATE=+RGLAST
; input variables to FILE^VAFCTFU
; RGDFN - patient ien ; RGSITE - treating facility
; RGDATE - date last treated ; RGENVR - event reason
;
I RGDATE D SETMSG,FILE^VAFCTFU(RGDFN,RGSITE_U_RGDATE_U_RGENVR,$G(RGSUP))
; update the TFL file for the site running the seeding process,
; then build the HL7 message with the new DATE LAST TREATED &
; ADT/HL7 EVENT REASON values & send them to our CMOR/subscribers.
;
D:$G(XPDNM)'="RG*1.0*4" KILL ; single patient operation, kill all
; variables (EN1 re-entrant when running post-install for RG*1.0*4)
Q
;
KILL ; kill and quit
K DFN,RGADMDIS,RGCNT,RGDATE,RGDFN,RGENCDT,RGENVR,RGFDA,RGFIN,RGICN
K RGLAST,RGSAVE,RGSITE,RGSTRT,RGTYPE
Q
;
ADMDIS(DFN) ; find the patient's last admission and discharge dates if
; they exist.
; Input: DFN - ien of the patient (file 2)
;Output: a valid discharge/admission date/time concatenated with
; the event type (1=admission, 3=discharge) -or- null
N %,VAERR,VAIP S VAIP("D")="LAST" D IN5^VADPT
I '+$G(VAIP(17,1)),('+$G(VAIP(13,1))) Q ""
; no discharge date, no admission date, return null
I '+$G(VAIP(17,1)) Q $P($G(VAIP(13,1)),U)_"^1"
; no discharge date, return admission date
I '+$G(VAIP(13,1)) Q $P($G(VAIP(17,1)),U)_"^3"
; no admission date, return discharge date
I +$G(VAIP(17,1))>(+$G(VAIP(13,1))) Q +$G(VAIP(17,1))_"^3"
; return discharge date
Q +$G(VAIP(13,1))_"^1" ; return admission date
;
ENCDT(DFN,INPDT) ; find the last patient check out date/time. 'ADFN'
; cross-reference accessed through DBIA: 2953
; Input: DFN - ien of the patient (file 2)
; INPDT - date (if any) returned from the inpatient admission/
; discharge subroutine
;Output: a valid discharge/admission date/time concatenated with
; the event type (5=check out) -or- null
Q:'DFN "" ; we need dfn defined
K RGDATA,RGPURGE,RGX,RGX1,RGX2 N RGX3
S RGX=9999999.9999999,RGX2=0,RGX3=""
F S RGX=$O(^SCE("ADFN",DFN,RGX),-1) Q:'RGX!(INPDT>RGX) D Q:RGX2
. S RGX1=0 F S RGX1=$O(^SCE("ADFN",DFN,RGX,RGX1)) Q:'RGX1 D Q:RGX2
.. D GETGEN^SDOE(RGX1,"RGDATA")
.. D PARSE^SDOE(.RGDATA,"EXTERNAL","RGPARSE")
.. I $G(RGPARSE(.12))="CHECKED OUT" S RGX2=1,RGX3=RGX
.. K RGDATA,RGPARSE
.. Q
. Q
K RGDATA,RGPURGE,RGX,RGX1,RGX2
Q RGX3_"^5" ; X is either null or the date/time of the check out
;
SETMSG ; define the variables used to build a HL7 message (RGADT1)
S DFN=RGDFN
S RGENVR=$S(RGTYPE=1:"A1",RGTYPE=3:"A2",1:"A3") ;A1=adm;A2=dis;A3=CO
Q
;
EMAIL ; Send a completion email message to the user who installed this patch,
; RG*1*4. Show the number of records processed, elapsed time and the
; number of records processed per minute.
N RGELAPS,RGARY,RGMIN
S XMDUZ=.5,XMY(DUZ)="",XMTEXT="RGARY(1,"
S XMSUB="CIRN-CPRS DATE LAST TREATED seeding (#391.91 ; .03) results"
S RGMIN=$$FMDIFF^XLFDT(RGFIN,RGSTRT,2)/60 ; # of sec x (1 min/60 sec)
S:RGMIN=0 RGMIN=1 ; avoid a possible divide by zero
S RGELAPS=$$FMDIFF^XLFDT(RGFIN,RGSTRT,3)
S RGARY(1,1)="# of processed patients, in the PATIENT (#2) file"
S RGARY(1,2)="with an ICN: "_RGCNT
S RGARY(1,3)="TFL seeding process run time: "_RGELAPS_" (DD HH:MM:SS format)"
S RGARY(1,4)="# of records processed per minute: "_$$STRIP^XLFSTR($J((RGCNT/RGMIN),8,2)," ")
D ^XMD K XMDUZ,XMSUB,XMTEXT,XMY
Q
;
LOCICN(DFN,ICN) ; check if this patient has a national ICN without having a
; local ICN. This function is used when an entire site (all patients)
; is seeding, or for individual patient seeding.
; note: IA 2070 covers the hit on the 'MPI' node
; IA 2701 covers the call to $$IFLOCAL^MPIF001
;input variables:
; DFN(required)-Patient ien (PATIENT file #2)
; ICN(optional)-Integration Control Number(fld: 991.01, file 2)
;output variable:
; FLAG-0 if the patient has a national ICN and not a local ICN, else 1
N FLAG S FLAG=1
I +$G(ICN) D
. I $P($G(^DPT(DFN,"MPI")),"^")=ICN,('$$IFLOCAL^MPIF001(DFN)) S FLAG=0
. Q
E D
. I $P($G(^DPT(DFN,"MPI")),"^"),('$$IFLOCAL^MPIF001(DFN)) S FLAG=0
. Q
Q FLAG
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGADT2 7079 printed Sep 23, 2025@19:17:21 Page 2
RGADT2 ;HIRMFO/GJC-TFL FILE SEEDING ROUTINE (PD-MPI LOAD) ;09/21/99
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**4,17,20**;30 Apr 99
+2 ; quit if called from the top
QUIT
+3 ;
EN ; entry point to check the TREATING FACILITY LIST (TFL-391.91) file
+1 ; for the proper LAST TREATMENT DATE. This code is part of the post
+2 ; init for RG*1*4. This can also be called from the EN1 entry point
+3 ; to determine the LAST TREATMENT DATE for a specific patient.
+4 ; Closely linked to the MFU event message broadcasts used to update
+5 ; the TFL (#391.91) file.
+6 ;
+7 ;IA: 2053 - FILE^DIE
+8 ;IA: 2070 - check for national ICN, 1st piece "MPI" node (global read)
+9 ;IA: 2701 - $$IFLOCAL^MPIF001
+10 ;IA: 2546 - GETGEN/PARSE^SDOE
+11 ;IA: 2988 - FILE^VAFCTFU
+12 ;IA: 2541 - $$KSP^XUPARAM
+13 ;IA: 2953 - ^SCE("ADFN"
+14 ;IA: 10061 - IN5^VADPT
+15 ;IA: 10103 - $$FMDIFF/$$NOW^XLFDT
+16 ;IA: 10104 - $$STRIP^XLFSTR
+17 ;IA: 10070 - ^XMD
+18 ;IA: 10141 - $$PARCP/$$UPCP^XPDUTL
+19 ;
+20 ; seeding process ran in the past
if $PIECE($GET(^RGSITE(991.8,1,1)),"^",2)
QUIT
+21 ;
+22 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+23 ;defines the local facility
SET U="^"
SET RGSITE=$$KSP^XUPARAM("INST")
+24 SET RGSTRT=$$NOW^XLFDT()
SET RGCNT=0
+25 ; check to see if software is part of an KIDS install. If not, no
+26 ; checkpoints needed.
+27 SET RGICN=$SELECT($DATA(XPDNM):+$$PARCP^XPDUTL("POST2"),1:0)
+28 ; check ALL patients with an Integration Control Number (ICN) for a
+29 ; given facility, make sure the DATE LAST TREATED field in the TFL
+30 ; file is correct.
+31 FOR
SET RGICN=$ORDER(^DPT("AICN",RGICN))
if RGICN'>0
QUIT
Begin DoDot:1
+32 SET RGDFN=0
+33 FOR
SET RGDFN=$ORDER(^DPT("AICN",RGICN,RGDFN))
if RGDFN'>0
QUIT
DO EN1(RGDFN)
+34 ; increment record counter
SET RGCNT=RGCNT+1
+35 if $DATA(XPDNM)
SET RGSAVE=$$UPCP^XPDUTL("POST2",RGICN)
+36 QUIT
End DoDot:1
+37 ; send completion message to user
SET RGFIN=$$NOW^XLFDT()
DO EMAIL^RGADT2
+38 ; populate the 'MPI/PD SEEDING COMP DATE/TIME' (#12) field in the CIRN
+39 ; SITE PARAMETER FILE (#991.8) (do not re-seed a facility)
+40 KILL RGFDA
SET RGFDA(991.8,"1,",12)=$$NOW^XLFDT()
+41 DO FILE^DIE("K","RGFDA")
DO KILL
+42 QUIT
+43 ;
EN1(RGDFN,RGSUP) ; determine the LAST TREATMENT DATE for a single
+1 ; patient called from our seeding process above.
+2 ; input: RGDFN - the dfn of the patient
+3 ; RGSUP - if 1, suppress add entries to the ADT HL7 PIVOT
+4 ; (#391.71) file for TF messaging - VAFCTFMF (optional)
+5 ; output: RGDATE - patient's DATE LAST TREATED
+6 ; RGENVR - event reason
+7 ;
+8 ; local ICN
if $$LOCICN(RGDFN,$GET(RGICN))
QUIT
+9 SET U="^"
+10 ;defines the local facility
SET RGSITE=$$KSP^XUPARAM("INST")
+11 ; dt_"^"_event type or ""
SET (RGLAST,RGADMDIS)=$$ADMDIS(RGDFN)
+12 ; event dt or null
SET RGADMDIS=$SELECT(RGADMDIS]"":$PIECE(RGADMDIS,"^"),1:"")
+13 if $PIECE(RGLAST,"^",2)=3!(RGLAST="")
SET RGENCDT=$$ENCDT(RGDFN,RGADMDIS)
+14 ; patient has been discharged or has never been admitted. Has this
+15 ; individual been checked out of a clinic?
+16 IF $DATA(RGENCDT)#2
IF ($PIECE(RGLAST,U))
SET RGLAST=$SELECT(+RGENCDT>+RGLAST:RGENCDT,1:RGLAST)
+17 IF $DATA(RGENCDT)#2
IF ('$PIECE(RGLAST,U))
SET RGLAST=RGENCDT
+18 SET RGTYPE=$PIECE(RGLAST,"^",2)
SET RGDATE=+RGLAST
+19 ; input variables to FILE^VAFCTFU
+20 ; RGDFN - patient ien ; RGSITE - treating facility
+21 ; RGDATE - date last treated ; RGENVR - event reason
+22 ;
+23 IF RGDATE
DO SETMSG
DO FILE^VAFCTFU(RGDFN,RGSITE_U_RGDATE_U_RGENVR,$GET(RGSUP))
+24 ; update the TFL file for the site running the seeding process,
+25 ; then build the HL7 message with the new DATE LAST TREATED &
+26 ; ADT/HL7 EVENT REASON values & send them to our CMOR/subscribers.
+27 ;
+28 ; single patient operation, kill all
if $GET(XPDNM)'="RG*1.0*4"
DO KILL
+29 ; variables (EN1 re-entrant when running post-install for RG*1.0*4)
+30 QUIT
+31 ;
KILL ; kill and quit
+1 KILL DFN,RGADMDIS,RGCNT,RGDATE,RGDFN,RGENCDT,RGENVR,RGFDA,RGFIN,RGICN
+2 KILL RGLAST,RGSAVE,RGSITE,RGSTRT,RGTYPE
+3 QUIT
+4 ;
ADMDIS(DFN) ; find the patient's last admission and discharge dates if
+1 ; they exist.
+2 ; Input: DFN - ien of the patient (file 2)
+3 ;Output: a valid discharge/admission date/time concatenated with
+4 ; the event type (1=admission, 3=discharge) -or- null
+5 NEW %,VAERR,VAIP
SET VAIP("D")="LAST"
DO IN5^VADPT
+6 IF '+$GET(VAIP(17,1))
IF ('+$GET(VAIP(13,1)))
QUIT ""
+7 ; no discharge date, no admission date, return null
+8 IF '+$GET(VAIP(17,1))
QUIT $PIECE($GET(VAIP(13,1)),U)_"^1"
+9 ; no discharge date, return admission date
+10 IF '+$GET(VAIP(13,1))
QUIT $PIECE($GET(VAIP(17,1)),U)_"^3"
+11 ; no admission date, return discharge date
+12 IF +$GET(VAIP(17,1))>(+$GET(VAIP(13,1)))
QUIT +$GET(VAIP(17,1))_"^3"
+13 ; return discharge date
+14 ; return admission date
QUIT +$GET(VAIP(13,1))_"^1"
+15 ;
ENCDT(DFN,INPDT) ; find the last patient check out date/time. 'ADFN'
+1 ; cross-reference accessed through DBIA: 2953
+2 ; Input: DFN - ien of the patient (file 2)
+3 ; INPDT - date (if any) returned from the inpatient admission/
+4 ; discharge subroutine
+5 ;Output: a valid discharge/admission date/time concatenated with
+6 ; the event type (5=check out) -or- null
+7 ; we need dfn defined
if 'DFN
QUIT ""
+8 KILL RGDATA,RGPURGE,RGX,RGX1,RGX2
NEW RGX3
+9 SET RGX=9999999.9999999
SET RGX2=0
SET RGX3=""
+10 FOR
SET RGX=$ORDER(^SCE("ADFN",DFN,RGX),-1)
if 'RGX!(INPDT>RGX)
QUIT
Begin DoDot:1
+11 SET RGX1=0
FOR
SET RGX1=$ORDER(^SCE("ADFN",DFN,RGX,RGX1))
if 'RGX1
QUIT
Begin DoDot:2
+12 DO GETGEN^SDOE(RGX1,"RGDATA")
+13 DO PARSE^SDOE(.RGDATA,"EXTERNAL","RGPARSE")
+14 IF $GET(RGPARSE(.12))="CHECKED OUT"
SET RGX2=1
SET RGX3=RGX
+15 KILL RGDATA,RGPARSE
+16 QUIT
End DoDot:2
if RGX2
QUIT
+17 QUIT
End DoDot:1
if RGX2
QUIT
+18 KILL RGDATA,RGPURGE,RGX,RGX1,RGX2
+19 ; X is either null or the date/time of the check out
QUIT RGX3_"^5"
+20 ;
SETMSG ; define the variables used to build a HL7 message (RGADT1)
+1 SET DFN=RGDFN
+2 ;A1=adm;A2=dis;A3=CO
SET RGENVR=$SELECT(RGTYPE=1:"A1",RGTYPE=3:"A2",1:"A3")
+3 QUIT
+4 ;
EMAIL ; Send a completion email message to the user who installed this patch,
+1 ; RG*1*4. Show the number of records processed, elapsed time and the
+2 ; number of records processed per minute.
+3 NEW RGELAPS,RGARY,RGMIN
+4 SET XMDUZ=.5
SET XMY(DUZ)=""
SET XMTEXT="RGARY(1,"
+5 SET XMSUB="CIRN-CPRS DATE LAST TREATED seeding (#391.91 ; .03) results"
+6 ; # of sec x (1 min/60 sec)
SET RGMIN=$$FMDIFF^XLFDT(RGFIN,RGSTRT,2)/60
+7 ; avoid a possible divide by zero
if RGMIN=0
SET RGMIN=1
+8 SET RGELAPS=$$FMDIFF^XLFDT(RGFIN,RGSTRT,3)
+9 SET RGARY(1,1)="# of processed patients, in the PATIENT (#2) file"
+10 SET RGARY(1,2)="with an ICN: "_RGCNT
+11 SET RGARY(1,3)="TFL seeding process run time: "_RGELAPS_" (DD HH:MM:SS format)"
+12 SET RGARY(1,4)="# of records processed per minute: "_$$STRIP^XLFSTR($JUSTIFY((RGCNT/RGMIN),8,2)," ")
+13 DO ^XMD
KILL XMDUZ,XMSUB,XMTEXT,XMY
+14 QUIT
+15 ;
LOCICN(DFN,ICN) ; check if this patient has a national ICN without having a
+1 ; local ICN. This function is used when an entire site (all patients)
+2 ; is seeding, or for individual patient seeding.
+3 ; note: IA 2070 covers the hit on the 'MPI' node
+4 ; IA 2701 covers the call to $$IFLOCAL^MPIF001
+5 ;input variables:
+6 ; DFN(required)-Patient ien (PATIENT file #2)
+7 ; ICN(optional)-Integration Control Number(fld: 991.01, file 2)
+8 ;output variable:
+9 ; FLAG-0 if the patient has a national ICN and not a local ICN, else 1
+10 NEW FLAG
SET FLAG=1
+11 IF +$GET(ICN)
Begin DoDot:1
+12 IF $PIECE($GET(^DPT(DFN,"MPI")),"^")=ICN
IF ('$$IFLOCAL^MPIF001(DFN))
SET FLAG=0
+13 QUIT
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 IF $PIECE($GET(^DPT(DFN,"MPI")),"^")
IF ('$$IFLOCAL^MPIF001(DFN))
SET FLAG=0
+16 QUIT
End DoDot:1
+17 QUIT FLAG
