RORUTL08 ;HCIOFO/SG - REPORT PARAMETERS UTILITIES ; 11/21/05 5:08pm
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
Q
;
;***** RETURNS CODE AND NAME OF THE REPORT PARAMETERS (#799.34)
;
; RPIEN IEN of the report parameters
; [.NAME] Report name is returned via this parameter
;
; Return Values:
; "" Code is not available
; Code of the report
;
RPCODE(RPIEN,NAME) ;
S NAME="" Q:RPIEN'>0 ""
N BUF
S BUF=$G(^ROR(799.34,+RPIEN,0)) Q:BUF="" ""
S NAME=$P(BUF,U)
Q $P(BUF,U,4)
;
;***** RETURNS IEN AND NAME OF THE REPORT PARAMETERS (#799.34)
;
; CODE Code of the report
; [.NAME] Report name is returned via this parameter
;
; Return Values:
; <0 Error code
; >0 IEN of the item
;
RPIEN(CODE,NAME) ;
N RC,RORBUF,RORMSG S NAME=""
D FIND^DIC(799.34,,"@;.01","QX",CODE,2,"KEY",,,"RORBUF","RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.34)
S RC=+$G(RORBUF("DILIST",0))
S:RC=1 NAME=$G(RORBUF("DILIST","ID",1,.01))
Q $S(RC<1:-86,RC>1:-87,1:+RORBUF("DILIST",2,1))
;
;***** RETURNS REPORT PARAMETERS
;
; CODE Report code
;
; .INFO Reference to a local variable (output):
;
; INFO(
; OFFSET+1) Report Name
; OFFSET+2) Backgr. Processing (0/1)
; OFFSET+3) reserved
; OFFSET+4) Code of the report
; OFFSET+5) Report Parameters IEN
; OFFSET+6) Inactivation Date (FileMan)
; OFFSET+7) National (0/1)
; OFFSET+8) List of parameter panels
; OFFSET+9) Report Builder ($$TAG^ROUTINE)
; OFFSET+10) Default parameters (XML)
; OFFSET+11) Default sorting modes (XML)
; OFFSET+12) Shared Templates (0/1)
;
; [FLAGS] Characters controlling behavior of the function
; (they can be combined):
; E Return external values also (when applicable)
;
; [OFFSET] A number that is added to all subscripts in the
; destination array (by default, it is zero).
;
; Return Values:
; <0 Error code
; 0 Ok
;
RPINFO(CODE,INFO,FLAGS,OFFSET) ;
N BUF,I,IEN,IENS,RC,RORBUF,RORMSG,TMP
S FLAGS=$$UP^XLFSTR($G(FLAGS))
S OFFSET=$S($G(OFFSET)>0:+OFFSET,1:0)
;--- Clear the output array
K:'OFFSET INFO S TMP=$$RPN
F I=1:1:TMP S INFO(OFFSET+I)=""
;--- Get the record IEN
S IEN=$$RPIEN(CODE) Q:IEN<0 IEN
;--- Load the parameters
S IENS=IEN_",",I=$S(FLAGS["E":"EIN",1:"IN")
S TMP=".01;.02;.03;.04;.05;.09;1;10.01;11;12"
D GETS^DIQ(799.34,IENS,TMP,I,"RORBUF","RORMSG")
I $G(DIERR) D Q RC
. S RC=$$DBS^RORERR("RORMSG",-9,,,799.34,IENS)
;--- Name
S INFO(OFFSET+1)=$G(RORBUF(799.34,IENS,.01,"I"))
;--- Background Processing
I $G(RORBUF(799.34,IENS,.02,"I"))'="" D
. S INFO(OFFSET+2)=RORBUF(799.34,IENS,.02,"I")
;--- Code of the report
S INFO(OFFSET+4)=$G(RORBUF(799.34,IENS,.04,"I"))
;--- Report Parameters IEN
S INFO(OFFSET+5)=IEN
;--- Inactivation Date
I $G(RORBUF(799.34,IENS,.05,"I"))'="" D
. S INFO(OFFSET+6)=RORBUF(799.34,IENS,.05,"I")
;--- National
I $G(RORBUF(799.34,IENS,.09,"I"))'="" D
. S INFO(OFFSET+7)=RORBUF(799.34,IENS,.09,"I")
;--- List of parameter panels
S INFO(OFFSET+8)=$G(RORBUF(799.34,IENS,1,"I"))
;--- Report Builder
S INFO(OFFSET+9)=$G(RORBUF(799.34,IENS,10.01,"I"))
;--- Default parameters
S I=0,BUF=""
F S I=$O(RORBUF(799.34,IENS,11,I)) Q:I'>0 D
. S BUF=BUF_$$TRIM^XLFSTR(RORBUF(799.34,IENS,11,I))
S:BUF'="" INFO(OFFSET+10)="<PARAMS>"_BUF_"</PARAMS>"
;--- Default sorting modes
S I=0,BUF=""
F S I=$O(RORBUF(799.34,IENS,12,I)) Q:I'>0 D
. S BUF=BUF_$$TRIM^XLFSTR(RORBUF(799.34,IENS,12,I))
S:BUF'="" INFO(OFFSET+11)="<SORT_MODES>"_BUF_"</SORT_MODES>"
;--- Shared Templates
S INFO(OFFSET+12)=$G(RORBUF(799.34,IENS,.03,"I"))
Q 0
;
;***** RETURNS A LIST OF REPORTS AVAILABLE FOR THE REGISTRY
;
; .ROR8DST Reference to a local variable. Report parameters are
; returned into this array in the following format:
;
; ROR8DST(ReportCode)=ReportIEN^ReportName
;
; [REGIEN] Registry IEN. If $G(REGIEN)>0, both the registry
; specific (REGISTRY=REGIEN) and common (REGISTRY=0)
; reports will be returned. Otherwise, only the common
; ones will be returned.
;
; [CDT] "Current" Date/Time (NOW by default)
;
; If this date/time is equal or later that the
; inactivation date from the record (only if there
; is any) then the record is considered inactive
; and will be skipped.
;
; To include both active and inactive reports in the
; list, pass a negative number as the value of this
; parameter.
;
; Return Values:
; <0 Error code
; 0 Ok
;
RPLIST(ROR8DST,REGIEN,CDT) ;
N CODE,I,IEN,IENS,NAME,INCTVDT,RC,RORMSG,RPLST
K ROR8DST S RC=0 S:'$G(CDT) CDT=$$NOW^XLFDT
;--- Load the list of available reports (report codes)
S IENS=(+REGIEN)_","
S RPLST=$$GET1^DIQ(798.1,IENS,27,,,"RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.1,IENS)
S RPLST=$TR(RPLST," ")
;--- Load the report parameters
F I=1:1 S CODE=$P(RPLST,",",I) Q:CODE="" D Q:RC<0
. S IEN=$$RPIEN(CODE,.NAME) Q:IEN'>0
. S IENS=IEN_","
. ;--- Skip inactive report parameters
. S INCTVDT=$$GET1^DIQ(799.34,IENS,.05,"I",,"RORMSG")
. I $G(DIERR) D Q
. . S RC=$$DBS^RORERR("RORMSG",-9,,,799.34,IENS)
. I INCTVDT>0 Q:CDT'<INCTVDT
. ;--- Create a record in the destination array
. S ROR8DST(CODE)=IEN_U_NAME
Q $S(RC<0:RC,1:0)
;
;***** RETURNS NUMBER OF NODES IN THE PARAMETERS ARRAY
RPN() Q 12
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUTL08 5881 printed Apr 09, 2024@20:48:04 Page 2
RORUTL08 ;HCIOFO/SG - REPORT PARAMETERS UTILITIES ; 11/21/05 5:08pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
+5 ;***** RETURNS CODE AND NAME OF THE REPORT PARAMETERS (#799.34)
+6 ;
+7 ; RPIEN IEN of the report parameters
+8 ; [.NAME] Report name is returned via this parameter
+9 ;
+10 ; Return Values:
+11 ; "" Code is not available
+12 ; Code of the report
+13 ;
RPCODE(RPIEN,NAME) ;
+1 SET NAME=""
if RPIEN'>0
QUIT ""
+2 NEW BUF
+3 SET BUF=$GET(^ROR(799.34,+RPIEN,0))
if BUF=""
QUIT ""
+4 SET NAME=$PIECE(BUF,U)
+5 QUIT $PIECE(BUF,U,4)
+6 ;
+7 ;***** RETURNS IEN AND NAME OF THE REPORT PARAMETERS (#799.34)
+8 ;
+9 ; CODE Code of the report
+10 ; [.NAME] Report name is returned via this parameter
+11 ;
+12 ; Return Values:
+13 ; <0 Error code
+14 ; >0 IEN of the item
+15 ;
RPIEN(CODE,NAME) ;
+1 NEW RC,RORBUF,RORMSG
SET NAME=""
+2 DO FIND^DIC(799.34,,"@;.01","QX",CODE,2,"KEY",,,"RORBUF","RORMSG")
+3 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,799.34)
+4 SET RC=+$GET(RORBUF("DILIST",0))
+5 if RC=1
SET NAME=$GET(RORBUF("DILIST","ID",1,.01))
+6 QUIT $SELECT(RC<1:-86,RC>1:-87,1:+RORBUF("DILIST",2,1))
+7 ;
+8 ;***** RETURNS REPORT PARAMETERS
+9 ;
+10 ; CODE Report code
+11 ;
+12 ; .INFO Reference to a local variable (output):
+13 ;
+14 ; INFO(
+15 ; OFFSET+1) Report Name
+16 ; OFFSET+2) Backgr. Processing (0/1)
+17 ; OFFSET+3) reserved
+18 ; OFFSET+4) Code of the report
+19 ; OFFSET+5) Report Parameters IEN
+20 ; OFFSET+6) Inactivation Date (FileMan)
+21 ; OFFSET+7) National (0/1)
+22 ; OFFSET+8) List of parameter panels
+23 ; OFFSET+9) Report Builder ($$TAG^ROUTINE)
+24 ; OFFSET+10) Default parameters (XML)
+25 ; OFFSET+11) Default sorting modes (XML)
+26 ; OFFSET+12) Shared Templates (0/1)
+27 ;
+28 ; [FLAGS] Characters controlling behavior of the function
+29 ; (they can be combined):
+30 ; E Return external values also (when applicable)
+31 ;
+32 ; [OFFSET] A number that is added to all subscripts in the
+33 ; destination array (by default, it is zero).
+34 ;
+35 ; Return Values:
+36 ; <0 Error code
+37 ; 0 Ok
+38 ;
RPINFO(CODE,INFO,FLAGS,OFFSET) ;
+1 NEW BUF,I,IEN,IENS,RC,RORBUF,RORMSG,TMP
+2 SET FLAGS=$$UP^XLFSTR($GET(FLAGS))
+3 SET OFFSET=$SELECT($GET(OFFSET)>0:+OFFSET,1:0)
+4 ;--- Clear the output array
+5 if 'OFFSET
KILL INFO
SET TMP=$$RPN
+6 FOR I=1:1:TMP
SET INFO(OFFSET+I)=""
+7 ;--- Get the record IEN
+8 SET IEN=$$RPIEN(CODE)
if IEN<0
QUIT IEN
+9 ;--- Load the parameters
+10 SET IENS=IEN_","
SET I=$SELECT(FLAGS["E":"EIN",1:"IN")
+11 SET TMP=".01;.02;.03;.04;.05;.09;1;10.01;11;12"
+12 DO GETS^DIQ(799.34,IENS,TMP,I,"RORBUF","RORMSG")
+13 IF $GET(DIERR)
Begin DoDot:1
+14 SET RC=$$DBS^RORERR("RORMSG",-9,,,799.34,IENS)
End DoDot:1
QUIT RC
+15 ;--- Name
+16 SET INFO(OFFSET+1)=$GET(RORBUF(799.34,IENS,.01,"I"))
+17 ;--- Background Processing
+18 IF $GET(RORBUF(799.34,IENS,.02,"I"))'=""
Begin DoDot:1
+19 SET INFO(OFFSET+2)=RORBUF(799.34,IENS,.02,"I")
End DoDot:1
+20 ;--- Code of the report
+21 SET INFO(OFFSET+4)=$GET(RORBUF(799.34,IENS,.04,"I"))
+22 ;--- Report Parameters IEN
+23 SET INFO(OFFSET+5)=IEN
+24 ;--- Inactivation Date
+25 IF $GET(RORBUF(799.34,IENS,.05,"I"))'=""
Begin DoDot:1
+26 SET INFO(OFFSET+6)=RORBUF(799.34,IENS,.05,"I")
End DoDot:1
+27 ;--- National
+28 IF $GET(RORBUF(799.34,IENS,.09,"I"))'=""
Begin DoDot:1
+29 SET INFO(OFFSET+7)=RORBUF(799.34,IENS,.09,"I")
End DoDot:1
+30 ;--- List of parameter panels
+31 SET INFO(OFFSET+8)=$GET(RORBUF(799.34,IENS,1,"I"))
+32 ;--- Report Builder
+33 SET INFO(OFFSET+9)=$GET(RORBUF(799.34,IENS,10.01,"I"))
+34 ;--- Default parameters
+35 SET I=0
SET BUF=""
+36 FOR
SET I=$ORDER(RORBUF(799.34,IENS,11,I))
if I'>0
QUIT
Begin DoDot:1
+37 SET BUF=BUF_$$TRIM^XLFSTR(RORBUF(799.34,IENS,11,I))
End DoDot:1
+38 if BUF'=""
SET INFO(OFFSET+10)="<PARAMS>"_BUF_"</PARAMS>"
+39 ;--- Default sorting modes
+40 SET I=0
SET BUF=""
+41 FOR
SET I=$ORDER(RORBUF(799.34,IENS,12,I))
if I'>0
QUIT
Begin DoDot:1
+42 SET BUF=BUF_$$TRIM^XLFSTR(RORBUF(799.34,IENS,12,I))
End DoDot:1
+43 if BUF'=""
SET INFO(OFFSET+11)="<SORT_MODES>"_BUF_"</SORT_MODES>"
+44 ;--- Shared Templates
+45 SET INFO(OFFSET+12)=$GET(RORBUF(799.34,IENS,.03,"I"))
+46 QUIT 0
+47 ;
+48 ;***** RETURNS A LIST OF REPORTS AVAILABLE FOR THE REGISTRY
+49 ;
+50 ; .ROR8DST Reference to a local variable. Report parameters are
+51 ; returned into this array in the following format:
+52 ;
+53 ; ROR8DST(ReportCode)=ReportIEN^ReportName
+54 ;
+55 ; [REGIEN] Registry IEN. If $G(REGIEN)>0, both the registry
+56 ; specific (REGISTRY=REGIEN) and common (REGISTRY=0)
+57 ; reports will be returned. Otherwise, only the common
+58 ; ones will be returned.
+59 ;
+60 ; [CDT] "Current" Date/Time (NOW by default)
+61 ;
+62 ; If this date/time is equal or later that the
+63 ; inactivation date from the record (only if there
+64 ; is any) then the record is considered inactive
+65 ; and will be skipped.
+66 ;
+67 ; To include both active and inactive reports in the
+68 ; list, pass a negative number as the value of this
+69 ; parameter.
+70 ;
+71 ; Return Values:
+72 ; <0 Error code
+73 ; 0 Ok
+74 ;
RPLIST(ROR8DST,REGIEN,CDT) ;
+1 NEW CODE,I,IEN,IENS,NAME,INCTVDT,RC,RORMSG,RPLST
+2 KILL ROR8DST
SET RC=0
if '$GET(CDT)
SET CDT=$$NOW^XLFDT
+3 ;--- Load the list of available reports (report codes)
+4 SET IENS=(+REGIEN)_","
+5 SET RPLST=$$GET1^DIQ(798.1,IENS,27,,,"RORMSG")
+6 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,798.1,IENS)
+7 SET RPLST=$TRANSLATE(RPLST," ")
+8 ;--- Load the report parameters
+9 FOR I=1:1
SET CODE=$PIECE(RPLST,",",I)
if CODE=""
QUIT
Begin DoDot:1
+10 SET IEN=$$RPIEN(CODE,.NAME)
if IEN'>0
QUIT
+11 SET IENS=IEN_","
+12 ;--- Skip inactive report parameters
+13 SET INCTVDT=$$GET1^DIQ(799.34,IENS,.05,"I",,"RORMSG")
+14 IF $GET(DIERR)
Begin DoDot:2
+15 SET RC=$$DBS^RORERR("RORMSG",-9,,,799.34,IENS)
End DoDot:2
QUIT
+16 IF INCTVDT>0
if CDT'<INCTVDT
QUIT
+17 ;--- Create a record in the destination array
+18 SET ROR8DST(CODE)=IEN_U_NAME
End DoDot:1
if RC<0
QUIT
+19 QUIT $SELECT(RC<0:RC,1:0)
+20 ;
+21 ;***** RETURNS NUMBER OF NODES IN THE PARAMETERS ARRAY
RPN() QUIT 12
