RGFICLN ;ALB/CJM-MPI/PD NDBI SITE CLEANUP UTILITY ;08/27/99
;;1.0; CLINICAL INFO RESOURCE NETWORK ;**9**;30 Apr 99
;
;Description:
;Looks for patients that have the legacy site as a treating facilty or
;as the CMOR and replaces it with the primary site.
;
;This utility can be executed in a test mode by setting the TESTMODE
;input parameter to 1.
;
CLEAN(LEGACY,PRIMARY,TESTMODE,ERROR) ;
;Input:
; LEGACY - station # of legacy site
; PRIMARY - station # of primary site
; TESTMODE - set to 1 if this routine is to be run in interactive mode
;Output:
; Function Value: 1 on success, 0 on failure
; ERROR: optional error msg returned on failure (pass by reference)
; ** Also sends a report to the MPI EXCEPTIONS mailgroup
;
;Variables:
; LEGACY("PTR"): ien of the legacy site in the Institution file
; PRIMARY("PTR"): ien of the primary site in the institution file
;
S TESTMODE=+$G(TESTMODE)
Q:'$$LOOKUP(.LEGACY,.PRIMARY,.ERROR) 0
D LOOP(.LEGACY,.PRIMARY)
Q 1
;
LOOKUP(LEGACY,PRIMARY,ERROR) ;
;Does a lookup on the Institution file for the legacy and primary site
;Input:
; LEGACY - station # of legacy site
; PRIMARY - station # of primary site
;Output:
; function value - 1 on success, 0 on faiure
; LEGACY("PTR") - the ien (optional, pass LEGACY by reference)
; PRIMARY("PTR") - the ien (optional, pass PRIMARY by reference)
; ERROR - error message on failure (optional, pass by reference)
;
S LEGACY("PTR")=$$LKUP^XUAF4($G(LEGACY))
I 'LEGACY("PTR") S ERROR="LEGACY STATION NUMBER NOT FOUND UNIQUELY IN THE INSTITUTION FILE!" Q 0
S PRIMARY("PTR")=$$LKUP^XUAF4($G(PRIMARY))
I 'PRIMARY("PTR") S ERROR="PRIMARY STATION NUMBER NOT FOUND UNIQUELY IN THE INSTITUTION FILE!" Q 0
Q 1
;
LOOP(LEGACY,PRIMARY) ;
;Description: Looks for patients having the Legacy site as the CMOR
;or as a TF and for each such patient exchanges the legacy site with the
;primary site.
;
;Input:
; LEGACY(): as above
; PRIMARY(): as above
;Output:
; MPI/NDBI SITE CLEANUP REPORT mailed to the MPI EXCEPTIONS mailgroup
;VARIABLES:
; RGREPORT - @RGREPORT will store interim results for the report
; COUNT("TF") - count of patients found with legacy as TF
; COUNT("CMOR") - count of patients found with legacy as CMOR
; HERE - station # of the site this is running on
; CMOR - patient's CMOR
; CMOR("#") - station # of patient's CMOR
;
N DFN,COUNT,RGREPORT,HERE
S RGREPORT="^TMP($J,""RG FACILITY INTEGRATION CLEANUP"")"
K @RGREPORT
S HERE=$P($$SITE^VASITE(),"^",3)
;
;don't do this if this is the legacy site
Q:(HERE=LEGACY)
;
S (COUNT("TF"),COUNT("CMOR"),DFN)=0
I TESTMODE W !!,"Looking for patients with legacy site as CMOR ..."
F S DFN=$O(^DPT("ACMOR",LEGACY("PTR"),DFN)) Q:'DFN D I TESTMODE Q:'$$ASKYESNO^RGFIU("Another","YES")
.N CMOR
.S CMOR=$$GETFIELD^RGFIU(2,991.03,DFN)
.Q:(CMOR'=LEGACY("PTR"))
.I TESTMODE Q:'$$ASKOK(DFN)
.D PROC
.D CMORADD(RGREPORT,.COUNT,DFN)
;
I TESTMODE W !!,"Looking for patients with legacy site as treating facility ..."
S DFN=0
F S DFN=$O(^DGCN(391.91,"AINST",LEGACY("PTR"),DFN)) Q:'DFN D I TESTMODE Q:'$$ASKYESNO^RGFIU("Another","YES")
.N CMOR
.I TESTMODE Q:'$$ASKOK(DFN)
.S CMOR=$$GETFIELD^RGFIU(2,991.03,DFN)
.D PROC
.D TFADD(RGREPORT,.COUNT,DFN)
I $G(TESTMODE) W !,"Returned mail message number:",$$REPORT(.COUNT,RGREPORT,LEGACY,PRIMARY)
I '$G(TESTMODE),$$REPORT(.COUNT,RGREPORT,LEGACY,PRIMARY)
K @RGREPORT
Q
;
PROC ;
N RES,ERROR,I
I '$$XCHANGE^RGFIPM(DFN,LEGACY,PRIMARY,.ERROR),TESTMODE W !,"** ERROR: ",$G(ERROR)
S CMOR("#")=$$STATNUM^RGFIU(CMOR)
I HERE=CMOR("#") D
.I TESTMODE D
..I $$SEND^RGFIBM(DFN,LEGACY,PRIMARY,.RES,.ERROR) W !,"HL7 Message sent: "
..E W !,"*** HL7 Message NOT sent! :",$G(ERROR)
..I $D(RES) S I=0 W !," Msg 1: ",RES F S I=$O(RES(I)) Q:'I W !," Msg ",(I+1),": ",RES(I)
.I 'TESTMODE,$$SEND^RGFIBM(DFN,LEGACY,PRIMARY,.RES,.ERROR)
Q
;
TFADD(RGREPORT,COUNT,DFN) ;
;adds patient to list of legacy as TF
S COUNT("TF")=COUNT("TF")+1
S @RGREPORT@("TF",DFN)=""
Q
;
CMORADD(RGREPORT,COUNT,DFN) ;
;adds patient to list of legacy as CMOR
;
S COUNT("CMOR")=COUNT("CMOR")+1
S @RGREPORT@("CMOR",DFN)=""
Q
;
ASKOK(DFN) ;
;Discription: Displays the CMOR and TF's for a single patient and asks whether to process
;
;Input:
; DFN - patient that was just processed
;Output:
; Function value - 1 to quit, 0 to continue
;Variables:
; MPIDATA() - to contain the MPI data
;
N SUB,MPIDATA
D GETALL^RGFIU(DFN,.MPIDATA)
W !!
W !,"Patient DFN: ",DFN
W !,"Patient Name: ",$$NAME^RGFIU(DFN)_" SSN: ",$$SSN^RGFIU(DFN)
W !,"Patient ICN: ",MPIDATA("ICN"),$S(MPIDATA("LOC"):" (local)",1:"")," CMOR: ",MPIDATA("CMOR")
;
W !,"Treating Facilities:"
S SUB=0
F S SUB=$O(MPIDATA("TF",SUB)) Q:'SUB W !," ",SUB
;
Q $$ASKYESNO^RGFIU("Process patient")
;
REPORT(COUNT,RGREPORT,LEGACY,PRIMARY) ;
;Description: Mails report of cases found requiring cleanup after a site integration
;
;Input:
; RGREPORT - @RGREPORT is the location of the report data
; COUNT() - contains counts of patients cleaned up (pass by reference)
; LEGACY - legacy site station #
; PRIMARY - primary site station #
;Output: none
;
;
N DFN,LINECNT
S (DFN,LINECNT)=0
K @RGREPORT@("MAILTEXT")
D HEADER
D ADDLINE("** Patients with Legacy Site as CMOR **")
D ADDLINE(" ")
F S DFN=$O(@RGREPORT@("CMOR",DFN)) Q:'DFN D
.D ADDLINE("Patient: "_$$LJ^XLFSTR($$NAME^RGFIU(DFN),30)_" SSN: "_$$SSN^RGFIU(DFN)_" ICN: "_$$ICN^RGFIU(DFN))
D ADDLINE(" "),ADDLINE(" ")
D ADDLINE("** Patients with Legacy Site as Treating Facility **")
D ADDLINE(" ")
S DFN=0
F S DFN=$O(@RGREPORT@("TF",DFN)) Q:'DFN D
.D ADDLINE("Patient: "_$$LJ^XLFSTR($$NAME^RGFIU(DFN),30)_" SSN: "_$$SSN^RGFIU(DFN)_" ICN: "_$$ICN^RGFIU(DFN))
D ADDLINE(" "),ADDLINE("** END OF MPI/NDBI SITE CLEANUP REPORT **")
Q $$MAIL
;
D ADDLINE("MPI/NDBI SITE CLEANUP REPORT FROM "_$P($$SITE^VASITE(),"^",2)_" DATE: "_$$FMTE^XLFDT(DT,"1"))
D ADDLINE("Primary Station: "_PRIMARY_" Legacy Station: "_LEGACY)
D ADDLINE("Count of Patients Found with Legacy Site as CMOR: "_COUNT("CMOR"))
D ADDLINE("Count of Patients Found with Legacy Site as Treating Facility: "_COUNT("TF"))
D ADDLINE(" ")
Q
;
ADDLINE(LINE) ;
;Description: adds one one to the message text
;Inputs:
; LINE - the line of text to be added
; RGREPORT - @RGREPORT is the location of the report
; LINECNT - should be defined, the count of lines added to mail msg
S LINECNT=$G(LINECNT)+1
S @RGREPORT@("MAILTEXT",LINECNT)=LINE
Q
MAIL() ;
N XMY,XMSUB,XMDUZ,XMTEXT,XMZ,XMDUN,DIFROM
S XMY=.5
S XMDUZ="MPI/PD at "_$P($$SITE^VASITE(),"^",2)
I $G(DUZ) S XMY(DUZ)=""
S XMY("G.MPIF EXCEPTIONS")=""
S XMTEXT=$P(RGREPORT,")")_",""MAILTEXT"","
S XMSUB="MPI/NDBI SITE CLEANUP"
D ^XMD
Q $G(XMZ)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGFICLN 7012 printed Sep 23, 2025@19:17:48 Page 2
RGFICLN ;ALB/CJM-MPI/PD NDBI SITE CLEANUP UTILITY ;08/27/99
+1 ;;1.0; CLINICAL INFO RESOURCE NETWORK ;**9**;30 Apr 99
+2 ;
+3 ;Description:
+4 ;Looks for patients that have the legacy site as a treating facilty or
+5 ;as the CMOR and replaces it with the primary site.
+6 ;
+7 ;This utility can be executed in a test mode by setting the TESTMODE
+8 ;input parameter to 1.
+9 ;
CLEAN(LEGACY,PRIMARY,TESTMODE,ERROR) ;
+1 ;Input:
+2 ; LEGACY - station # of legacy site
+3 ; PRIMARY - station # of primary site
+4 ; TESTMODE - set to 1 if this routine is to be run in interactive mode
+5 ;Output:
+6 ; Function Value: 1 on success, 0 on failure
+7 ; ERROR: optional error msg returned on failure (pass by reference)
+8 ; ** Also sends a report to the MPI EXCEPTIONS mailgroup
+9 ;
+10 ;Variables:
+11 ; LEGACY("PTR"): ien of the legacy site in the Institution file
+12 ; PRIMARY("PTR"): ien of the primary site in the institution file
+13 ;
+14 SET TESTMODE=+$GET(TESTMODE)
+15 if '$$LOOKUP(.LEGACY,.PRIMARY,.ERROR)
QUIT 0
+16 DO LOOP(.LEGACY,.PRIMARY)
+17 QUIT 1
+18 ;
LOOKUP(LEGACY,PRIMARY,ERROR) ;
+1 ;Does a lookup on the Institution file for the legacy and primary site
+2 ;Input:
+3 ; LEGACY - station # of legacy site
+4 ; PRIMARY - station # of primary site
+5 ;Output:
+6 ; function value - 1 on success, 0 on faiure
+7 ; LEGACY("PTR") - the ien (optional, pass LEGACY by reference)
+8 ; PRIMARY("PTR") - the ien (optional, pass PRIMARY by reference)
+9 ; ERROR - error message on failure (optional, pass by reference)
+10 ;
+11 SET LEGACY("PTR")=$$LKUP^XUAF4($GET(LEGACY))
+12 IF 'LEGACY("PTR")
SET ERROR="LEGACY STATION NUMBER NOT FOUND UNIQUELY IN THE INSTITUTION FILE!"
QUIT 0
+13 SET PRIMARY("PTR")=$$LKUP^XUAF4($GET(PRIMARY))
+14 IF 'PRIMARY("PTR")
SET ERROR="PRIMARY STATION NUMBER NOT FOUND UNIQUELY IN THE INSTITUTION FILE!"
QUIT 0
+15 QUIT 1
+16 ;
LOOP(LEGACY,PRIMARY) ;
+1 ;Description: Looks for patients having the Legacy site as the CMOR
+2 ;or as a TF and for each such patient exchanges the legacy site with the
+3 ;primary site.
+4 ;
+5 ;Input:
+6 ; LEGACY(): as above
+7 ; PRIMARY(): as above
+8 ;Output:
+9 ; MPI/NDBI SITE CLEANUP REPORT mailed to the MPI EXCEPTIONS mailgroup
+10 ;VARIABLES:
+11 ; RGREPORT - @RGREPORT will store interim results for the report
+12 ; COUNT("TF") - count of patients found with legacy as TF
+13 ; COUNT("CMOR") - count of patients found with legacy as CMOR
+14 ; HERE - station # of the site this is running on
+15 ; CMOR - patient's CMOR
+16 ; CMOR("#") - station # of patient's CMOR
+17 ;
+18 NEW DFN,COUNT,RGREPORT,HERE
+19 SET RGREPORT="^TMP($J,""RG FACILITY INTEGRATION CLEANUP"")"
+20 KILL @RGREPORT
+21 SET HERE=$PIECE($$SITE^VASITE(),"^",3)
+22 ;
+23 ;don't do this if this is the legacy site
+24 if (HERE=LEGACY)
QUIT
+25 ;
+26 SET (COUNT("TF"),COUNT("CMOR"),DFN)=0
+27 IF TESTMODE
WRITE !!,"Looking for patients with legacy site as CMOR ..."
+28 FOR
SET DFN=$ORDER(^DPT("ACMOR",LEGACY("PTR"),DFN))
if 'DFN
QUIT
Begin DoDot:1
+29 NEW CMOR
+30 SET CMOR=$$GETFIELD^RGFIU(2,991.03,DFN)
+31 if (CMOR'=LEGACY("PTR"))
QUIT
+32 IF TESTMODE
if '$$ASKOK(DFN)
QUIT
+33 DO PROC
+34 DO CMORADD(RGREPORT,.COUNT,DFN)
End DoDot:1
IF TESTMODE
if '$$ASKYESNO^RGFIU("Another","YES")
QUIT
+35 ;
+36 IF TESTMODE
WRITE !!,"Looking for patients with legacy site as treating facility ..."
+37 SET DFN=0
+38 FOR
SET DFN=$ORDER(^DGCN(391.91,"AINST",LEGACY("PTR"),DFN))
if 'DFN
QUIT
Begin DoDot:1
+39 NEW CMOR
+40 IF TESTMODE
if '$$ASKOK(DFN)
QUIT
+41 SET CMOR=$$GETFIELD^RGFIU(2,991.03,DFN)
+42 DO PROC
+43 DO TFADD(RGREPORT,.COUNT,DFN)
End DoDot:1
IF TESTMODE
if '$$ASKYESNO^RGFIU("Another","YES")
QUIT
+44 IF $GET(TESTMODE)
WRITE !,"Returned mail message number:",$$REPORT(.COUNT,RGREPORT,LEGACY,PRIMARY)
+45 IF '$GET(TESTMODE)
IF $$REPORT(.COUNT,RGREPORT,LEGACY,PRIMARY)
+46 KILL @RGREPORT
+47 QUIT
+48 ;
PROC ;
+1 NEW RES,ERROR,I
+2 IF '$$XCHANGE^RGFIPM(DFN,LEGACY,PRIMARY,.ERROR)
IF TESTMODE
WRITE !,"** ERROR: ",$GET(ERROR)
+3 SET CMOR("#")=$$STATNUM^RGFIU(CMOR)
+4 IF HERE=CMOR("#")
Begin DoDot:1
+5 IF TESTMODE
Begin DoDot:2
+6 IF $$SEND^RGFIBM(DFN,LEGACY,PRIMARY,.RES,.ERROR)
WRITE !,"HL7 Message sent: "
+7 IF '$TEST
WRITE !,"*** HL7 Message NOT sent! :",$GET(ERROR)
+8 IF $DATA(RES)
SET I=0
WRITE !," Msg 1: ",RES
FOR
SET I=$ORDER(RES(I))
if 'I
QUIT
WRITE !," Msg ",(I+1),": ",RES(I)
End DoDot:2
+9 IF 'TESTMODE
IF $$SEND^RGFIBM(DFN,LEGACY,PRIMARY,.RES,.ERROR)
End DoDot:1
+10 QUIT
+11 ;
TFADD(RGREPORT,COUNT,DFN) ;
+1 ;adds patient to list of legacy as TF
+2 SET COUNT("TF")=COUNT("TF")+1
+3 SET @RGREPORT@("TF",DFN)=""
+4 QUIT
+5 ;
CMORADD(RGREPORT,COUNT,DFN) ;
+1 ;adds patient to list of legacy as CMOR
+2 ;
+3 SET COUNT("CMOR")=COUNT("CMOR")+1
+4 SET @RGREPORT@("CMOR",DFN)=""
+5 QUIT
+6 ;
ASKOK(DFN) ;
+1 ;Discription: Displays the CMOR and TF's for a single patient and asks whether to process
+2 ;
+3 ;Input:
+4 ; DFN - patient that was just processed
+5 ;Output:
+6 ; Function value - 1 to quit, 0 to continue
+7 ;Variables:
+8 ; MPIDATA() - to contain the MPI data
+9 ;
+10 NEW SUB,MPIDATA
+11 DO GETALL^RGFIU(DFN,.MPIDATA)
+12 WRITE !!
+13 WRITE !,"Patient DFN: ",DFN
+14 WRITE !,"Patient Name: ",$$NAME^RGFIU(DFN)_" SSN: ",$$SSN^RGFIU(DFN)
+15 WRITE !,"Patient ICN: ",MPIDATA("ICN"),$SELECT(MPIDATA("LOC"):" (local)",1:"")," CMOR: ",MPIDATA("CMOR")
+16 ;
+17 WRITE !,"Treating Facilities:"
+18 SET SUB=0
+19 FOR
SET SUB=$ORDER(MPIDATA("TF",SUB))
if 'SUB
QUIT
WRITE !," ",SUB
+20 ;
+21 QUIT $$ASKYESNO^RGFIU("Process patient")
+22 ;
REPORT(COUNT,RGREPORT,LEGACY,PRIMARY) ;
+1 ;Description: Mails report of cases found requiring cleanup after a site integration
+2 ;
+3 ;Input:
+4 ; RGREPORT - @RGREPORT is the location of the report data
+5 ; COUNT() - contains counts of patients cleaned up (pass by reference)
+6 ; LEGACY - legacy site station #
+7 ; PRIMARY - primary site station #
+8 ;Output: none
+9 ;
+10 ;
+11 NEW DFN,LINECNT
+12 SET (DFN,LINECNT)=0
+13 KILL @RGREPORT@("MAILTEXT")
+14 DO HEADER
+15 DO ADDLINE("** Patients with Legacy Site as CMOR **")
+16 DO ADDLINE(" ")
+17 FOR
SET DFN=$ORDER(@RGREPORT@("CMOR",DFN))
if 'DFN
QUIT
Begin DoDot:1
+18 DO ADDLINE("Patient: "_$$LJ^XLFSTR($$NAME^RGFIU(DFN),30)_" SSN: "_$$SSN^RGFIU(DFN)_" ICN: "_$$ICN^RGFIU(DFN))
End DoDot:1
+19 DO ADDLINE(" ")
DO ADDLINE(" ")
+20 DO ADDLINE("** Patients with Legacy Site as Treating Facility **")
+21 DO ADDLINE(" ")
+22 SET DFN=0
+23 FOR
SET DFN=$ORDER(@RGREPORT@("TF",DFN))
if 'DFN
QUIT
Begin DoDot:1
+24 DO ADDLINE("Patient: "_$$LJ^XLFSTR($$NAME^RGFIU(DFN),30)_" SSN: "_$$SSN^RGFIU(DFN)_" ICN: "_$$ICN^RGFIU(DFN))
End DoDot:1
+25 DO ADDLINE(" ")
DO ADDLINE("** END OF MPI/NDBI SITE CLEANUP REPORT **")
+26 QUIT $$MAIL
+27 ;
+1 DO ADDLINE("MPI/NDBI SITE CLEANUP REPORT FROM "_$PIECE($$SITE^VASITE(),"^",2)_" DATE: "_$$FMTE^XLFDT(DT,"1"))
+2 DO ADDLINE("Primary Station: "_PRIMARY_" Legacy Station: "_LEGACY)
+3 DO ADDLINE("Count of Patients Found with Legacy Site as CMOR: "_COUNT("CMOR"))
+4 DO ADDLINE("Count of Patients Found with Legacy Site as Treating Facility: "_COUNT("TF"))
+5 DO ADDLINE(" ")
+6 QUIT
+7 ;
ADDLINE(LINE) ;
+1 ;Description: adds one one to the message text
+2 ;Inputs:
+3 ; LINE - the line of text to be added
+4 ; RGREPORT - @RGREPORT is the location of the report
+5 ; LINECNT - should be defined, the count of lines added to mail msg
+6 SET LINECNT=$GET(LINECNT)+1
+7 SET @RGREPORT@("MAILTEXT",LINECNT)=LINE
+8 QUIT
MAIL() ;
+1 NEW XMY,XMSUB,XMDUZ,XMTEXT,XMZ,XMDUN,DIFROM
+2 SET XMY=.5
+3 SET XMDUZ="MPI/PD at "_$PIECE($$SITE^VASITE(),"^",2)
+4 IF $GET(DUZ)
SET XMY(DUZ)=""
+5 SET XMY("G.MPIF EXCEPTIONS")=""
+6 SET XMTEXT=$PIECE(RGREPORT,")")_",""MAILTEXT"","
+7 SET XMSUB="MPI/NDBI SITE CLEANUP"
+8 DO ^XMD
+9 QUIT $GET(XMZ)
