- 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 Feb 18, 2025@23:09:14 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 ;