- 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 Feb 18, 2025@23:08:12 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)