Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RGFICLN

RGFICLN.m

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