| 1 | RGEX01 ;BAY/ALS-LIST MANAGER FOR MPI/PD EXCEPTIONS ;10/07/99
|
|---|
| 2 | ;;1.0;CLINICAL INFO RESOURCE NETWORK;**3,12,19,23,43,45,47,48,52**;30 Apr 99;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | ;Reference to MAIN^VAFCPDAT supported by IA #3299
|
|---|
| 5 | EN ; -- main entry point for RG EXCPT SUMMARY
|
|---|
| 6 | N STDT,ENDDT,PRGSTAT,XFLAG,NOW,%,X,%H,%I,INDT,RUN,INDTT
|
|---|
| 7 | S XFLAG=0 D NOW^%DTC S NOW=%
|
|---|
| 8 | S STDT=$P($G(^RGSITE(991.8,1,"EXCPRG")),"^",1),INDT=STDT
|
|---|
| 9 | I $D(STDT) S STDT=$$FMTE^XLFDT(STDT,1)
|
|---|
| 10 | S PRGSTAT=$P($G(^RGSITE(991.8,1,"EXCPRG")),"^",3)
|
|---|
| 11 | ;status shows 'running' but lock shows 'not running';**47
|
|---|
| 12 | I PRGSTAT="R" D
|
|---|
| 13 | .L +^RGHL7(991.1,"RG PURGE EXCEPTION"):0 I $T D ;can get lock
|
|---|
| 14 | ..L +^RGSITE(991.8):10
|
|---|
| 15 | ..S DIE="^RGSITE(991.8,",DA=1,DR="42///@"
|
|---|
| 16 | ..D ^DIE K DA,DIE,DR ;delete old status
|
|---|
| 17 | ..L -^RGSITE(991.8)
|
|---|
| 18 | ..S PRGSTAT=""
|
|---|
| 19 | .L -^RGHL7(991.1,"RG PURGE EXCEPTION")
|
|---|
| 20 | I PRGSTAT="" D
|
|---|
| 21 | . W $C(7)
|
|---|
| 22 | . W !!,"The MPI/PD Exception Purge process has not been run."
|
|---|
| 23 | . ;**48 NO LONGER A CHOICE
|
|---|
| 24 | . W !!,"The MPI/PD Exception Purge process will now run."
|
|---|
| 25 | . W !,"Please come back to this option in five minutes."
|
|---|
| 26 | . W !!,"Please contact IRM to schedule the MPI/PD EXCEPTION PURGE"
|
|---|
| 27 | . W !,"[RG EXCEPTION PURGE] option via TaskMan with a frequency of once an hour."
|
|---|
| 28 | . S XFLAG=1 D QUEPRG
|
|---|
| 29 | 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
|
|---|
| 30 | L -^RGHL7(991.1,"RG PURGE EXCEPTION")
|
|---|
| 31 | S RUN=0
|
|---|
| 32 | I $G(PRGSTAT)="C" D
|
|---|
| 33 | . I $P(INDT,".")<$P(NOW,".") S RUN=1 ;RAN A PREVIOUS DAY
|
|---|
| 34 | . I $P(INDT,".")=$P(NOW,".") D
|
|---|
| 35 | .. S INDTT=$E($P(INDT,".",2),1,4),INDTT=INDTT+101
|
|---|
| 36 | .. I INDTT<$E($P(NOW,".",2),1,4) S RUN=1
|
|---|
| 37 | . Q:RUN=0
|
|---|
| 38 | . ;** if job ran more than 1 hour ago, run it now.
|
|---|
| 39 | . W !!,"The MPI/PD Exception Purge process last ran "_STDT_"."
|
|---|
| 40 | . W !!,"The MPI/PD Exception Purge process will now run."
|
|---|
| 41 | . W !,"Please come back to this option in five minutes."
|
|---|
| 42 | . W !!,"Please contact IRM to verify that the MPI/PD EXCEPTION PURGE "
|
|---|
| 43 | . W !,"[RG EXCEPTION PURGE] option is scheduled to run via TaskMan"
|
|---|
| 44 | . W !,"with a frequency of once an hour."
|
|---|
| 45 | . S XFLAG=1 D QUEPRG
|
|---|
| 46 | I XFLAG=1 G EXIT
|
|---|
| 47 | K RGANS
|
|---|
| 48 | D WAIT^DICD
|
|---|
| 49 | D EN^VALM("RG EXCPT SUMMARY")
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | HDR ; -- header code
|
|---|
| 53 | S VALMHDR(1)="MPI/PD Exception Handling"
|
|---|
| 54 | S VALMHDR(2)=""
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | INIT ; -- init variables and list array
|
|---|
| 58 | I '$D(RGSORT) S RGSORT="SD"
|
|---|
| 59 | K @VALMAR
|
|---|
| 60 | I RGSORT="SD" D DTLIST^RGEXHND1
|
|---|
| 61 | E I RGSORT="ST" D EXCLST^RGEXHND1
|
|---|
| 62 | E I RGSORT="SN" D PATLST^RGEXHND1
|
|---|
| 63 | E I RGSORT="VT" D SELTYP^RGEXHND1
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | SORT ;
|
|---|
| 67 | D INIT
|
|---|
| 68 | S VALMBCK="R"
|
|---|
| 69 | Q
|
|---|
| 70 | HELP ; -- help code
|
|---|
| 71 | S X="?" D DISP^XQORM1 W !!
|
|---|
| 72 | Q
|
|---|
| 73 | HLPPRG ;
|
|---|
| 74 | W !,"Enter Y(YES) to run the MPI/PD Exception Purge process now."
|
|---|
| 75 | W !!,"Enter N(NO) to go directly into the MPI/PD Exception Handling option."
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | EXIT ; -- exit code
|
|---|
| 79 | K VADM,RGDFN,RGNM,RGSORT,RGSSN,STAT,STRING,NDX,NM,IEN,IEN2,X,DATA,CNT,EXCTYPE,ETYPE,^TMP("RGEXC",$J),^TMP("RGEX01",$J)
|
|---|
| 80 | Q
|
|---|
| 81 | QUEPRG S ZTRTN="MAIN^RGEVPRG",ZTDESC="PURGE ZZ*, OVER 30 DAY AND DUPLICATE RECORDS FROM THE CIRN HL7 EXCEPTION LOG FILE"
|
|---|
| 82 | D NOW^%DTC
|
|---|
| 83 | S ZTIO="",ZTDTH=%
|
|---|
| 84 | I $D(DUZ) S ZTSAVE("DUZ")=DUZ
|
|---|
| 85 | D ^%ZTLOAD
|
|---|
| 86 | D HOME^%ZIS K IO("Q")
|
|---|
| 87 | K ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,%
|
|---|
| 88 | Q
|
|---|
| 89 | ;
|
|---|
| 90 | EXPND ; -- expand code
|
|---|
| 91 | Q
|
|---|
| 92 | ;
|
|---|
| 93 | CUREX() ;Are there any patients in the CIRN HL7 EXCEPTION LOG file (#991.1)
|
|---|
| 94 | ;that are NOT PROCESSED for specific exception types?
|
|---|
| 95 | ; Return RGEX:
|
|---|
| 96 | ;If RGEX=3 both unprocessed and Primary View Reject exceptions exist
|
|---|
| 97 | ;If RGEX=2 only Primary View Reject exceptions exist
|
|---|
| 98 | ;If RGEX=1 only unprocessed exceptions exist
|
|---|
| 99 | ;If RGEX=0 no unprocessed exceptions exist
|
|---|
| 100 | ;
|
|---|
| 101 | N EXCTYP,RG1,RG2,RGEX
|
|---|
| 102 | S EXCTYP="",(RG1,RG2,RGEX)=0
|
|---|
| 103 | F S EXCTYP=$O(^RGHL7(991.1,"ASTAT","0",EXCTYP)) Q:'EXCTYP D
|
|---|
| 104 | .I (EXCTYP=234)!(EXCTYP=218) S RG1=1 ;MPIC_772; **52 remove 215, 216, and 217
|
|---|
| 105 | .I (EXCTYP=234) S RG2=1 ;Primary View Reject
|
|---|
| 106 | I (RG1=1),(RG2=1) S RGEX=3 ;Send both messages
|
|---|
| 107 | I (RG1=1),(RG2=0) S RGEX=1 ;Only unresolved exceptions exist
|
|---|
| 108 | I (RG1=0),(RG2=1) S RGEX=2 ;Only Primary View Reject exceptions exist
|
|---|
| 109 | Q RGEX
|
|---|
| 110 | ;
|
|---|
| 111 | PROC ; For a given patient, set exceptions STATUS to PROCESSED.
|
|---|
| 112 | ;**52 The PROC module is obsolete and is no longer being called.
|
|---|
| 113 | ; DFN must be defined
|
|---|
| 114 | ;Q:'$D(DFN)
|
|---|
| 115 | ;S EXCTYP=""
|
|---|
| 116 | ;S HOME=$$SITE^VASITE()
|
|---|
| 117 | ;F S EXCTYP=$O(^RGHL7(991.1,"ADFN",EXCTYP)) Q:'EXCTYP D
|
|---|
| 118 | ;. S RGDFN="",ICN=""
|
|---|
| 119 | ;. F S RGDFN=$O(^RGHL7(991.1,"ADFN",EXCTYP,RGDFN)) Q:'RGDFN D
|
|---|
| 120 | ;.. I DFN=RGDFN D
|
|---|
| 121 | ;... S ICN=+$$GETICN^MPIF001(DFN)
|
|---|
| 122 | ;... ;Only set to PROCESSED if patient has national ICN.
|
|---|
| 123 | ;... I $E(ICN,1,3)'=$E($P(HOME,"^",3),1,3)&(ICN>0) D
|
|---|
| 124 | ;.... ;Exclude Death exceptions (215-217); they must be processed manually.
|
|---|
| 125 | ;.... ;Exclude 218 Potential Matches Returned exception **43
|
|---|
| 126 | ;.... I (EXCTYP>218)!(EXCTYP<215) D
|
|---|
| 127 | ;..... S IEN=0
|
|---|
| 128 | ;..... F S IEN=$O(^RGHL7(991.1,"ADFN",EXCTYP,RGDFN,IEN)) Q:'IEN D
|
|---|
| 129 | ;...... S IEN2=0
|
|---|
| 130 | ;...... F S IEN2=$O(^RGHL7(991.1,"ADFN",EXCTYP,RGDFN,IEN,IEN2)) Q:'IEN2 D
|
|---|
| 131 | ;....... L +^RGHL7(991.1,IEN):10
|
|---|
| 132 | ;....... S DA(1)=IEN,DA=IEN2,DR="6///"_1,DIE="^RGHL7(991.1,"_DA(1)_",1,"
|
|---|
| 133 | ;....... D ^DIE K DIE,DA,DR
|
|---|
| 134 | ;....... L -^RGHL7(991.1,IEN)
|
|---|
| 135 | ;K IEN,IEN2,RGDFN,EXCTYP,ICN
|
|---|
| 136 | Q
|
|---|
| 137 | PDAT ;
|
|---|
| 138 | K DIRUT
|
|---|
| 139 | W !,"This report prints MPI/PD Data for a selected patient. The"
|
|---|
| 140 | W !,"information displayed includes the Integration Control Number"
|
|---|
| 141 | W !,"(ICN), patient identity information, and Treating Facility list."
|
|---|
| 142 | W !!,"The information is pulled from the Patient (#2) file and the"
|
|---|
| 143 | W !,"Treating Facility List (#391.91) file."
|
|---|
| 144 | ;
|
|---|
| 145 | ASK ;Ask for PATIENT
|
|---|
| 146 | I $D(DIRUT) G QUIT
|
|---|
| 147 | W !!,"Patient lookup can be done by Patient Name/SSN or by ICN.",!
|
|---|
| 148 | N DFN,ICN
|
|---|
| 149 | S DIC="^DPT(",DIC(0)="QEAM",DIC("A")="Select PATIENT: ",D="SSN^AICN^B^BS^BS5"
|
|---|
| 150 | D MIX^DIC1 K DIC
|
|---|
| 151 | G:Y<0 QUIT
|
|---|
| 152 | S DFN=+Y
|
|---|
| 153 | D MAIN^VAFCPDAT
|
|---|
| 154 | G ASK
|
|---|
| 155 | Q
|
|---|
| 156 | QUIT ;
|
|---|
| 157 | K DFN,ICN,D,Y,HOME
|
|---|
