RORRP012 ;HCIOFO/SG - RPC: MISCELLANEOUS ; 12/15/05 4:03pm
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
Q
;
;***** RETURNS THE CURRENT DATE/TIME ON THE SERVER
; RPC: [ROR GET SERVER TIME]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; Return Values:
;
; The current dat/time (in internal FileMan format) is returned
; in the RESULTS(1). RESULTS(0) alwais contains 0.
;
GETSRVDT(RESULTS) ;
S RESULTS(0)=0
S RESULTS(1)=$$NOW^XLFDT
Q
;
;***** RETURNS A LIST OF ITEMS FROM THE 'ROR LIST ITEM' FILE
; RPC: [ROR LIST ITEMS]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; REGIEN Registry IEN
;
; TYPE Type of the items:
; 3 Lab Group
; 4 Drug Group
;
; 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, number of items is returned in the RESULTS(0)
; and the subsequent nodes of the array contain the items.
;
; RESULTS(0) Number of item
;
; RESULTS(i) List Item
; ^01: IEN
; ^02: Text
; ^03: Code
;
LSTITEMS(RESULTS,REGIEN,TYPE) ;
N CNT,CODE,ITEMS,RC,RORERRDL
D CLEAR^RORERR("LSTITEMS^RORRP012",1)
K RESULTS S RESULTS(0)=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
. ;--- Type
. I $G(TYPE)'>0 D Q
. . S RC=$$ERROR^RORERR(-88,,,,"TYPE",$G(TYPE))
. S TYPE=+TYPE
;--- Load the list items
S RC=$$ITEMLIST^RORUTL09(TYPE,REGIEN,.ITEMS)
;--- Populate the output array
S CODE="",CNT=0
F S CODE=$O(ITEMS(CODE)) Q:CODE="" D
. S CNT=CNT+1,RESULTS(CNT)=$P(ITEMS(CODE),U,1,2)
. S $P(RESULTS(CNT),U,3)=CODE
S RESULTS(0)=CNT
Q
;
;***** CHECKS FOR PRODUCTION ACCOUNT
; RPC: [ROR PRODUCTION ACCOUNT]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; Return Values:
;
; 1 is returned in RESULTS(0) in case of a production account.
; Otherwise, zero is returned.
;
PROD(RESULTS) ;
S RESULTS(0)=+$$PROD^XUPROD()
Q
;
;***** CHECKS IF THE RESCHEDULING CODE IS VALID
; ROR: [ROR TASK VALIDATE RESCHEDULING]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; SCHCODE Rescheduling code
;
; [SCHDT] Date when a task is scheduled to run for the
; first time (FileMan). By default (if $G(SCHDT)'>0),
; the current date/time is used.
;
; 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, either 1 (the rescheduling code is valid) or 0 (the
; code is not valid) is returned in the RESULTS(0). If the code is
; valid then the next date/time to run the task (FileMan format)
; is returned in the RESULTS(1).
;
VALIDSCH(RESULTS,SCHCODE,SCHDT) ;
N NEXT,RORMSG,TMP K RESULTS
I $G(SCHCODE)="" S RESULTS(0)=1 Q
S RESULTS(0)=0
;--- Check if the rescheduling code is correct
S:$G(SCHDT)'>0 SCHDT=$$NOW^XLFDT
S NEXT=$$SCH^XLFDT(SCHCODE,SCHDT,1)
Q:NEXT'>0
;--- Make sure that a task will not be rescheduled in less
;--- than 60 seconds (to be able to delete it if necessary)
S TMP=$$SCH^XLFDT(SCHCODE,NEXT,1)
S:$$FMDIFF^XLFDT(TMP,NEXT,2)'<60 RESULTS(0)=1,RESULTS(1)=NEXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORRP012 3762 printed Apr 09, 2024@20:49:18 Page 2
RORRP012 ;HCIOFO/SG - RPC: MISCELLANEOUS ; 12/15/05 4:03pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
+5 ;***** RETURNS THE CURRENT DATE/TIME ON THE SERVER
+6 ; RPC: [ROR GET SERVER TIME]
+7 ;
+8 ; .RESULTS Reference to a local variable where the results
+9 ; are returned to.
+10 ;
+11 ; Return Values:
+12 ;
+13 ; The current dat/time (in internal FileMan format) is returned
+14 ; in the RESULTS(1). RESULTS(0) alwais contains 0.
+15 ;
GETSRVDT(RESULTS) ;
+1 SET RESULTS(0)=0
+2 SET RESULTS(1)=$$NOW^XLFDT
+3 QUIT
+4 ;
+5 ;***** RETURNS A LIST OF ITEMS FROM THE 'ROR LIST ITEM' FILE
+6 ; RPC: [ROR LIST ITEMS]
+7 ;
+8 ; .RESULTS Reference to a local variable where the results
+9 ; are returned to.
+10 ;
+11 ; REGIEN Registry IEN
+12 ;
+13 ; TYPE Type of the items:
+14 ; 3 Lab Group
+15 ; 4 Drug Group
+16 ;
+17 ; Return Values:
+18 ;
+19 ; A negative value of the first "^"-piece of the RESULTS(0)
+20 ; indicates an error (see the RPCSTK^RORERR procedure for more
+21 ; details).
+22 ;
+23 ; Otherwise, number of items is returned in the RESULTS(0)
+24 ; and the subsequent nodes of the array contain the items.
+25 ;
+26 ; RESULTS(0) Number of item
+27 ;
+28 ; RESULTS(i) List Item
+29 ; ^01: IEN
+30 ; ^02: Text
+31 ; ^03: Code
+32 ;
LSTITEMS(RESULTS,REGIEN,TYPE) ;
+1 NEW CNT,CODE,ITEMS,RC,RORERRDL
+2 DO CLEAR^RORERR("LSTITEMS^RORRP012",1)
+3 KILL RESULTS
SET RESULTS(0)=0
+4 ;--- Check the parameters
+5 SET RC=0
Begin DoDot:1
+6 ;--- Registry IEN
+7 IF $GET(REGIEN)'>0
Begin DoDot:2
+8 SET RC=$$ERROR^RORERR(-88,,,,"REGIEN",$GET(REGIEN))
End DoDot:2
QUIT
+9 SET REGIEN=+REGIEN
+10 ;--- Type
+11 IF $GET(TYPE)'>0
Begin DoDot:2
+12 SET RC=$$ERROR^RORERR(-88,,,,"TYPE",$GET(TYPE))
End DoDot:2
QUIT
+13 SET TYPE=+TYPE
End DoDot:1
IF RC<0
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+14 ;--- Load the list items
+15 SET RC=$$ITEMLIST^RORUTL09(TYPE,REGIEN,.ITEMS)
+16 ;--- Populate the output array
+17 SET CODE=""
SET CNT=0
+18 FOR
SET CODE=$ORDER(ITEMS(CODE))
if CODE=""
QUIT
Begin DoDot:1
+19 SET CNT=CNT+1
SET RESULTS(CNT)=$PIECE(ITEMS(CODE),U,1,2)
+20 SET $PIECE(RESULTS(CNT),U,3)=CODE
End DoDot:1
+21 SET RESULTS(0)=CNT
+22 QUIT
+23 ;
+24 ;***** CHECKS FOR PRODUCTION ACCOUNT
+25 ; RPC: [ROR PRODUCTION ACCOUNT]
+26 ;
+27 ; .RESULTS Reference to a local variable where the results
+28 ; are returned to.
+29 ;
+30 ; Return Values:
+31 ;
+32 ; 1 is returned in RESULTS(0) in case of a production account.
+33 ; Otherwise, zero is returned.
+34 ;
PROD(RESULTS) ;
+1 SET RESULTS(0)=+$$PROD^XUPROD()
+2 QUIT
+3 ;
+4 ;***** CHECKS IF THE RESCHEDULING CODE IS VALID
+5 ; ROR: [ROR TASK VALIDATE RESCHEDULING]
+6 ;
+7 ; .RESULTS Reference to a local variable where the results
+8 ; are returned to.
+9 ;
+10 ; SCHCODE Rescheduling code
+11 ;
+12 ; [SCHDT] Date when a task is scheduled to run for the
+13 ; first time (FileMan). By default (if $G(SCHDT)'>0),
+14 ; the current date/time is used.
+15 ;
+16 ; Return Values:
+17 ;
+18 ; A negative value of the first "^"-piece of the RESULTS(0) indicates
+19 ; an error (see the RPCSTK^RORERR procedure for more details).
+20 ;
+21 ; Otherwise, either 1 (the rescheduling code is valid) or 0 (the
+22 ; code is not valid) is returned in the RESULTS(0). If the code is
+23 ; valid then the next date/time to run the task (FileMan format)
+24 ; is returned in the RESULTS(1).
+25 ;
VALIDSCH(RESULTS,SCHCODE,SCHDT) ;
+1 NEW NEXT,RORMSG,TMP
KILL RESULTS
+2 IF $GET(SCHCODE)=""
SET RESULTS(0)=1
QUIT
+3 SET RESULTS(0)=0
+4 ;--- Check if the rescheduling code is correct
+5 if $GET(SCHDT)'>0
SET SCHDT=$$NOW^XLFDT
+6 SET NEXT=$$SCH^XLFDT(SCHCODE,SCHDT,1)
+7 if NEXT'>0
QUIT
+8 ;--- Make sure that a task will not be rescheduled in less
+9 ;--- than 60 seconds (to be able to delete it if necessary)
+10 SET TMP=$$SCH^XLFDT(SCHCODE,NEXT,1)
+11 if $$FMDIFF^XLFDT(TMP,NEXT,2)'<60
SET RESULTS(0)=1
SET RESULTS(1)=NEXT
+12 QUIT
