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

RGEX01.m

Go to the documentation of this file.
  1. RGEX01 ;BAY/ALS-LIST MANAGER FOR MPI/PD EXCEPTIONS ;10/07/99
  1. ;;1.0;CLINICAL INFO RESOURCE NETWORK;**3,12,19,23,43,45,47,48,52,57**;30 Apr 99;Build 2
  1. ;
  1. ;Reference to MAIN^VAFCPDAT supported by IA #3299
  1. EN ; -- main entry point for RG EXCPT SUMMARY
  1. N STDT,ENDDT,PRGSTAT,XFLAG,NOW,%,X,%H,%I,INDT,RUN,INDTT
  1. S XFLAG=0 D NOW^%DTC S NOW=%
  1. S STDT=$P($G(^RGSITE(991.8,1,"EXCPRG")),"^",1),INDT=STDT
  1. I $D(STDT) S STDT=$$FMTE^XLFDT(STDT,1)
  1. S PRGSTAT=$P($G(^RGSITE(991.8,1,"EXCPRG")),"^",3)
  1. ;status shows 'running' but lock shows 'not running';**47
  1. I PRGSTAT="R" D
  1. .L +^RGHL7(991.1,"RG PURGE EXCEPTION"):0 I $T D ;can get lock
  1. ..L +^RGSITE(991.8):10
  1. ..S DIE="^RGSITE(991.8,",DA=1,DR="42///@"
  1. ..D ^DIE K DA,DIE,DR ;delete old status
  1. ..L -^RGSITE(991.8)
  1. ..S PRGSTAT=""
  1. .L -^RGHL7(991.1,"RG PURGE EXCEPTION")
  1. I PRGSTAT="" D
  1. . W $C(7)
  1. . W !!,"The MPI/PD Exception Purge process has not been run."
  1. . ;**48 NO LONGER A CHOICE
  1. . W !!,"The MPI/PD Exception Purge process will now run."
  1. . W !,"Please come back to this option in five minutes."
  1. . W !!,"Please contact IRM to schedule the MPI/PD EXCEPTION PURGE"
  1. . W !,"[RG EXCEPTION PURGE] option via TaskMan with a frequency of once an hour."
  1. . S XFLAG=1 D QUEPRG
  1. L +^RGHL7(991.1,"RG PURGE EXCEPTION"):0 I '$T W $C(7),!!,"The MPI/PD Exception Purge process is currently running.",!,"Please try this option again in five minutes." S XFLAG=1 G EXIT
  1. L -^RGHL7(991.1,"RG PURGE EXCEPTION")
  1. S RUN=0
  1. I $G(PRGSTAT)="C" D
  1. . I $P(INDT,".")<$P(NOW,".") S RUN=1 ;RAN A PREVIOUS DAY
  1. . I $P(INDT,".")=$P(NOW,".") D
  1. .. S INDTT=$E($P(INDT,".",2),1,4),INDTT=INDTT+101
  1. .. I INDTT<$E($P(NOW,".",2),1,4) S RUN=1
  1. . Q:RUN=0
  1. . ;** if job ran more than 1 hour ago, run it now.
  1. . W !!,"The MPI/PD Exception Purge process last ran "_STDT_"."
  1. . W !!,"The MPI/PD Exception Purge process will now run."
  1. . W !,"Please come back to this option in five minutes."
  1. . W !!,"Please contact IRM to verify that the MPI/PD EXCEPTION PURGE "
  1. . W !,"[RG EXCEPTION PURGE] option is scheduled to run via TaskMan"
  1. . W !,"with a frequency of once an hour."
  1. . S XFLAG=1 D QUEPRG
  1. I XFLAG=1 G EXIT
  1. K RGANS
  1. D WAIT^DICD
  1. D EN^VALM("RG EXCPT SUMMARY")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. S VALMHDR(1)="MPI/PD Exception Handling"
  1. S VALMHDR(2)=""
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. I '$D(RGSORT) S RGSORT="SD"
  1. K @VALMAR
  1. I RGSORT="SD" D DTLIST^RGEXHND1
  1. E I RGSORT="ST" D EXCLST^RGEXHND1
  1. E I RGSORT="SN" D PATLST^RGEXHND1
  1. E I RGSORT="VT" D SELTYP^RGEXHND1
  1. Q
  1. ;
  1. SORT ;
  1. D INIT
  1. S VALMBCK="R"
  1. Q
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. HLPPRG ;
  1. W !,"Enter Y(YES) to run the MPI/PD Exception Purge process now."
  1. W !!,"Enter N(NO) to go directly into the MPI/PD Exception Handling option."
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K VADM,RGDFN,RGNM,RGSORT,RGSSN,STAT,STRING,NDX,NM,IEN,IEN2,X,DATA,CNT,EXCTYPE,ETYPE,^TMP("RGEXC",$J),^TMP("RGEX01",$J)
  1. Q
  1. QUEPRG S ZTRTN="MAIN^RGEVPRG",ZTDESC="PURGE ZZ*, OVER 30 DAY AND DUPLICATE RECORDS FROM THE CIRN HL7 EXCEPTION LOG FILE"
  1. D NOW^%DTC
  1. S ZTIO="",ZTDTH=%
  1. I $D(DUZ) S ZTSAVE("DUZ")=DUZ
  1. D ^%ZTLOAD
  1. D HOME^%ZIS K IO("Q")
  1. K ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,%
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;
  1. CUREX() ;**57 MPIC_1893 The CUREX module is obsolete and is no longer being called.
  1. ;Are there any patients in the CIRN HL7 EXCEPTION LOG file (#991.1)
  1. ;that are NOT PROCESSED for specific exception types?
  1. ; Return RGEX:
  1. ;If RGEX=3 both unprocessed and Primary View Reject exceptions exist
  1. ;If RGEX=2 only Primary View Reject exceptions exist
  1. ;If RGEX=1 only unprocessed exceptions exist
  1. ;If RGEX=0 no unprocessed exceptions exist
  1. ;
  1. ;N EXCTYP,RG1,RG2,RGEX
  1. ;S EXCTYP="",(RG1,RG2,RGEX)=0
  1. ;F S EXCTYP=$O(^RGHL7(991.1,"ASTAT","0",EXCTYP)) Q:'EXCTYP D
  1. ;.I (EXCTYP=234)!(EXCTYP=218) S RG1=1 ;**52 MPIC_772 remove 215, 216 & 217
  1. ;.I (EXCTYP=234) S RG2=1 ;Primary View Reject
  1. ;I (RG1=1),(RG2=1) S RGEX=3 ;Send both messages
  1. ;I (RG1=1),(RG2=0) S RGEX=1 ;Only unresolved exceptions exist
  1. ;I (RG1=0),(RG2=1) S RGEX=2 ;Only Primary View Reject exceptions exist
  1. S RGEX=0 Q RGEX
  1. ;
  1. PROC ; For a given patient, set exceptions STATUS to PROCESSED.
  1. ;**52 The PROC module is obsolete and is no longer being called.
  1. ; DFN must be defined
  1. ;Q:'$D(DFN)
  1. ;S EXCTYP=""
  1. ;S HOME=$$SITE^VASITE()
  1. ;F S EXCTYP=$O(^RGHL7(991.1,"ADFN",EXCTYP)) Q:'EXCTYP D
  1. ;. S RGDFN="",ICN=""
  1. ;. F S RGDFN=$O(^RGHL7(991.1,"ADFN",EXCTYP,RGDFN)) Q:'RGDFN D
  1. ;.. I DFN=RGDFN D
  1. ;... S ICN=+$$GETICN^MPIF001(DFN)
  1. ;... ;Only set to PROCESSED if patient has national ICN.
  1. ;... I $E(ICN,1,3)'=$E($P(HOME,"^",3),1,3)&(ICN>0) D
  1. ;.... ;Exclude Death exceptions (215-217); they must be processed manually.
  1. ;.... ;Exclude 218 Potential Matches Returned exception **43
  1. ;.... I (EXCTYP>218)!(EXCTYP<215) D
  1. ;..... S IEN=0
  1. ;..... F S IEN=$O(^RGHL7(991.1,"ADFN",EXCTYP,RGDFN,IEN)) Q:'IEN D
  1. ;...... S IEN2=0
  1. ;...... F S IEN2=$O(^RGHL7(991.1,"ADFN",EXCTYP,RGDFN,IEN,IEN2)) Q:'IEN2 D
  1. ;....... L +^RGHL7(991.1,IEN):10
  1. ;....... S DA(1)=IEN,DA=IEN2,DR="6///"_1,DIE="^RGHL7(991.1,"_DA(1)_",1,"
  1. ;....... D ^DIE K DIE,DA,DR
  1. ;....... L -^RGHL7(991.1,IEN)
  1. ;K IEN,IEN2,RGDFN,EXCTYP,ICN
  1. Q
  1. PDAT ;
  1. K DIRUT
  1. W !,"This report prints MPI/PD Data for a selected patient. The"
  1. W !,"information displayed includes the Integration Control Number"
  1. W !,"(ICN), patient identity information, and Treating Facility list."
  1. W !!,"The information is pulled from the Patient (#2) file and the"
  1. W !,"Treating Facility List (#391.91) file."
  1. ;
  1. ASK ;Ask for PATIENT
  1. I $D(DIRUT) G QUIT
  1. W !!,"Patient lookup can be done by Patient Name/SSN or by ICN.",!
  1. N DFN,ICN
  1. S DIC="^DPT(",DIC(0)="QEAM",DIC("A")="Select PATIENT: ",D="SSN^AICN^B^BS^BS5"
  1. D MIX^DIC1 K DIC
  1. G:Y<0 QUIT
  1. S DFN=+Y
  1. D MAIN^VAFCPDAT
  1. G ASK
  1. Q
  1. QUIT ;
  1. K DFN,ICN,D,Y,HOME