- 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 Jan 18, 2025@02:43 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 ;