Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEX01.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEX01.m
r613 r623 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 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**;30 Apr 99;Build 3 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>214)&(EXCTYP<219))) S RG1=1 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 ; DFN must be defined 113 Q:'$D(DFN) 114 S EXCTYP="" 115 S HOME=$$SITE^VASITE() 116 F S EXCTYP=$O(^RGHL7(991.1,"ADFN",EXCTYP)) Q:'EXCTYP D 117 . S RGDFN="",ICN="" 118 . F S RGDFN=$O(^RGHL7(991.1,"ADFN",EXCTYP,RGDFN)) Q:'RGDFN D 119 .. I DFN=RGDFN D 120 ... S ICN=+$$GETICN^MPIF001(DFN) 121 ... ;Only set to PROCESSED if patient has national ICN. 122 ... I $E(ICN,1,3)'=$E($P(HOME,"^",3),1,3)&(ICN>0) D 123 .... ;Exclude Death exceptions (215-217); they must be processed manually. 124 .... ;Exclude 218 Potential Matches Returned exception **43 125 .... I (EXCTYP>218)!(EXCTYP<215) D 126 ..... S IEN=0 127 ..... F S IEN=$O(^RGHL7(991.1,"ADFN",EXCTYP,RGDFN,IEN)) Q:'IEN D 128 ...... S IEN2=0 129 ...... F S IEN2=$O(^RGHL7(991.1,"ADFN",EXCTYP,RGDFN,IEN,IEN2)) Q:'IEN2 D 130 ....... L +^RGHL7(991.1,IEN):10 131 ....... S DA(1)=IEN,DA=IEN2,DR="6///"_1,DIE="^RGHL7(991.1,"_DA(1)_",1," 132 ....... D ^DIE K DIE,DA,DR 133 ....... L -^RGHL7(991.1,IEN) 134 K IEN,IEN2,RGDFN,EXCTYP,ICN 135 Q 136 PDAT ; 137 K DIRUT 138 W !,"This report prints MPI/PD Data for a selected patient. The" 139 W !,"information displayed includes the Integration Control Number" 140 W !,"(ICN), patient identity information, and Treating Facility list." 141 W !!,"The information is pulled from the Patient (#2) file and the" 142 W !,"Treating Facility List (#391.91) file." 143 ; 144 ASK ;Ask for PATIENT 145 I $D(DIRUT) G QUIT 146 W !!,"Patient lookup can be done by Patient Name/SSN or by ICN.",! 147 N DFN,ICN 148 S DIC="^DPT(",DIC(0)="QEAM",DIC("A")="Select PATIENT: ",D="SSN^AICN^B^BS^BS5" 149 D MIX^DIC1 K DIC 150 G:Y<0 QUIT 151 S DFN=+Y 152 D MAIN^VAFCPDAT 153 G ASK 154 Q 155 QUIT ; 156 K DFN,ICN,D,Y,HOME
Note:
See TracChangeset
for help on using the changeset viewer.
