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