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