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

RGEXHND1.m

Go to the documentation of this file.
  1. RGEXHND1 ;BAY/ALS-MPI/PD EXCEPTION HANDLING UTILITY ;10/08/99
  1. ;;1.0;CLINICAL INFO RESOURCE NETWORK;**3,12,19,23,43,45,52,57**;30 Apr 99;Build 2
  1. DTLIST ;List exceptions by date
  1. K ^TMP("RGEXC",$J)
  1. I '$D(RGBG) S VALMBG=1
  1. ;**45 list exception 234 first regardless of date - Primary View Reject
  1. S EXCDT="",EXCTYP=234,(CNT,IEN)=0
  1. F S IEN=$O(^RGHL7(991.1,"ASTAT","0",EXCTYP,IEN)) Q:'IEN D
  1. .S IEN2=0
  1. .F S IEN2=$O(^RGHL7(991.1,"ASTAT","0",EXCTYP,IEN,IEN2)) Q:'IEN2 D
  1. ..S EXCDT=$P(^RGHL7(991.1,IEN,0),"^",3)
  1. ..D ADDREC
  1. ;**57 MPIC_1893 Only exception type 234 remains, rest are obsolete
  1. ;S EXCDT="",EXCTYP=""
  1. ;F S EXCDT=$O(^RGHL7(991.1,"AD",EXCDT)) Q:'EXCDT D
  1. ;. S IEN=0
  1. ;. F S IEN=$O(^RGHL7(991.1,"AD",EXCDT,IEN)) Q:'IEN D
  1. ;.. S NUM="" S NUM=$P($G(^RGHL7(991.1,IEN,1,0)),"^",4) Q:NUM<1 D
  1. ;... S IEN2=0
  1. ;... F S IEN2=$O(^RGHL7(991.1,IEN,1,IEN2)) Q:'IEN2 D
  1. ;.... S EXCTYP=$P(^RGHL7(991.1,IEN,1,IEN2,0),"^",3)
  1. ;....;don't include 234 below; those were done first (above).
  1. ;.... I EXCTYP=218 D ADDREC ;**45;**52 MPIC_772 remove 215, 216 & 217
  1. K I,NUM,EXCDT,EXCTYP,RGBG
  1. IF CNT<1 D NDATA
  1. Q
  1. ;
  1. NDATA ; There is no data matching the criteria
  1. S CNT=CNT+1,STRING=""
  1. S STRING=$$SETSTR^VALM1("There were no exceptions found.",STRING,5,35)
  1. S ^TMP("RGEXC",$J,CNT,0)=STRING
  1. S ^TMP("RGEXC",$J,"IDX",CNT,CNT)=""
  1. S VALMCNT=CNT
  1. Q
  1. EXCLST ;List exceptions by type
  1. K ^TMP("RGEXC",$J)
  1. S CNT=0,EXCDT="",EXCTYP=""
  1. I '$D(RGBG) S VALMBG=1
  1. F S EXCTYP=$O(^RGHL7(991.1,"AC",EXCTYP)) Q:'EXCTYP D
  1. . I EXCTYP=234 D ;**45;**52 MPIC_772 remove 215, 216 & 217;**57 MPIC_1893 remove 218
  1. .. S IEN=0
  1. .. F S IEN=$O(^RGHL7(991.1,"AC",EXCTYP,IEN)) Q:'IEN D
  1. ... S NUM="" S NUM=$P($G(^RGHL7(991.1,IEN,1,0)),"^",4) Q:NUM<1 D
  1. .... S IEN2=0
  1. .... F S IEN2=$O(^RGHL7(991.1,"AC",EXCTYP,IEN,IEN2)) Q:'IEN2 D
  1. ..... S EXCDT=$P($G(^RGHL7(991.1,IEN,0)),"^",3) Q:'EXCDT
  1. ..... D ADDREC
  1. IF CNT<1 D NDATA
  1. K RGBG
  1. Q
  1. PATLST ;List exceptions by patient
  1. K ^TMP("RGEXC",$J),^TMP("RGEX01",$J)
  1. S CNT=0,EXCDT="",EXCTYP="",NDX=0,NAME=""
  1. I '$D(RGBG) S VALMBG=1
  1. F S EXCTYP=$O(^RGHL7(991.1,"ADFN",EXCTYP)) Q:'EXCTYP D
  1. . I EXCTYP=234 D ;**45;**52 MPIC_772 remove 215, 216 & 217;**57 MPIC_1893 remove 218
  1. .. S DFN=""
  1. .. F S DFN=$O(^RGHL7(991.1,"ADFN",EXCTYP,DFN)) Q:'DFN D
  1. ... S IEN=0
  1. ... F S IEN=$O(^RGHL7(991.1,"ADFN",EXCTYP,DFN,IEN)) Q:'IEN D
  1. .... S IEN2=0
  1. .... F S IEN2=$O(^RGHL7(991.1,"ADFN",EXCTYP,DFN,IEN,IEN2)) Q:'IEN2 D
  1. ..... S EXCDT=$P($G(^RGHL7(991.1,IEN,0)),"^",3) Q:'EXCDT
  1. ..... D DEM^VADPT S NAME=VADM(1) Q:NAME=""
  1. ..... S NDX=NDX+1
  1. ..... S ^TMP("RGEX01",$J,NAME,NDX)=$G(VADM(1))_"^"_IEN_"^"_IEN2_"^"_EXCTYP_"^"_EXCDT
  1. D PATTMP
  1. IF CNT<1 D NDATA
  1. K DFN,RGBG
  1. Q
  1. PATTMP ;
  1. S NM=""
  1. F S NM=$O(^TMP("RGEX01",$J,NM)) Q:NM="" D
  1. . S NDX=0
  1. . F S NDX=$O(^TMP("RGEX01",$J,NM,NDX)) Q:'NDX D
  1. .. S IEN=$P(^TMP("RGEX01",$J,NM,NDX),"^",2)
  1. .. S IEN2=$P(^TMP("RGEX01",$J,NM,NDX),"^",3)
  1. .. S EXCTYP=$P(^TMP("RGEX01",$J,NM,NDX),"^",4)
  1. .. S EXCDT=$P(^TMP("RGEX01",$J,NM,NDX),"^",5)
  1. .. D ADDREC
  1. K NDX,NM,NAME
  1. Q
  1. SELTYP ; List all exceptions of type selected by user
  1. S EXCTYPE="",FLAG=0,ETYPE=""
  1. I '$D(RGBG) S VALMBG=1
  1. K DIR,Y,DIC
  1. S DIR("A")="Enter an exception type to view: ",DIR("B")=234 ;**57 MPIC_1893 Only exception type 234 remains, rest are obsolete
  1. S DIR(0)="SAM^234:Primary View Reject" ;**43;**45;**52 MPIC_772 remove 215, 216 & 217 ;**57 MPIC_1893 remove 218
  1. S DIR("?")="^D HLPSEL^RGEXHND1"
  1. D ^DIR
  1. I Y<1 S RGSORT="SD" D SORT^RGEX01 Q
  1. Q:$D(DUOUT)!$D(DTOUT)
  1. S EXCTYPE=+Y,ETYPE=$P(^RGHL7(991.11,EXCTYPE,10),"^",1)
  1. I EXCTYPE=234 S FLAG=1 ;**43;**45;**52 MPIC_772 remove 215, 216 & 217 ;**57 MPIC_1893 remove 218
  1. I FLAG=1 D ADDSEL
  1. E I FLAG=0 D
  1. . W !,"Not a valid selection."
  1. . D SELTYP
  1. K FLAG,Y,DIR,DIC,DTOUT,DUOUT,RGBG
  1. Q
  1. ADDSEL ;called by SELTYP
  1. K ^TMP("RGEXC",$J)
  1. S CNT=0,EXCDT="",EXCTYP=""
  1. F S EXCTYP=$O(^RGHL7(991.1,"AC",EXCTYP)) Q:'EXCTYP D
  1. . I EXCTYP=EXCTYPE D
  1. .. S IEN=0
  1. .. F S IEN=$O(^RGHL7(991.1,"AC",EXCTYP,IEN)) Q:'IEN D
  1. ... S IEN2=0
  1. ... F S IEN2=$O(^RGHL7(991.1,"AC",EXCTYP,IEN,IEN2)) Q:'IEN2 D
  1. .... S EXCDT=$P($G(^RGHL7(991.1,IEN,0)),"^",3) Q:'EXCDT ;**43
  1. .... D ADDREC
  1. I CNT<1 D
  1. . W !,"There are no "_ETYPE
  1. . W !,"exceptions that need processing."
  1. . D SELTYP
  1. Q
  1. HLPSEL ;
  1. D FULL^VALM1
  1. ;W !,"The following exception types are handled by this option:"
  1. ;W !,"Primary View Reject",?50,"(234)"
  1. S VALMBCK="R"
  1. Q
  1. ADDREC ;
  1. S ETEXT="",RGDFN="",ICN="",RGNM="",STAT="",DOD=""
  1. S ETEXT=$P($G(^RGHL7(991.11,EXCTYP,10)),"^",1)
  1. S RGDFN=$P(^RGHL7(991.1,IEN,1,IEN2,0),"^",4) Q:'RGDFN
  1. S STAT=$P($G(^RGHL7(991.1,IEN,1,IEN2,0)),"^",5)
  1. S ICN=+$$GETICN^MPIF001(RGDFN)
  1. S HOME=$$SITE^VASITE()
  1. I (STAT<1)!(STAT="") D
  1. .;Only list exceptions that are Not Processed
  1. .; only list patients with local ICN, or for exception 234 ;**52 MPIC_772 remove 215, 216 & 217;**57 MPIC_1893 remove 218
  1. . I $E(ICN,1,3)=$E($P(HOME,"^",3),1,3)!(ICN<0)!(EXCTYP=234) D ;**43,**45,**52,**57
  1. .. S DFN=RGDFN D DEM^VADPT
  1. .. S RGNM=VADM(1)
  1. .. S RGSSN=$P($G(VADM(2)),"^",1)
  1. .. S DOB=$G(VADM(3)) I DOB="" S DOB="^"
  1. .. S DOD=$P($P($G(VADM(6)),"^",2),"@",1)
  1. .. S EXDATE=$P($$FMTE^XLFDT(EXCDT,2),"@",1)
  1. .. S CNT=CNT+1
  1. .. S STRING=""
  1. .. I ICN<0 S ICN=""
  1. .. S STRING=$$SETSTR^VALM1(CNT,STRING,1,4)
  1. .. S STRING=$$SETSTR^VALM1($E(RGNM,1,22),STRING,6,21)
  1. .. S STRING=$$SETSTR^VALM1(RGSSN,STRING,28,10)
  1. .. S STRING=$$SETSTR^VALM1(EXDATE,STRING,39,8)
  1. .. S STRING=$$SETSTR^VALM1(ETEXT,STRING,49,32)
  1. .. S ^TMP("RGEXC",$J,CNT,0)=STRING
  1. .. S ^TMP("RGEXC",$J,"IDX",CNT,CNT)=""
  1. .. S ^TMP("RGEXC",$J,CNT,"DATA")=RGNM_"^"_RGSSN_"^"_$P($$FMTE^XLFDT(EXCDT),"@",1)_"^"_ETEXT_"^"_DFN_"^"_ICN_"^"_DOB_"^"_STAT_"^"_IEN_"^"_IEN2_"^"_CNT_"^"_DOD
  1. S VALMCNT=CNT
  1. K RGDFN,RGNM,RGSSN,EXDATE,ETEXT,ICN,DOB,STAT,VADM,HOME,STRING,DOD
  1. Q
  1. SELECT ;
  1. I $G(STRING)["no exceptions found" D SORT^RGEX01 Q
  1. N VALMY
  1. D EN^VALM2(XQORNOD(0),"OS")
  1. I '$D(VALMY) Q
  1. S VALMCNT=CNT
  1. S DATA="",CNT=""
  1. S CNT=$O(VALMY(0))
  1. S DATA=$G(^TMP("RGEXC",$J,CNT,"DATA"))
  1. I '$D(DATA) S CNT=0 Q
  1. D CLEAN^VALM10
  1. D EN^RGEX03(DATA)
  1. I RGSORT="VT" D
  1. . K @VALMAR
  1. . D ADDSEL
  1. E I RGSORT'="VT" D SORT^RGEX01
  1. ;
  1. Q
  1. QUIT ;