RORREP01 ;HOIFO/BH - REGISTRY COMPARISON REPORT ; 12/21/05 11:55am
 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
 ;
 ;--------------------------------------------------------------------
 ; Registry: [VA HIV]
 ;--------------------------------------------------------------------
 ;
 Q
 ;
BEGIN ;
 I '$$VFILE^DILFD(158)  D  Q
 . W !,"ICR v2.1 is not installed in this account!",!
 I '$D(^XUSEC("IMRA",DUZ)) S IMRLOC="RORREP01" D ACESSERR^IMRERR,H^XUS K IMRLOC
 ;
 W !,?10,"####################################################"
 W !,?10,"#",?20,"Local ICR Version Comparison Report      #",?61
 W !,?10,"####################################################"
 ;
 ;
DEV D IMRDEV^IMREDIT
 G:POP KILL
 I '$D(IO("Q")) W @IOF D REP Q
 I $D(IO("Q")) D  G KILL
 . S ZTRTN="REP^RORREP01",ZTDESC="Local ICR Version Comparison Report"
 . S ZTSAVE("*")="",ZTIO=ION_";"_IOM_";"_IOSL
 . D ^%ZTLOAD K ZTRTN,ZTDESC,ZTSAVE,ZTSK
 . Q
 ;
REP ; Get Data
 U IO
 D EN1
 K CNT
 ;
 D PRNT^RORREP02
CLOSE D ^%ZISC K %ZIS,IOP
 S:$D(ZTQUEUED) ZTREQ="@"
 ;
 ;
KILL D ^%ZISC
 K ^TMP("RORREP01",$J)
 K DTOUT,VAROOT,VAERR,A,DIRUT,I,J,POP,X,X0,X1,Y,Z,D,IMRDTE,IMRFLG,IMRHED,IMRRPG,%I,DISYS,IMRPG
 D HOME^%ZIS
 Q
 ;
 ; ---------------------------------------------------------------------
EN1 ;
 K ^TMP("RORREP01",$J)
 S CNT=0
 D VTHREE
 D VTWO
 ;
 D INTWO
 D INTHREE
 Q
 ;
VTHREE ; Make array of version 3 patients 
 N ICN,IDSC,NAME,RC,PAT
 K VTHREE
 S RC=$$PATITER^RORAPI01(.IDSC,"VA HIV")
 I RC<0 Q
 F  S RC=$$NEXTPAT^RORAPI01(.IDSC)  Q:RC'>0  D
 . S PAT=+RC
 . S ^TMP("RORREP01",$J,"VTHREE",PAT)=""
 . S ICN=$$GETICN^MPIF001(PAT)
 . Q:$L(ICN)'=9
 . S NAME=$P(^DPT(PAT,0),"^",1)
 . S ^TMP("RORREP01",$J,"ICN",NAME,PAT)=""
 Q
 ;
 ;
VTWO ; Make array of version 2.1 patients
 N ENCODE,PAT,IMRIEN
 S IMRIEN=0
 F  S IMRIEN=$O(^IMR(158,IMRIEN)) Q:'IMRIEN  D
 . S ENCODE=$P(^IMR(158,IMRIEN,0),U)
 . I ENCODE="" D  Q
 . . S CNT=CNT+1
 . . S ^TMP("RORREP01",$J,"ERROR","ENCODE",CNT)="Entry "_IMRIEN_" in file #158 does not have .01 field." Q
 . S PAT=$$XOR^RORUTL03(ENCODE)
 . I PAT=0!(PAT="") D  Q
 . . S CNT=CNT+1
 . . S ^TMP("RORREP01",$J,"ERROR","ENCODE",CNT)="Could not decode .01 field "_ENCODE_" of file #158."
 . ;
 . I $D(^DPT(PAT,-9)) D  Q
 . . N NEWIEN
 . . S NEWIEN=^DPT(PAT,-9)
 . . I NEWIEN="" Q
 . . I $D(^TMP("RORREP01",$J,"PROC",NEWIEN)) Q
 . . S ^TMP("RORREP01",$J,"MERGE",NEWIEN)=ENCODE
 . ;
 . I $$GET1^DIQ(2,PAT,.01)="" D  Q
 . . S CNT=CNT+1
 . . S ^TMP("RORREP01",$J,"ERROR","ENCODE",CNT)="Could not get patient name from patient file IEN "_PAT Q
 . ;
 . D VTWO1(PAT,ENCODE)
 ;
 I $D(^TMP("RORREP01",$J,"MERGE")) D
 . N ENC,SUB4 S SUB4=0
 . F  S SUB4=$O(^TMP("RORREP01",$J,"MERGE",SUB4)) Q:SUB4=""  D
 . . S ENC=^TMP("RORREP01",$J,"MERGE",SUB4)
 . . D VTWO1(SUB4,ENC)
 ;
 K ^TMP("RORREP01",$J,"PROC"),^TMP("RORREP01",$J,"MERGE")
 Q
 ;
VTWO1(PAT,ENCODE) ;
 N ICN,SSN
 I $$GET1^DIQ(2,PAT,.01)="" D  Q
 . S CNT=CNT+1
 . S ^TMP("RORREP01",$J,"ERROR","ENCODE",CNT)="Could not get file #2 entry for entry "_ENCODE_" of file #158."
 ;
 S ^TMP("RORREP01",$J,"PROC",PAT)=""
 S ^TMP("RORREP01",$J,"VTWO",PAT)=ENCODE
 I PAT=7202138 W ENCODE_"***"
 S ICN=$$GETICN^MPIF001(PAT)
 Q:$L(ICN)'=9
 S NAME=$P(^DPT(PAT,0),"^",1)
 S SSN=$$GET1^DIQ(2,PAT,.09),SSN=$E(SSN,6,9)
 S ^TMP("RORREP01",$J,"ICN",NAME,PAT)=SSN
 Q
 ;
INTWO ; Patients in version 2.1 and not in three or in both
 N IEN,NAME,DATE21,RULE,SSN S IEN=0
 F  S IEN=$O(^TMP("RORREP01",$J,"VTWO",IEN)) Q:IEN=""  D
 . S NAME=$$GET1^DIQ(2,IEN,.01)
 . S SSN=$$GET1^DIQ(2,IEN,.09),SSN=$E(SSN,6,9)
 . S DATE21=$$DATE21(^TMP("RORREP01",$J,"VTWO",IEN))
 . I '$D(^TMP("RORREP01",$J,"VTHREE",IEN)) D  Q
 . . S ^TMP("RORREP01",$J,"INTWO",NAME)=DATE21_"^"_SSN
 . S RULE=$$RULE(IEN) I RULE=0 Q
 . S ^TMP("RORREP01",$J,"INBOTH",NAME)=RULE_"^"_DATE21_"^"_SSN
 Q
 ;
 ;
INTHREE ; Patients in version 3.0 and not in two OR in both
 N DATE21,RULE,IEN,PENDING,NAME,SSN S IEN=0
 F  S IEN=$O(^TMP("RORREP01",$J,"VTHREE",IEN)) Q:IEN=""  D
 . S NAME=$$GET1^DIQ(2,IEN,.01)
 . S SSN=$$GET1^DIQ(2,IEN,.09),SSN=$E(SSN,6,9)
 . I NAME="" S CNT=CNT+1,^TMP("RORREP01",$J,"ERROR","ROR",CNT)="Can't find Name from patient (#2) file IEN "_IEN_"." Q
 . ;
 . S RULE=$$RULE(IEN) I RULE=0 Q
 . I '$D(^TMP("RORREP01",$J,"VTWO",IEN)) D  Q
 . . S PENDING=$$PEND(IEN)
 . . S ^TMP("RORREP01",$J,"INTHREE",NAME)=RULE_"^"_PENDING_"^"_SSN
 . S DATE21=$$DATE21(^TMP("RORREP01",$J,"VTWO",IEN))
 . S ^TMP("RORREP01",$J,"INBOTH",NAME)=RULE_"^"_DATE21_"^"_SSN
 Q
 ;
 ;
DATE21(ENCODE) ; Get date added to ICR 2.1
 N IMRCAT1,IMRCAT2,IMRCAT3,IMRCAT4,IMRNODE,IMRIEN,IMRDTE,IMRARR
 S IMRIEN=0
 S IMRIEN=$O(^IMR(158,"B",ENCODE,IMRIEN))
 S IMRNODE=^IMR(158,IMRIEN,0)
 S IMRCAT1=$P(IMRNODE,"^",36) I IMRCAT1'="" S IMRARR(IMRCAT1)=""
 S IMRCAT2=$P(IMRNODE,"^",44) I IMRCAT2'="" S IMRARR(IMRCAT2)=""
 S IMRCAT3=$P(IMRNODE,"^",35) I IMRCAT3'="" S IMRARR(IMRCAT3)=""
 S IMRCAT4=$P(IMRNODE,"^",23) I IMRCAT4'="" S IMRARR(IMRCAT4)=""
 I '$D(IMRARR) Q "No Cat. Date"
 S IMRDTE=""
 S IMRDTE=$O(IMRARR(IMRDTE))
 S Y=IMRDTE D DD^%DT S IMRDTE=Y
 Q IMRDTE
 ;
 ;
PEND(IEN) ;
 N RORIEN,PEND
 S RORIEN="",PEND="YES"
 S RORIEN=$O(^RORDATA(798,"KEY",IEN,2,RORIEN))
 S RES=$P(^RORDATA(798,RORIEN,0),"^",5)
 I RES'=4 S PEND="NO"
 Q PEND
 ;
 ;
RULE(IEN) ; Get earliest selction rule 
 N RORIEN
 S RORIEN=""
 S RORIEN=$O(^RORDATA(798,"KEY",IEN,2,RORIEN))
 I 'RORIEN D  Q 0
 . S CNT=CNT+1
 . S ^TMP("RORREP01",$J,"ERROR","ROR",CNT)="Can't find IEN of file #798 record that has a #.01 field of "_IEN_"." Q
 ;
 N RULE1,DATE1,SELARR,RORSRIEN,SELDATE,DATA,RULE
 S RORSRIEN=0
 F  S RORSRIEN=$O(^RORDATA(798,RORIEN,1,RORSRIEN)) Q:'RORSRIEN  D
 . S DATA=^RORDATA(798,RORIEN,1,RORSRIEN,0)
 . S RULE=$P(DATA,"^",1)
 . S RULE=$$GET1^DIQ(798.2,RULE,.01,"E")
 . S SELDATE=$P(DATA,"^",2)
 . S SELARR(SELDATE)=RULE
 ;
 I '$D(SELARR) D  Q 0
 . S CNT=CNT+1
 . N BUFF,EVID,NME
 . S NME=$$GET1^DIQ(798,RORIEN,.01,"E")
 . ;
 . S EVID=$P(^RORDATA(798,RORIEN,0),U,14)
 . I 'EVID D
 . . S BUFF=NME_" is in ROR Local Registry file (#798) but has no selection rules."
 . . S ^TMP("RORREP01",$J,"ERROR",IEN)=BUFF
 . I EVID D
 . . S ^TMP("RORREP01",$J,"ISSUE","EVID",IEN)=NME
 S DATE1="" S DATE1=$O(SELARR(DATE1))
 S RULE1=SELARR(DATE1)
 S Y=DATE1 D DD^%DT S DATE1=Y
 Q DATE1_"^"_RULE1
 ;
 ;
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORREP01   6418     printed  Sep 23, 2025@19:18:50                                                                                                                                                                                                    Page 2
RORREP01  ;HOIFO/BH - REGISTRY COMPARISON REPORT ; 12/21/05 11:55am
 +1       ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
 +2       ;
 +3       ;--------------------------------------------------------------------
 +4       ; Registry: [VA HIV]
 +5       ;--------------------------------------------------------------------
 +6       ;
 +7        QUIT 
 +8       ;
BEGIN     ;
 +1        IF '$$VFILE^DILFD(158)
               Begin DoDot:1
 +2                WRITE !,"ICR v2.1 is not installed in this account!",!
               End DoDot:1
               QUIT 
 +3        IF '$DATA(^XUSEC("IMRA",DUZ))
               SET IMRLOC="RORREP01"
               DO ACESSERR^IMRERR
               DO H^XUS
               KILL IMRLOC
 +4       ;
 +5        WRITE !,?10,"####################################################"
 +6        WRITE !,?10,"#",?20,"Local ICR Version Comparison Report      #",?61
 +7        WRITE !,?10,"####################################################"
 +8       ;
 +9       ;
DEV        DO IMRDEV^IMREDIT
 +1        if POP
               GOTO KILL
 +2        IF '$DATA(IO("Q"))
               WRITE @IOF
               DO REP
               QUIT 
 +3        IF $DATA(IO("Q"))
               Begin DoDot:1
 +4                SET ZTRTN="REP^RORREP01"
                   SET ZTDESC="Local ICR Version Comparison Report"
 +5                SET ZTSAVE("*")=""
                   SET ZTIO=ION_";"_IOM_";"_IOSL
 +6                DO ^%ZTLOAD
                   KILL ZTRTN,ZTDESC,ZTSAVE,ZTSK
 +7                QUIT 
               End DoDot:1
               GOTO KILL
 +8       ;
REP       ; Get Data
 +1        USE IO
 +2        DO EN1
 +3        KILL CNT
 +4       ;
 +5        DO PRNT^RORREP02
CLOSE      DO ^%ZISC
           KILL %ZIS,IOP
 +1        if $DATA(ZTQUEUED)
               SET ZTREQ="@"
 +2       ;
 +3       ;
KILL       DO ^%ZISC
 +1        KILL ^TMP("RORREP01",$JOB)
 +2        KILL DTOUT,VAROOT,VAERR,A,DIRUT,I,J,POP,X,X0,X1,Y,Z,D,IMRDTE,IMRFLG,IMRHED,IMRRPG,%I,DISYS,IMRPG
 +3        DO HOME^%ZIS
 +4        QUIT 
 +5       ;
 +6       ; ---------------------------------------------------------------------
EN1       ;
 +1        KILL ^TMP("RORREP01",$JOB)
 +2        SET CNT=0
 +3        DO VTHREE
 +4        DO VTWO
 +5       ;
 +6        DO INTWO
 +7        DO INTHREE
 +8        QUIT 
 +9       ;
VTHREE    ; Make array of version 3 patients 
 +1        NEW ICN,IDSC,NAME,RC,PAT
 +2        KILL VTHREE
 +3        SET RC=$$PATITER^RORAPI01(.IDSC,"VA HIV")
 +4        IF RC<0
               QUIT 
 +5        FOR 
               SET RC=$$NEXTPAT^RORAPI01(.IDSC)
               if RC'>0
                   QUIT 
               Begin DoDot:1
 +6                SET PAT=+RC
 +7                SET ^TMP("RORREP01",$JOB,"VTHREE",PAT)=""
 +8                SET ICN=$$GETICN^MPIF001(PAT)
 +9                if $LENGTH(ICN)'=9
                       QUIT 
 +10               SET NAME=$PIECE(^DPT(PAT,0),"^",1)
 +11               SET ^TMP("RORREP01",$JOB,"ICN",NAME,PAT)=""
               End DoDot:1
 +12       QUIT 
 +13      ;
 +14      ;
VTWO      ; Make array of version 2.1 patients
 +1        NEW ENCODE,PAT,IMRIEN
 +2        SET IMRIEN=0
 +3        FOR 
               SET IMRIEN=$ORDER(^IMR(158,IMRIEN))
               if 'IMRIEN
                   QUIT 
               Begin DoDot:1
 +4                SET ENCODE=$PIECE(^IMR(158,IMRIEN,0),U)
 +5                IF ENCODE=""
                       Begin DoDot:2
 +6                        SET CNT=CNT+1
 +7                        SET ^TMP("RORREP01",$JOB,"ERROR","ENCODE",CNT)="Entry "_IMRIEN_" in file #158 does not have .01 field."
                           QUIT 
                       End DoDot:2
                       QUIT 
 +8                SET PAT=$$XOR^RORUTL03(ENCODE)
 +9                IF PAT=0!(PAT="")
                       Begin DoDot:2
 +10                       SET CNT=CNT+1
 +11                       SET ^TMP("RORREP01",$JOB,"ERROR","ENCODE",CNT)="Could not decode .01 field "_ENCODE_" of file #158."
                       End DoDot:2
                       QUIT 
 +12      ;
 +13               IF $DATA(^DPT(PAT,-9))
                       Begin DoDot:2
 +14                       NEW NEWIEN
 +15                       SET NEWIEN=^DPT(PAT,-9)
 +16                       IF NEWIEN=""
                               QUIT 
 +17                       IF $DATA(^TMP("RORREP01",$JOB,"PROC",NEWIEN))
                               QUIT 
 +18                       SET ^TMP("RORREP01",$JOB,"MERGE",NEWIEN)=ENCODE
                       End DoDot:2
                       QUIT 
 +19      ;
 +20               IF $$GET1^DIQ(2,PAT,.01)=""
                       Begin DoDot:2
 +21                       SET CNT=CNT+1
 +22                       SET ^TMP("RORREP01",$JOB,"ERROR","ENCODE",CNT)="Could not get patient name from patient file IEN "_PAT
                           QUIT 
                       End DoDot:2
                       QUIT 
 +23      ;
 +24               DO VTWO1(PAT,ENCODE)
               End DoDot:1
 +25      ;
 +26       IF $DATA(^TMP("RORREP01",$JOB,"MERGE"))
               Begin DoDot:1
 +27               NEW ENC,SUB4
                   SET SUB4=0
 +28               FOR 
                       SET SUB4=$ORDER(^TMP("RORREP01",$JOB,"MERGE",SUB4))
                       if SUB4=""
                           QUIT 
                       Begin DoDot:2
 +29                       SET ENC=^TMP("RORREP01",$JOB,"MERGE",SUB4)
 +30                       DO VTWO1(SUB4,ENC)
                       End DoDot:2
               End DoDot:1
 +31      ;
 +32       KILL ^TMP("RORREP01",$JOB,"PROC"),^TMP("RORREP01",$JOB,"MERGE")
 +33       QUIT 
 +34      ;
VTWO1(PAT,ENCODE) ;
 +1        NEW ICN,SSN
 +2        IF $$GET1^DIQ(2,PAT,.01)=""
               Begin DoDot:1
 +3                SET CNT=CNT+1
 +4                SET ^TMP("RORREP01",$JOB,"ERROR","ENCODE",CNT)="Could not get file #2 entry for entry "_ENCODE_" of file #158."
               End DoDot:1
               QUIT 
 +5       ;
 +6        SET ^TMP("RORREP01",$JOB,"PROC",PAT)=""
 +7        SET ^TMP("RORREP01",$JOB,"VTWO",PAT)=ENCODE
 +8        IF PAT=7202138
               WRITE ENCODE_"***"
 +9        SET ICN=$$GETICN^MPIF001(PAT)
 +10       if $LENGTH(ICN)'=9
               QUIT 
 +11       SET NAME=$PIECE(^DPT(PAT,0),"^",1)
 +12       SET SSN=$$GET1^DIQ(2,PAT,.09)
           SET SSN=$EXTRACT(SSN,6,9)
 +13       SET ^TMP("RORREP01",$JOB,"ICN",NAME,PAT)=SSN
 +14       QUIT 
 +15      ;
INTWO     ; Patients in version 2.1 and not in three or in both
 +1        NEW IEN,NAME,DATE21,RULE,SSN
           SET IEN=0
 +2        FOR 
               SET IEN=$ORDER(^TMP("RORREP01",$JOB,"VTWO",IEN))
               if IEN=""
                   QUIT 
               Begin DoDot:1
 +3                SET NAME=$$GET1^DIQ(2,IEN,.01)
 +4                SET SSN=$$GET1^DIQ(2,IEN,.09)
                   SET SSN=$EXTRACT(SSN,6,9)
 +5                SET DATE21=$$DATE21(^TMP("RORREP01",$JOB,"VTWO",IEN))
 +6                IF '$DATA(^TMP("RORREP01",$JOB,"VTHREE",IEN))
                       Begin DoDot:2
 +7                        SET ^TMP("RORREP01",$JOB,"INTWO",NAME)=DATE21_"^"_SSN
                       End DoDot:2
                       QUIT 
 +8                SET RULE=$$RULE(IEN)
                   IF RULE=0
                       QUIT 
 +9                SET ^TMP("RORREP01",$JOB,"INBOTH",NAME)=RULE_"^"_DATE21_"^"_SSN
               End DoDot:1
 +10       QUIT 
 +11      ;
 +12      ;
INTHREE   ; Patients in version 3.0 and not in two OR in both
 +1        NEW DATE21,RULE,IEN,PENDING,NAME,SSN
           SET IEN=0
 +2        FOR 
               SET IEN=$ORDER(^TMP("RORREP01",$JOB,"VTHREE",IEN))
               if IEN=""
                   QUIT 
               Begin DoDot:1
 +3                SET NAME=$$GET1^DIQ(2,IEN,.01)
 +4                SET SSN=$$GET1^DIQ(2,IEN,.09)
                   SET SSN=$EXTRACT(SSN,6,9)
 +5                IF NAME=""
                       SET CNT=CNT+1
                       SET ^TMP("RORREP01",$JOB,"ERROR","ROR",CNT)="Can't find Name from patient (#2) file IEN "_IEN_"."
                       QUIT 
 +6       ;
 +7                SET RULE=$$RULE(IEN)
                   IF RULE=0
                       QUIT 
 +8                IF '$DATA(^TMP("RORREP01",$JOB,"VTWO",IEN))
                       Begin DoDot:2
 +9                        SET PENDING=$$PEND(IEN)
 +10                       SET ^TMP("RORREP01",$JOB,"INTHREE",NAME)=RULE_"^"_PENDING_"^"_SSN
                       End DoDot:2
                       QUIT 
 +11               SET DATE21=$$DATE21(^TMP("RORREP01",$JOB,"VTWO",IEN))
 +12               SET ^TMP("RORREP01",$JOB,"INBOTH",NAME)=RULE_"^"_DATE21_"^"_SSN
               End DoDot:1
 +13       QUIT 
 +14      ;
 +15      ;
DATE21(ENCODE) ; Get date added to ICR 2.1
 +1        NEW IMRCAT1,IMRCAT2,IMRCAT3,IMRCAT4,IMRNODE,IMRIEN,IMRDTE,IMRARR
 +2        SET IMRIEN=0
 +3        SET IMRIEN=$ORDER(^IMR(158,"B",ENCODE,IMRIEN))
 +4        SET IMRNODE=^IMR(158,IMRIEN,0)
 +5        SET IMRCAT1=$PIECE(IMRNODE,"^",36)
           IF IMRCAT1'=""
               SET IMRARR(IMRCAT1)=""
 +6        SET IMRCAT2=$PIECE(IMRNODE,"^",44)
           IF IMRCAT2'=""
               SET IMRARR(IMRCAT2)=""
 +7        SET IMRCAT3=$PIECE(IMRNODE,"^",35)
           IF IMRCAT3'=""
               SET IMRARR(IMRCAT3)=""
 +8        SET IMRCAT4=$PIECE(IMRNODE,"^",23)
           IF IMRCAT4'=""
               SET IMRARR(IMRCAT4)=""
 +9        IF '$DATA(IMRARR)
               QUIT "No Cat. Date"
 +10       SET IMRDTE=""
 +11       SET IMRDTE=$ORDER(IMRARR(IMRDTE))
 +12       SET Y=IMRDTE
           DO DD^%DT
           SET IMRDTE=Y
 +13       QUIT IMRDTE
 +14      ;
 +15      ;
PEND(IEN) ;
 +1        NEW RORIEN,PEND
 +2        SET RORIEN=""
           SET PEND="YES"
 +3        SET RORIEN=$ORDER(^RORDATA(798,"KEY",IEN,2,RORIEN))
 +4        SET RES=$PIECE(^RORDATA(798,RORIEN,0),"^",5)
 +5        IF RES'=4
               SET PEND="NO"
 +6        QUIT PEND
 +7       ;
 +8       ;
RULE(IEN) ; Get earliest selction rule 
 +1        NEW RORIEN
 +2        SET RORIEN=""
 +3        SET RORIEN=$ORDER(^RORDATA(798,"KEY",IEN,2,RORIEN))
 +4        IF 'RORIEN
               Begin DoDot:1
 +5                SET CNT=CNT+1
 +6                SET ^TMP("RORREP01",$JOB,"ERROR","ROR",CNT)="Can't find IEN of file #798 record that has a #.01 field of "_IEN_"."
                   QUIT 
               End DoDot:1
               QUIT 0
 +7       ;
 +8        NEW RULE1,DATE1,SELARR,RORSRIEN,SELDATE,DATA,RULE
 +9        SET RORSRIEN=0
 +10       FOR 
               SET RORSRIEN=$ORDER(^RORDATA(798,RORIEN,1,RORSRIEN))
               if 'RORSRIEN
                   QUIT 
               Begin DoDot:1
 +11               SET DATA=^RORDATA(798,RORIEN,1,RORSRIEN,0)
 +12               SET RULE=$PIECE(DATA,"^",1)
 +13               SET RULE=$$GET1^DIQ(798.2,RULE,.01,"E")
 +14               SET SELDATE=$PIECE(DATA,"^",2)
 +15               SET SELARR(SELDATE)=RULE
               End DoDot:1
 +16      ;
 +17       IF '$DATA(SELARR)
               Begin DoDot:1
 +18               SET CNT=CNT+1
 +19               NEW BUFF,EVID,NME
 +20               SET NME=$$GET1^DIQ(798,RORIEN,.01,"E")
 +21      ;
 +22               SET EVID=$PIECE(^RORDATA(798,RORIEN,0),U,14)
 +23               IF 'EVID
                       Begin DoDot:2
 +24                       SET BUFF=NME_" is in ROR Local Registry file (#798) but has no selection rules."
 +25                       SET ^TMP("RORREP01",$JOB,"ERROR",IEN)=BUFF
                       End DoDot:2
 +26               IF EVID
                       Begin DoDot:2
 +27                       SET ^TMP("RORREP01",$JOB,"ISSUE","EVID",IEN)=NME
                       End DoDot:2
               End DoDot:1
               QUIT 0
 +28       SET DATE1=""
           SET DATE1=$ORDER(SELARR(DATE1))
 +29       SET RULE1=SELARR(DATE1)
 +30       SET Y=DATE1
           DO DD^%DT
           SET DATE1=Y
 +31       QUIT DATE1_"^"_RULE1
 +32      ;
 +33      ;