Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEXHND1.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/RGEXHND1.m
r613 r623 1 RGEXHND1 ;BAY/ALS-MPI/PD EXCEPTION HANDLING UTILITY ;10/08/99 2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**3,12,19,23,43,45,52**;30 Apr 99;Build 2 3 DTLIST ;List exceptions by date 4 K ^TMP("RGEXC",$J) 5 I '$D(RGBG) S VALMBG=1 6 ;**45 list exception 234 first regardless of date - Primary View Reject 7 S EXCDT="",EXCTYP=234,(CNT,IEN)=0 8 F S IEN=$O(^RGHL7(991.1,"ASTAT","0",EXCTYP,IEN)) Q:'IEN D 9 .S IEN2=0 10 .F S IEN2=$O(^RGHL7(991.1,"ASTAT","0",EXCTYP,IEN,IEN2)) Q:'IEN2 D 11 ..S EXCDT=$P(^RGHL7(991.1,IEN,0),"^",3) 12 ..D ADDREC 13 S EXCDT="",EXCTYP="" 14 F S EXCDT=$O(^RGHL7(991.1,"AD",EXCDT)) Q:'EXCDT D 15 . S IEN=0 16 . F S IEN=$O(^RGHL7(991.1,"AD",EXCDT,IEN)) Q:'IEN D 17 .. S NUM="" S NUM=$P($G(^RGHL7(991.1,IEN,1,0)),"^",4) Q:NUM<1 D 18 ... S IEN2=0 19 ... F S IEN2=$O(^RGHL7(991.1,IEN,1,IEN2)) Q:'IEN2 D 20 .... S EXCTYP=$P(^RGHL7(991.1,IEN,1,IEN2,0),"^",3) 21 ....;don't include 234 below; those were done first (above). 22 .... I EXCTYP=218 D ADDREC ;**45;MPIC_772; **52 remove 215, 216, and 217 23 K I,NUM,EXCDT,EXCTYP,RGBG 24 IF CNT<1 D NDATA 25 Q 26 ; 27 NDATA ; There is no data matching the criteria 28 S CNT=CNT+1,STRING="" 29 S STRING=$$SETSTR^VALM1("There were no exceptions found.",STRING,5,35) 30 S ^TMP("RGEXC",$J,CNT,0)=STRING 31 S ^TMP("RGEXC",$J,"IDX",CNT,CNT)="" 32 S VALMCNT=CNT 33 Q 34 EXCLST ;List exceptions by type 35 K ^TMP("RGEXC",$J) 36 S CNT=0,EXCDT="",EXCTYP="" 37 I '$D(RGBG) S VALMBG=1 38 F S EXCTYP=$O(^RGHL7(991.1,"AC",EXCTYP)) Q:'EXCTYP D 39 . I (EXCTYP=234)!(EXCTYP=218) D ;**45;MPIC_772; **52 remove 215, 216, and 217 40 .. S IEN=0 41 .. F S IEN=$O(^RGHL7(991.1,"AC",EXCTYP,IEN)) Q:'IEN D 42 ... S NUM="" S NUM=$P($G(^RGHL7(991.1,IEN,1,0)),"^",4) Q:NUM<1 D 43 .... S IEN2=0 44 .... F S IEN2=$O(^RGHL7(991.1,"AC",EXCTYP,IEN,IEN2)) Q:'IEN2 D 45 ..... S EXCDT=$P($G(^RGHL7(991.1,IEN,0)),"^",3) Q:'EXCDT 46 ..... D ADDREC 47 IF CNT<1 D NDATA 48 K RGBG 49 Q 50 PATLST ;List exceptions by patient 51 K ^TMP("RGEXC",$J),^TMP("RGEX01",$J) 52 S CNT=0,EXCDT="",EXCTYP="",NDX=0,NAME="" 53 I '$D(RGBG) S VALMBG=1 54 F S EXCTYP=$O(^RGHL7(991.1,"ADFN",EXCTYP)) Q:'EXCTYP D 55 . I (EXCTYP=234)!(EXCTYP=218) D ;**45;MPIC_772; **52 remove 215, 216, and 217 56 .. S DFN="" 57 .. F S DFN=$O(^RGHL7(991.1,"ADFN",EXCTYP,DFN)) Q:'DFN D 58 ... S IEN=0 59 ... F S IEN=$O(^RGHL7(991.1,"ADFN",EXCTYP,DFN,IEN)) Q:'IEN D 60 .... S IEN2=0 61 .... F S IEN2=$O(^RGHL7(991.1,"ADFN",EXCTYP,DFN,IEN,IEN2)) Q:'IEN2 D 62 ..... S EXCDT=$P($G(^RGHL7(991.1,IEN,0)),"^",3) Q:'EXCDT 63 ..... D DEM^VADPT S NAME=VADM(1) Q:NAME="" 64 ..... S NDX=NDX+1 65 ..... S ^TMP("RGEX01",$J,NAME,NDX)=$G(VADM(1))_"^"_IEN_"^"_IEN2_"^"_EXCTYP_"^"_EXCDT 66 D PATTMP 67 IF CNT<1 D NDATA 68 K DFN,RGBG 69 Q 70 PATTMP ; 71 S NM="" 72 F S NM=$O(^TMP("RGEX01",$J,NM)) Q:NM="" D 73 . S NDX=0 74 . F S NDX=$O(^TMP("RGEX01",$J,NM,NDX)) Q:'NDX D 75 .. S IEN=$P(^TMP("RGEX01",$J,NM,NDX),"^",2) 76 .. S IEN2=$P(^TMP("RGEX01",$J,NM,NDX),"^",3) 77 .. S EXCTYP=$P(^TMP("RGEX01",$J,NM,NDX),"^",4) 78 .. S EXCDT=$P(^TMP("RGEX01",$J,NM,NDX),"^",5) 79 .. D ADDREC 80 K NDX,NM,NAME 81 Q 82 SELTYP ; List all exceptions of type selected by user 83 S EXCTYPE="",FLAG=0,ETYPE="" 84 I '$D(RGBG) S VALMBG=1 85 K DIR,Y,DIC 86 S DIR("A")="Enter an exception type to view: " 87 S DIR(0)="SAM^218:Potential Matches Returned;234:Primary View Reject" ;**43;**45;MPIC_772; **52 remove 215, 216, and 217 88 S DIR("?")="^D HLPSEL^RGEXHND1" 89 D ^DIR 90 I Y<1 S RGSORT="SD" D SORT^RGEX01 Q 91 Q:$D(DUOUT)!$D(DTOUT) 92 S EXCTYPE=+Y,ETYPE=$P(^RGHL7(991.11,EXCTYPE,10),"^",1) 93 I (EXCTYPE=234)!(EXCTYPE=218) S FLAG=1 ;**43;**45;MPIC_772; **52 remove 215, 216, and 217 94 I FLAG=1 D ADDSEL 95 E I FLAG=0 D 96 . W !,"Not a valid selection." 97 . D SELTYP 98 K FLAG,Y,DIR,DIC,DTOUT,DUOUT,RGBG 99 Q 100 ADDSEL ;called by SELTYP 101 K ^TMP("RGEXC",$J) 102 S CNT=0,EXCDT="",EXCTYP="" 103 F S EXCTYP=$O(^RGHL7(991.1,"AC",EXCTYP)) Q:'EXCTYP D 104 . I EXCTYP=EXCTYPE D 105 .. S IEN=0 106 .. F S IEN=$O(^RGHL7(991.1,"AC",EXCTYP,IEN)) Q:'IEN D 107 ... S IEN2=0 108 ... F S IEN2=$O(^RGHL7(991.1,"AC",EXCTYP,IEN,IEN2)) Q:'IEN2 D 109 .... S EXCDT=$P($G(^RGHL7(991.1,IEN,0)),"^",3) Q:'EXCDT ;**43 110 .... D ADDREC 111 I CNT<1 D 112 . W !,"There are no "_ETYPE 113 . W !,"exceptions that need processing." 114 . D SELTYP 115 Q 116 HLPSEL ; 117 D FULL^VALM1 118 ;W !,"The following exception types are handled by this option:" 119 ;W !,"Potential Matches Returned",?50,"(218)" 120 ;W !,"Primary View Reject",?50,"(234)" 121 S VALMBCK="R" 122 Q 123 ADDREC ; 124 S ETEXT="",RGDFN="",ICN="",RGNM="",STAT="",DOD="" 125 S ETEXT=$P($G(^RGHL7(991.11,EXCTYP,10)),"^",1) 126 S RGDFN=$P(^RGHL7(991.1,IEN,1,IEN2,0),"^",4) Q:'RGDFN 127 S STAT=$P($G(^RGHL7(991.1,IEN,1,IEN2,0)),"^",5) 128 S ICN=+$$GETICN^MPIF001(RGDFN) 129 S HOME=$$SITE^VASITE() 130 I (STAT<1)!(STAT="") D 131 .;Only list exceptions that are Not Processed 132 .; only list patients with local ICN, or for exceptions 234 or 218;MPIC_772; **52 remove 215, 216, and 217 133 . I $E(ICN,1,3)=$E($P(HOME,"^",3),1,3)!(ICN<0)!(EXCTYP=234)!(EXCTYP=218) D ;**43,**45,**52 134 .. S DFN=RGDFN D DEM^VADPT 135 .. S RGNM=VADM(1) 136 .. S RGSSN=$P($G(VADM(2)),"^",1) 137 .. S DOB=$G(VADM(3)) I DOB="" S DOB="^" 138 .. S DOD=$P($P($G(VADM(6)),"^",2),"@",1) 139 .. S EXDATE=$P($$FMTE^XLFDT(EXCDT,2),"@",1) 140 .. S CNT=CNT+1 141 .. S STRING="" 142 .. I ICN<0 S ICN="" 143 .. S STRING=$$SETSTR^VALM1(CNT,STRING,1,4) 144 .. S STRING=$$SETSTR^VALM1($E(RGNM,1,22),STRING,6,21) 145 .. S STRING=$$SETSTR^VALM1(RGSSN,STRING,28,10) 146 .. S STRING=$$SETSTR^VALM1(EXDATE,STRING,39,8) 147 .. S STRING=$$SETSTR^VALM1(ETEXT,STRING,49,32) 148 .. S ^TMP("RGEXC",$J,CNT,0)=STRING 149 .. S ^TMP("RGEXC",$J,"IDX",CNT,CNT)="" 150 .. S ^TMP("RGEXC",$J,CNT,"DATA")=RGNM_"^"_RGSSN_"^"_$P($$FMTE^XLFDT(EXCDT),"@",1)_"^"_ETEXT_"^"_DFN_"^"_ICN_"^"_DOB_"^"_STAT_"^"_IEN_"^"_IEN2_"^"_CNT_"^"_DOD 151 S VALMCNT=CNT 152 K RGDFN,RGNM,RGSSN,EXDATE,ETEXT,ICN,DOB,STAT,VADM,HOME,STRING,DOD 153 Q 154 SELECT ; 155 I $G(STRING)["no exceptions found" D SORT^RGEX01 Q 156 N VALMY 157 D EN^VALM2(XQORNOD(0),"OS") 158 I '$D(VALMY) Q 159 S VALMCNT=CNT 160 S DATA="",CNT="" 161 S CNT=$O(VALMY(0)) 162 S DATA=$G(^TMP("RGEXC",$J,CNT,"DATA")) 163 I '$D(DATA) S CNT=0 Q 164 D CLEAN^VALM10 165 D EN^RGEX03(DATA) 166 I RGSORT="VT" D 167 . K @VALMAR 168 . D ADDSEL 169 E I RGSORT'="VT" D SORT^RGEX01 170 ; 171 Q 172 QUIT ; 1 RGEXHND1 ;BAY/ALS-MPI/PD EXCEPTION HANDLING UTILITY ;10/08/99 2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**3,12,19,23,43,45**;30 Apr 99;Build 9 3 DTLIST ;List exceptions by date 4 K ^TMP("RGEXC",$J) 5 I '$D(RGBG) S VALMBG=1 6 ;**45 list exception 234 first regardless of date - Primary View Reject 7 S EXCDT="",EXCTYP=234,(CNT,IEN)=0 8 F S IEN=$O(^RGHL7(991.1,"ASTAT","0",EXCTYP,IEN)) Q:'IEN D 9 .S IEN2=0 10 .F S IEN2=$O(^RGHL7(991.1,"ASTAT","0",EXCTYP,IEN,IEN2)) Q:'IEN2 D 11 ..S EXCDT=$P(^RGHL7(991.1,IEN,0),"^",3) 12 ..D ADDREC 13 S EXCDT="",EXCTYP="" 14 F S EXCDT=$O(^RGHL7(991.1,"AD",EXCDT)) Q:'EXCDT D 15 . S IEN=0 16 . F S IEN=$O(^RGHL7(991.1,"AD",EXCDT,IEN)) Q:'IEN D 17 .. S NUM="" S NUM=$P($G(^RGHL7(991.1,IEN,1,0)),"^",4) Q:NUM<1 D 18 ... S IEN2=0 19 ... F S IEN2=$O(^RGHL7(991.1,IEN,1,IEN2)) Q:'IEN2 D 20 .... S EXCTYP=$P(^RGHL7(991.1,IEN,1,IEN2,0),"^",3) 21 ....;don't include 234 below; those were done first (above). 22 .... I ((EXCTYP>214)&(EXCTYP<219)) D ADDREC ;**45 23 K I,NUM,EXCDT,EXCTYP,RGBG 24 IF CNT<1 D NDATA 25 Q 26 ; 27 NDATA ; There is no data matching the criteria 28 S CNT=CNT+1,STRING="" 29 S STRING=$$SETSTR^VALM1("There were no exceptions found.",STRING,5,35) 30 S ^TMP("RGEXC",$J,CNT,0)=STRING 31 S ^TMP("RGEXC",$J,"IDX",CNT,CNT)="" 32 S VALMCNT=CNT 33 Q 34 EXCLST ;List exceptions by type 35 K ^TMP("RGEXC",$J) 36 S CNT=0,EXCDT="",EXCTYP="" 37 I '$D(RGBG) S VALMBG=1 38 F S EXCTYP=$O(^RGHL7(991.1,"AC",EXCTYP)) Q:'EXCTYP D 39 . I (EXCTYP=234)!((EXCTYP>214)&(EXCTYP<219)) D ;**45 40 .. S IEN=0 41 .. F S IEN=$O(^RGHL7(991.1,"AC",EXCTYP,IEN)) Q:'IEN D 42 ... S NUM="" S NUM=$P($G(^RGHL7(991.1,IEN,1,0)),"^",4) Q:NUM<1 D 43 .... S IEN2=0 44 .... F S IEN2=$O(^RGHL7(991.1,"AC",EXCTYP,IEN,IEN2)) Q:'IEN2 D 45 ..... S EXCDT=$P($G(^RGHL7(991.1,IEN,0)),"^",3) Q:'EXCDT 46 ..... D ADDREC 47 IF CNT<1 D NDATA 48 K RGBG 49 Q 50 PATLST ;List exceptions by patient 51 K ^TMP("RGEXC",$J),^TMP("RGEX01",$J) 52 S CNT=0,EXCDT="",EXCTYP="",NDX=0,NAME="" 53 I '$D(RGBG) S VALMBG=1 54 F S EXCTYP=$O(^RGHL7(991.1,"ADFN",EXCTYP)) Q:'EXCTYP D 55 . I (EXCTYP=234)!((EXCTYP>214)&(EXCTYP<219)) D ;**45 56 .. S DFN="" 57 .. F S DFN=$O(^RGHL7(991.1,"ADFN",EXCTYP,DFN)) Q:'DFN D 58 ... S IEN=0 59 ... F S IEN=$O(^RGHL7(991.1,"ADFN",EXCTYP,DFN,IEN)) Q:'IEN D 60 .... S IEN2=0 61 .... F S IEN2=$O(^RGHL7(991.1,"ADFN",EXCTYP,DFN,IEN,IEN2)) Q:'IEN2 D 62 ..... S EXCDT=$P($G(^RGHL7(991.1,IEN,0)),"^",3) Q:'EXCDT 63 ..... D DEM^VADPT S NAME=VADM(1) Q:NAME="" 64 ..... S NDX=NDX+1 65 ..... S ^TMP("RGEX01",$J,NAME,NDX)=$G(VADM(1))_"^"_IEN_"^"_IEN2_"^"_EXCTYP_"^"_EXCDT 66 D PATTMP 67 IF CNT<1 D NDATA 68 K DFN,RGBG 69 Q 70 PATTMP ; 71 S NM="" 72 F S NM=$O(^TMP("RGEX01",$J,NM)) Q:NM="" D 73 . S NDX=0 74 . F S NDX=$O(^TMP("RGEX01",$J,NM,NDX)) Q:'NDX D 75 .. S IEN=$P(^TMP("RGEX01",$J,NM,NDX),"^",2) 76 .. S IEN2=$P(^TMP("RGEX01",$J,NM,NDX),"^",3) 77 .. S EXCTYP=$P(^TMP("RGEX01",$J,NM,NDX),"^",4) 78 .. S EXCDT=$P(^TMP("RGEX01",$J,NM,NDX),"^",5) 79 .. D ADDREC 80 K NDX,NM,NAME 81 Q 82 SELTYP ; List all exceptions of type selected by user 83 S EXCTYPE="",FLAG=0,ETYPE="" 84 I '$D(RGBG) S VALMBG=1 85 K DIR,Y,DIC 86 S DIR("A")="Enter an exception type to view: " 87 S DIR(0)="SAM^215:Death Entry on MPI not VISTA;216:Death Entry on Vista not MPI;217:Death Entries on MPI and Vista DON'T MATCH;218:Potential Matches Returned;234:Primary View Reject" ;**43,45 88 S DIR("?")="^D HLPSEL^RGEXHND1" 89 D ^DIR 90 I Y<1 S RGSORT="SD" D SORT^RGEX01 Q 91 Q:$D(DUOUT)!$D(DTOUT) 92 S EXCTYPE=+Y,ETYPE=$P(^RGHL7(991.11,EXCTYPE,10),"^",1) 93 I (EXCTYPE=234)!((EXCTYPE>214)&(EXCTYPE<219)) S FLAG=1 ;**43,45 94 I FLAG=1 D ADDSEL 95 E I FLAG=0 D 96 . W !,"Not a valid selection." 97 . D SELTYP 98 K FLAG,Y,DIR,DIC,DTOUT,DUOUT,RGBG 99 Q 100 ADDSEL ;called by SELTYP 101 K ^TMP("RGEXC",$J) 102 S CNT=0,EXCDT="",EXCTYP="" 103 F S EXCTYP=$O(^RGHL7(991.1,"AC",EXCTYP)) Q:'EXCTYP D 104 . I EXCTYP=EXCTYPE D 105 .. S IEN=0 106 .. F S IEN=$O(^RGHL7(991.1,"AC",EXCTYP,IEN)) Q:'IEN D 107 ... S IEN2=0 108 ... F S IEN2=$O(^RGHL7(991.1,"AC",EXCTYP,IEN,IEN2)) Q:'IEN2 D 109 .... S EXCDT=$P($G(^RGHL7(991.1,IEN,0)),"^",3) Q:'EXCDT ;**43 110 .... D ADDREC 111 I CNT<1 D 112 . W !,"There are no "_ETYPE 113 . W !,"exceptions that need processing." 114 . D SELTYP 115 Q 116 HLPSEL ; 117 D FULL^VALM1 118 ;W !,"The following exception types are handled by this option:" 119 ;W !!,"Death Entry on MPI not in VISTA",?50,"(215)" 120 ;W !,"Death Entry on Vista not in MPI",?50,"(216)" 121 ;W !,"Death Entries on MPI and Vista DO NOT MATCH",?50,"(217)" 122 ;W !,"Potential Matches Returned",?50,"(218)" 123 ;W !,"Primary View Reject",?50,"(234)" 124 S VALMBCK="R" 125 Q 126 ADDREC ; 127 S ETEXT="",RGDFN="",ICN="",RGNM="",STAT="",DOD="" 128 S ETEXT=$P($G(^RGHL7(991.11,EXCTYP,10)),"^",1) 129 S RGDFN=$P(^RGHL7(991.1,IEN,1,IEN2,0),"^",4) Q:'RGDFN 130 S STAT=$P($G(^RGHL7(991.1,IEN,1,IEN2,0)),"^",5) 131 S ICN=+$$GETICN^MPIF001(RGDFN) 132 S HOME=$$SITE^VASITE() 133 I (STAT<1)!(STAT="") D 134 .;Only list exceptions that are Not Processed 135 .; only list patients with local ICN, or for exceptions 234, 215 - 218 136 . I $E(ICN,1,3)=$E($P(HOME,"^",3),1,3)!(ICN<0)!(EXCTYP=234)!((EXCTYP>214)&(EXCTYP<219)) D ;**43,45 137 .. S DFN=RGDFN D DEM^VADPT 138 .. S RGNM=VADM(1) 139 .. S RGSSN=$P($G(VADM(2)),"^",1) 140 .. S DOB=$G(VADM(3)) I DOB="" S DOB="^" 141 .. S DOD=$P($P($G(VADM(6)),"^",2),"@",1) 142 .. S EXDATE=$P($$FMTE^XLFDT(EXCDT,2),"@",1) 143 .. S CNT=CNT+1 144 .. S STRING="" 145 .. I ICN<0 S ICN="" 146 .. S STRING=$$SETSTR^VALM1(CNT,STRING,1,4) 147 .. S STRING=$$SETSTR^VALM1($E(RGNM,1,22),STRING,6,21) 148 .. S STRING=$$SETSTR^VALM1(RGSSN,STRING,28,10) 149 .. S STRING=$$SETSTR^VALM1(EXDATE,STRING,39,8) 150 .. S STRING=$$SETSTR^VALM1(ETEXT,STRING,49,32) 151 .. S ^TMP("RGEXC",$J,CNT,0)=STRING 152 .. S ^TMP("RGEXC",$J,"IDX",CNT,CNT)="" 153 .. S ^TMP("RGEXC",$J,CNT,"DATA")=RGNM_"^"_RGSSN_"^"_$P($$FMTE^XLFDT(EXCDT),"@",1)_"^"_ETEXT_"^"_DFN_"^"_ICN_"^"_DOB_"^"_STAT_"^"_IEN_"^"_IEN2_"^"_CNT_"^"_DOD 154 S VALMCNT=CNT 155 K RGDFN,RGNM,RGSSN,EXDATE,ETEXT,ICN,DOB,STAT,VADM,HOME,STRING,DOD 156 Q 157 SELECT ; 158 I $G(STRING)["no exceptions found" D SORT^RGEX01 Q 159 N VALMY 160 D EN^VALM2(XQORNOD(0),"OS") 161 I '$D(VALMY) Q 162 S VALMCNT=CNT 163 S DATA="",CNT="" 164 S CNT=$O(VALMY(0)) 165 S DATA=$G(^TMP("RGEXC",$J,CNT,"DATA")) 166 I '$D(DATA) S CNT=0 Q 167 D CLEAN^VALM10 168 D EN^RGEX03(DATA) 169 I RGSORT="VT" D 170 . K @VALMAR 171 . D ADDSEL 172 E I RGSORT'="VT" D SORT^RGEX01 173 ; 174 Q 175 QUIT ;
Note:
See TracChangeset
for help on using the changeset viewer.
