RORRP014 ;HCIOFO/SG - RPC: REGISTRY INFO & PARAMETERS ; 11/14/05 8:31am
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
Q
;
;***** RETURNS THE REGISTRY INFORMATION
; RPC: [ROR GET REGISTRY INFO]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; REGISTRY Either a registry IEN or a registry name
;
; Return Values:
;
; A negative value of the first "^"-piece of the RESULTS(0) indicates
; an error (see the RPCSTK^RORERR procedure for more details).
;
; Otherwise, 0 is returned in the RESULTS(0) and the subsequent
; nodes of the RESULTS array contain the registry information.
;
; RESULTS(0) 0
;
; RESULTS(1) Registry
; ^01: IEN
; ^02: Name
;
; RESULTS(2) National (0/1)
;
; RESULTS(3) Registry Description
;
; RESULTS(4) Last registry update date (int)
;
; RESULTS(5) Last data extraction date (int)
;
; RESULTS(6) Number of Active Patients
;
; RESULTS(7) Number of Pending Patients
;
; RESULTS(8) Registry Status
; ^01: Internal value (0-Active, 1-Inactive)
; ^02: External value
;
; RESULTS(9) reserved
;
; RESULTS(10) Version information
; ^01: Package version
; ^02: Latest patch number
; ^03: Date of the latest patch (int)
;
REGINFO(RESULTS,REGISTRY) ;
N IENS,RC,REGIEN,RORBUF,RORERRDL,RORMSG,TMP
D CLEAR^RORERR("REGINFO^RORRP014",1)
;--- Check the parameters
S TMP=$$UP^XLFSTR($G(REGISTRY)),REGIEN=+TMP
I TMP'=REGIEN D:TMP?3.UNP
. S REGIEN=$$REGIEN^RORUTL02(TMP)
. S:REGIEN<0 TMP=$$ERROR^RORERR(REGIEN)
I REGIEN'>0 D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$ERROR^RORERR(-88,,,,"REGISTRY",$G(REGISTRY))
;--- Initialize the variables
K RESULTS
;--- Load the registry info
S IENS=REGIEN_",",TMP=".01;.09;1;2;4;11;19.1;19.2"
D GETS^DIQ(798.1,IENS,TMP,"I","RORBUF","RORMSG")
I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$DBS^RORERR("RORMSG",-9,,,798.1,IENS)
;--- Registry IEN and Name
S RESULTS(1)=REGIEN_"^"_$G(RORBUF(798.1,IENS,.01,"I"))
;--- National
S RESULTS(2)=+$G(RORBUF(798.1,IENS,.09,"I"))
;--- Registry Description
S RESULTS(3)=$G(RORBUF(798.1,IENS,4,"I"))
;--- Registry Updated Until
S RESULTS(4)=$G(RORBUF(798.1,IENS,1,"I"))
;--- Data Extracted Until
S RESULTS(5)=$G(RORBUF(798.1,IENS,2,"I"))
;--- Number of Active Patients
S RESULTS(6)=+$G(RORBUF(798.1,IENS,19.1,"I"))
;--- Number of Pending Patients
S RESULTS(7)=+$G(RORBUF(798.1,IENS,19.2,"I"))
;--- Registry Status
S TMP=+$G(RORBUF(798.1,IENS,11,"I"))
S $P(TMP,"^",2)=$$EXTERNAL^DILFD(798.1,11,,TMP,"RORMSG")
S RESULTS(8)=TMP
;--- reserved (former Awaiting Acknowledgement)
S RESULTS(9)=""
;--- Version information
S TMP="CLINICAL CASE REGISTRIES"
S RESULTS(10)=$$VERSION^XPDUTL(TMP),TMP=$$LAST^XPDUTL(TMP)
S:TMP>0 $P(RESULTS(10),"^",2,3)=+TMP_"^"_$P(TMP,U,2)
;---
S RESULTS(0)=0
Q
;
;***** RETURNS LIST OF REGISTRY SELECTION RULES
; RPC: [ROR LIST SELECTION RULES]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; REGIEN Registry IEN
;
; See the description of the ROR LIST SELECTION RULES remote
; procedure for more details.
;
; Return Values:
;
; A negative value of the first "^"-piece of the RESULTS(0) node
; indicates an error (see the RPCSTK^RORERR procedure for details).
;
SELRULES(RESULTS,REGIEN) ;
N CNT,IEN,IENS,IRL,RC,RORBUF,RORLST,RORMSG
D CLEAR^RORERR("SELRULES^RORRP014",1)
K RESULTS S (RESULTS(0),CNT)=0
;
;=== Check the parameters
S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
. ;--- Registry IEN
. I $G(REGIEN)'>0 D Q
. . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
. S REGIEN=+REGIEN
;
;=== Load the list of selection rules
S IENS=","_REGIEN_","
D LIST^DIC(798.13,IENS,"@;.01",,,,,"B",,,"RORLST","RORMSG")
I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$DBS^RORERR("RORMSG",-9,,,798.13,IENS)
;
;=== Add rule definitions to the results
S IRL=0
F S IRL=$O(RORLST("DILIST","ID",IRL)) Q:IRL'>0 D
. K RORBUF,RORMSG
. S NAME=RORLST("DILIST","ID",IRL,.01)
. S IEN=$$SRLIEN^RORUTL02(NAME,".01;4",.RORBUF) Q:IEN'>0
. S CNT=CNT+1,RESULTS(CNT)=IEN
. S $P(RESULTS(CNT),U,2)=$G(RORBUF("DILIST","ID",1,.01))
. S $P(RESULTS(CNT),U,3)=$G(RORBUF("DILIST","ID",1,4))
;
;=== Success
S RESULTS(0)=CNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORRP014 4703 printed Apr 09, 2024@20:46:35 Page 2
RORRP014 ;HCIOFO/SG - RPC: REGISTRY INFO & PARAMETERS ; 11/14/05 8:31am
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
+5 ;***** RETURNS THE REGISTRY INFORMATION
+6 ; RPC: [ROR GET REGISTRY INFO]
+7 ;
+8 ; .RESULTS Reference to a local variable where the results
+9 ; are returned to.
+10 ;
+11 ; REGISTRY Either a registry IEN or a registry name
+12 ;
+13 ; Return Values:
+14 ;
+15 ; A negative value of the first "^"-piece of the RESULTS(0) indicates
+16 ; an error (see the RPCSTK^RORERR procedure for more details).
+17 ;
+18 ; Otherwise, 0 is returned in the RESULTS(0) and the subsequent
+19 ; nodes of the RESULTS array contain the registry information.
+20 ;
+21 ; RESULTS(0) 0
+22 ;
+23 ; RESULTS(1) Registry
+24 ; ^01: IEN
+25 ; ^02: Name
+26 ;
+27 ; RESULTS(2) National (0/1)
+28 ;
+29 ; RESULTS(3) Registry Description
+30 ;
+31 ; RESULTS(4) Last registry update date (int)
+32 ;
+33 ; RESULTS(5) Last data extraction date (int)
+34 ;
+35 ; RESULTS(6) Number of Active Patients
+36 ;
+37 ; RESULTS(7) Number of Pending Patients
+38 ;
+39 ; RESULTS(8) Registry Status
+40 ; ^01: Internal value (0-Active, 1-Inactive)
+41 ; ^02: External value
+42 ;
+43 ; RESULTS(9) reserved
+44 ;
+45 ; RESULTS(10) Version information
+46 ; ^01: Package version
+47 ; ^02: Latest patch number
+48 ; ^03: Date of the latest patch (int)
+49 ;
REGINFO(RESULTS,REGISTRY) ;
+1 NEW IENS,RC,REGIEN,RORBUF,RORERRDL,RORMSG,TMP
+2 DO CLEAR^RORERR("REGINFO^RORRP014",1)
+3 ;--- Check the parameters
+4 SET TMP=$$UP^XLFSTR($GET(REGISTRY))
SET REGIEN=+TMP
+5 IF TMP'=REGIEN
if TMP?3.UNP
Begin DoDot:1
+6 SET REGIEN=$$REGIEN^RORUTL02(TMP)
+7 if REGIEN<0
SET TMP=$$ERROR^RORERR(REGIEN)
End DoDot:1
+8 IF REGIEN'>0
Begin DoDot:1
+9 SET RC=$$ERROR^RORERR(-88,,,,"REGISTRY",$GET(REGISTRY))
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+10 ;--- Initialize the variables
+11 KILL RESULTS
+12 ;--- Load the registry info
+13 SET IENS=REGIEN_","
SET TMP=".01;.09;1;2;4;11;19.1;19.2"
+14 DO GETS^DIQ(798.1,IENS,TMP,"I","RORBUF","RORMSG")
+15 IF $GET(DIERR)
Begin DoDot:1
+16 SET RC=$$DBS^RORERR("RORMSG",-9,,,798.1,IENS)
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+17 ;--- Registry IEN and Name
+18 SET RESULTS(1)=REGIEN_"^"_$GET(RORBUF(798.1,IENS,.01,"I"))
+19 ;--- National
+20 SET RESULTS(2)=+$GET(RORBUF(798.1,IENS,.09,"I"))
+21 ;--- Registry Description
+22 SET RESULTS(3)=$GET(RORBUF(798.1,IENS,4,"I"))
+23 ;--- Registry Updated Until
+24 SET RESULTS(4)=$GET(RORBUF(798.1,IENS,1,"I"))
+25 ;--- Data Extracted Until
+26 SET RESULTS(5)=$GET(RORBUF(798.1,IENS,2,"I"))
+27 ;--- Number of Active Patients
+28 SET RESULTS(6)=+$GET(RORBUF(798.1,IENS,19.1,"I"))
+29 ;--- Number of Pending Patients
+30 SET RESULTS(7)=+$GET(RORBUF(798.1,IENS,19.2,"I"))
+31 ;--- Registry Status
+32 SET TMP=+$GET(RORBUF(798.1,IENS,11,"I"))
+33 SET $PIECE(TMP,"^",2)=$$EXTERNAL^DILFD(798.1,11,,TMP,"RORMSG")
+34 SET RESULTS(8)=TMP
+35 ;--- reserved (former Awaiting Acknowledgement)
+36 SET RESULTS(9)=""
+37 ;--- Version information
+38 SET TMP="CLINICAL CASE REGISTRIES"
+39 SET RESULTS(10)=$$VERSION^XPDUTL(TMP)
SET TMP=$$LAST^XPDUTL(TMP)
+40 if TMP>0
SET $PIECE(RESULTS(10),"^",2,3)=+TMP_"^"_$PIECE(TMP,U,2)
+41 ;---
+42 SET RESULTS(0)=0
+43 QUIT
+44 ;
+45 ;***** RETURNS LIST OF REGISTRY SELECTION RULES
+46 ; RPC: [ROR LIST SELECTION RULES]
+47 ;
+48 ; .RESULTS Reference to a local variable where the results
+49 ; are returned to.
+50 ;
+51 ; REGIEN Registry IEN
+52 ;
+53 ; See the description of the ROR LIST SELECTION RULES remote
+54 ; procedure for more details.
+55 ;
+56 ; Return Values:
+57 ;
+58 ; A negative value of the first "^"-piece of the RESULTS(0) node
+59 ; indicates an error (see the RPCSTK^RORERR procedure for details).
+60 ;
SELRULES(RESULTS,REGIEN) ;
+1 NEW CNT,IEN,IENS,IRL,RC,RORBUF,RORLST,RORMSG
+2 DO CLEAR^RORERR("SELRULES^RORRP014",1)
+3 KILL RESULTS
SET (RESULTS(0),CNT)=0
+4 ;
+5 ;=== Check the parameters
+6 SET RC=0
Begin DoDot:1
+7 ;--- Registry IEN
+8 IF $GET(REGIEN)'>0
Begin DoDot:2
+9 SET RC=$$ERROR^RORERR(-88,,,,"REGIEN",$GET(REGIEN))
End DoDot:2
QUIT
+10 SET REGIEN=+REGIEN
End DoDot:1
IF RC<0
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+11 ;
+12 ;=== Load the list of selection rules
+13 SET IENS=","_REGIEN_","
+14 DO LIST^DIC(798.13,IENS,"@;.01",,,,,"B",,,"RORLST","RORMSG")
+15 IF $GET(DIERR)
Begin DoDot:1
+16 SET RC=$$DBS^RORERR("RORMSG",-9,,,798.13,IENS)
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+17 ;
+18 ;=== Add rule definitions to the results
+19 SET IRL=0
+20 FOR
SET IRL=$ORDER(RORLST("DILIST","ID",IRL))
if IRL'>0
QUIT
Begin DoDot:1
+21 KILL RORBUF,RORMSG
+22 SET NAME=RORLST("DILIST","ID",IRL,.01)
+23 SET IEN=$$SRLIEN^RORUTL02(NAME,".01;4",.RORBUF)
if IEN'>0
QUIT
+24 SET CNT=CNT+1
SET RESULTS(CNT)=IEN
+25 SET $PIECE(RESULTS(CNT),U,2)=$GET(RORBUF("DILIST","ID",1,.01))
+26 SET $PIECE(RESULTS(CNT),U,3)=$GET(RORBUF("DILIST","ID",1,4))
End DoDot:1
+27 ;
+28 ;=== Success
+29 SET RESULTS(0)=CNT
+30 QUIT
