source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP014.m@ 1464

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