RGI15PST ;Hines OI/GJC-POST-INIT FOR RG*1.0*15 ;01/03/01
;;1.0;CLINICAL INFO RESOURCE NETWORK;**15**;30 Apr 99
;
N RGC
S RGC=$$NEWCP^XPDUTL("POST1","EN1^RGI15PST")
; Check to see the patient has had a check out event
; due to a completion of a Rad/Nuc Med, Surgery or Lab
; procedure. Checkpoint for patient's ICN while traversing
; the AICN cross reference in the Patient (#2) file.
;
S RGC=$$NEWCP^XPDUTL("POST2")
; Checkpoint for patient's dfn while traversing
; the AICN cross reference in the Patient (#2) file.
;
Q
EN1 ; 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*15.
;
; Integration Agreements (IAs) utilized in this application:
; #2988-IAs for VAFCTFU utilities
; #2911-Treating Facility List (TFL-391.91) relationship with MPI/PD
; #2070-use of Integration Control Number (ICN) 'AICN' cross reference
;
S:$D(ZTQUEUED) ZTREQ="@"
N RGDT S RGDT=$P($G(^RGSITE(991.8,1,1)),"^",3)
I RGDT D Q
.N RGTXT
.S RGTXT(1)="Data comparison ran on "_$$FMTE^XLFDT($E(RGDT,1,12),"1P")
.S RGTXT(2)="Data comparison process exiting..."
.D BMES^XPDUTL(.RGTXT)
.Q
S (RGCNT,RGCNT(0),RGXIT)=0
S RGSTART=$$FMTE^XLFDT($E($$NOW^XLFDT(),1,12),"1P") ; start time
S U="^",RGSITE=$$KSP^XUPARAM("INST") ;defines the local facility
; checkpoints for RGICN (POST1) & RGDFN (POST2)
S RGICN=+$$PARCP^XPDUTL("POST1")
; check ALL patients with an Integration Control Number (ICN) for a
; given facility, make sure the DATE LAST TREATED field in the
; TREATING FACILITY LIST (#391.91-TFL) file is correct.
F S RGICN=$O(^DPT("AICN",RGICN)) Q:RGICN'>0 D Q:RGXIT
.S RGDFN=+$$PARCP^XPDUTL("POST2")
.F S RGDFN=$O(^DPT("AICN",RGICN,RGDFN)) Q:RGDFN'>0 D Q:RGXIT
..D EN2(RGDFN)
..S RGS=$$UPCP^XPDUTL("POST2",RGDFN)
..S RGCNT=RGCNT+1
..Q:(RGCNT#250) ; every 250 patients, check if process stopped
..D:'$D(ZTQUEUED) EN^DDIOL(".",,"?0") ; print dots (process active)
..S RGXIT=$$S^%ZTLOAD() ; return 1 if user stopped the task, else 0
..S:RGXIT ZTSTOP=1 ; informs submgr to set task status to 'stopped'
..Q
.S RGS=$$UPCP^XPDUTL("POST1",RGICN)
.S RGS=$$UPCP^XPDUTL("POST2",RGDFN)
.Q
S RGFIN=$$FMTE^XLFDT($E($$NOW^XLFDT(),1,12),"1P") ; finish time
D EMAIL
I '$G(ZTSTOP) D ; only if the process runs to completion
.K RGFDA S RGFDA(991.8,"1,",13)=$$NOW^XLFDT()
.D FILE^DIE("K","RGFDA")
.Q
D KILL
QUIT
;
EN2(RGDFN) ; determine the LAST TREATMENT DATE for a single
; patient called from our seeding process above.
; input: RGDFN - the dfn of the patient
;
Q:$$LOCICN^RGADT2(RGDFN,$G(RGICN)) ; local ICN
; find the date last treated for this patient at this facility.
; check the Outpatient Encounter (OE) file for a date
; chronologically after the date/time filed in the TFL (#391.91)
; file. If a date/time exists that falls after the date/time on file
; update the CMOR/subscribers.
S RGCNT(0)=RGCNT(0)+1
S RGTFL=+$O(^DGCN(391.91,"APAT",RGDFN,RGSITE,0))
S RGDLT=$P($G(^DGCN(391.91,RGTFL,0)),U,3) ; a date/time or null
S RGDATE=$$ENCDT(RGDFN,RGDLT) ; patient's OE date/time (if any)
I $L(RGDATE),RGDATE>RGDLT D FILE^VAFCTFU(RGDFN,RGSITE_U_RGDATE_U_"A3",$G(RGSUP))
; update the TFL file for the site running the Outpatient Encounter
; check. Build the HL7 message with the new DATE LAST TREATED &
; ADT/HL7 EVENT REASON values & send them to our CMOR/subscribers.
Q
;
KILL ; kill and quit
K RGCNT,RGDATE,RGDFN,RGDLT,RGFIN,RGICN,RGPARSE,RGS,RGSITE,RGSTART
K RGTFL,RGXIT
Q
;
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) obtained from the DATE LAST TREATED
; (#.03) field on the TFL (#391.91) file.
;Output: a valid check out date/time -or- null
;
K RGDATA,RGPURGE,RGX,RGX1,RGX2 N RGX3
S RGX=$C(32),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"),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 ; X is either null or the date/time of the check out
;
EMAIL ; Send a completion email message to the user who installed this patch.
; Show the number of patient records processed, elapsed time and the
; number of patient records processed per minute.
N DIFROM,RGARY S XMDUZ=.5,XMY(DUZ)="",XMTEXT="RGARY(1,"
S XMY("G.MPIF EXCEPTIONS")="" ; keep us updated...
S XMSUB="MPI/PD-determine the correct DATE LAST TREATED"
S RGARY(1,1)="Data compare between the DATE field in the OUTPATIENT ENCOUNTER"
S RGARY(1,2)="(#409.68) file and the DATE LAST TREATED field in the TREATING"
S RGARY(1,3)="FACILITY LIST (#391.91) file"
S RGARY(1,4)="process start time: "_RGSTART
S RGARY(1,5)="process completion time: "_RGFIN
S RGARY(1,6)=" "
S RGARY(1,7)="# of processed patients, in the PATIENT (#2) file with"
S RGARY(1,8)="an ICN: "_RGCNT
S RGARY(1,9)="# of processed patients, in the PATIENT (#2) file with"
S RGARY(1,10)="a non-local ICN: "_RGCNT(0)
I $G(ZTSTOP) S RGARY(1,11)=" ",RGARY(1,12)="Note: task stopped by user intervention"
D ^XMD K XMDUZ,XMSUB,XMTEXT,XMY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGI15PST 5535 printed Sep 23, 2025@19:17:59 Page 2
RGI15PST ;Hines OI/GJC-POST-INIT FOR RG*1.0*15 ;01/03/01
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**15**;30 Apr 99
+2 ;
+3 NEW RGC
+4 SET RGC=$$NEWCP^XPDUTL("POST1","EN1^RGI15PST")
+5 ; Check to see the patient has had a check out event
+6 ; due to a completion of a Rad/Nuc Med, Surgery or Lab
+7 ; procedure. Checkpoint for patient's ICN while traversing
+8 ; the AICN cross reference in the Patient (#2) file.
+9 ;
+10 SET RGC=$$NEWCP^XPDUTL("POST2")
+11 ; Checkpoint for patient's dfn while traversing
+12 ; the AICN cross reference in the Patient (#2) file.
+13 ;
+14 QUIT
EN1 ; 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*15.
+3 ;
+4 ; Integration Agreements (IAs) utilized in this application:
+5 ; #2988-IAs for VAFCTFU utilities
+6 ; #2911-Treating Facility List (TFL-391.91) relationship with MPI/PD
+7 ; #2070-use of Integration Control Number (ICN) 'AICN' cross reference
+8 ;
+9 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+10 NEW RGDT
SET RGDT=$PIECE($GET(^RGSITE(991.8,1,1)),"^",3)
+11 IF RGDT
Begin DoDot:1
+12 NEW RGTXT
+13 SET RGTXT(1)="Data comparison ran on "_$$FMTE^XLFDT($EXTRACT(RGDT,1,12),"1P")
+14 SET RGTXT(2)="Data comparison process exiting..."
+15 DO BMES^XPDUTL(.RGTXT)
+16 QUIT
End DoDot:1
QUIT
+17 SET (RGCNT,RGCNT(0),RGXIT)=0
+18 ; start time
SET RGSTART=$$FMTE^XLFDT($EXTRACT($$NOW^XLFDT(),1,12),"1P")
+19 ;defines the local facility
SET U="^"
SET RGSITE=$$KSP^XUPARAM("INST")
+20 ; checkpoints for RGICN (POST1) & RGDFN (POST2)
+21 SET RGICN=+$$PARCP^XPDUTL("POST1")
+22 ; check ALL patients with an Integration Control Number (ICN) for a
+23 ; given facility, make sure the DATE LAST TREATED field in the
+24 ; TREATING FACILITY LIST (#391.91-TFL) file is correct.
+25 FOR
SET RGICN=$ORDER(^DPT("AICN",RGICN))
if RGICN'>0
QUIT
Begin DoDot:1
+26 SET RGDFN=+$$PARCP^XPDUTL("POST2")
+27 FOR
SET RGDFN=$ORDER(^DPT("AICN",RGICN,RGDFN))
if RGDFN'>0
QUIT
Begin DoDot:2
+28 DO EN2(RGDFN)
+29 SET RGS=$$UPCP^XPDUTL("POST2",RGDFN)
+30 SET RGCNT=RGCNT+1
+31 ; every 250 patients, check if process stopped
if (RGCNT#250)
QUIT
+32 ; print dots (process active)
if '$DATA(ZTQUEUED)
DO EN^DDIOL(".",,"?0")
+33 ; return 1 if user stopped the task, else 0
SET RGXIT=$$S^%ZTLOAD()
+34 ; informs submgr to set task status to 'stopped'
if RGXIT
SET ZTSTOP=1
+35 QUIT
End DoDot:2
if RGXIT
QUIT
+36 SET RGS=$$UPCP^XPDUTL("POST1",RGICN)
+37 SET RGS=$$UPCP^XPDUTL("POST2",RGDFN)
+38 QUIT
End DoDot:1
if RGXIT
QUIT
+39 ; finish time
SET RGFIN=$$FMTE^XLFDT($EXTRACT($$NOW^XLFDT(),1,12),"1P")
+40 DO EMAIL
+41 ; only if the process runs to completion
IF '$GET(ZTSTOP)
Begin DoDot:1
+42 KILL RGFDA
SET RGFDA(991.8,"1,",13)=$$NOW^XLFDT()
+43 DO FILE^DIE("K","RGFDA")
+44 QUIT
End DoDot:1
+45 DO KILL
+46 QUIT
+47 ;
EN2(RGDFN) ; 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 ;
+4 ; local ICN
if $$LOCICN^RGADT2(RGDFN,$GET(RGICN))
QUIT
+5 ; find the date last treated for this patient at this facility.
+6 ; check the Outpatient Encounter (OE) file for a date
+7 ; chronologically after the date/time filed in the TFL (#391.91)
+8 ; file. If a date/time exists that falls after the date/time on file
+9 ; update the CMOR/subscribers.
+10 SET RGCNT(0)=RGCNT(0)+1
+11 SET RGTFL=+$ORDER(^DGCN(391.91,"APAT",RGDFN,RGSITE,0))
+12 ; a date/time or null
SET RGDLT=$PIECE($GET(^DGCN(391.91,RGTFL,0)),U,3)
+13 ; patient's OE date/time (if any)
SET RGDATE=$$ENCDT(RGDFN,RGDLT)
+14 IF $LENGTH(RGDATE)
IF RGDATE>RGDLT
DO FILE^VAFCTFU(RGDFN,RGSITE_U_RGDATE_U_"A3",$GET(RGSUP))
+15 ; update the TFL file for the site running the Outpatient Encounter
+16 ; check. Build the HL7 message with the new DATE LAST TREATED &
+17 ; ADT/HL7 EVENT REASON values & send them to our CMOR/subscribers.
+18 QUIT
+19 ;
KILL ; kill and quit
+1 KILL RGCNT,RGDATE,RGDFN,RGDLT,RGFIN,RGICN,RGPARSE,RGS,RGSITE,RGSTART
+2 KILL RGTFL,RGXIT
+3 QUIT
+4 ;
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) obtained from the DATE LAST TREATED
+4 ; (#.03) field on the TFL (#391.91) file.
+5 ;Output: a valid check out date/time -or- null
+6 ;
+7 KILL RGDATA,RGPURGE,RGX,RGX1,RGX2
NEW RGX3
+8 SET RGX=$CHAR(32)
SET RGX2=0
SET RGX3=""
+9 FOR
SET RGX=$ORDER(^SCE("ADFN",DFN,RGX),-1)
if 'RGX!(INPDT>RGX)
QUIT
Begin DoDot:1
+10 SET RGX1=0
+11 FOR
SET RGX1=$ORDER(^SCE("ADFN",DFN,RGX,RGX1))
if 'RGX1
QUIT
Begin DoDot:2
+12 DO GETGEN^SDOE(RGX1,"RGDATA")
DO PARSE^SDOE(.RGDATA,"EXTERNAL","RGPARSE")
+13 IF $GET(RGPARSE(.12))="CHECKED OUT"
SET RGX2=1
SET RGX3=RGX
+14 KILL RGDATA,RGPARSE
+15 QUIT
End DoDot:2
if RGX2
QUIT
+16 QUIT
End DoDot:1
if RGX2
QUIT
+17 KILL RGDATA,RGPURGE,RGX,RGX1,RGX2
+18 ; X is either null or the date/time of the check out
QUIT RGX3
+19 ;
EMAIL ; Send a completion email message to the user who installed this patch.
+1 ; Show the number of patient records processed, elapsed time and the
+2 ; number of patient records processed per minute.
+3 NEW DIFROM,RGARY
SET XMDUZ=.5
SET XMY(DUZ)=""
SET XMTEXT="RGARY(1,"
+4 ; keep us updated...
SET XMY("G.MPIF EXCEPTIONS")=""
+5 SET XMSUB="MPI/PD-determine the correct DATE LAST TREATED"
+6 SET RGARY(1,1)="Data compare between the DATE field in the OUTPATIENT ENCOUNTER"
+7 SET RGARY(1,2)="(#409.68) file and the DATE LAST TREATED field in the TREATING"
+8 SET RGARY(1,3)="FACILITY LIST (#391.91) file"
+9 SET RGARY(1,4)="process start time: "_RGSTART
+10 SET RGARY(1,5)="process completion time: "_RGFIN
+11 SET RGARY(1,6)=" "
+12 SET RGARY(1,7)="# of processed patients, in the PATIENT (#2) file with"
+13 SET RGARY(1,8)="an ICN: "_RGCNT
+14 SET RGARY(1,9)="# of processed patients, in the PATIENT (#2) file with"
+15 SET RGARY(1,10)="a non-local ICN: "_RGCNT(0)
+16 IF $GET(ZTSTOP)
SET RGARY(1,11)=" "
SET RGARY(1,12)="Note: task stopped by user intervention"
+17 DO ^XMD
KILL XMDUZ,XMSUB,XMTEXT,XMY
+18 QUIT
