source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP012.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1RORRP012 ;HCIOFO/SG - RPC: MISCELLANEOUS ; 12/15/05 4:03pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** RETURNS THE CURRENT DATE/TIME ON THE SERVER
7 ; RPC: [ROR GET SERVER TIME]
8 ;
9 ; .RESULTS Reference to a local variable where the results
10 ; are returned to.
11 ;
12 ; Return Values:
13 ;
14 ; The current dat/time (in internal FileMan format) is returned
15 ; in the RESULTS(1). RESULTS(0) alwais contains 0.
16 ;
17GETSRVDT(RESULTS) ;
18 S RESULTS(0)=0
19 S RESULTS(1)=$$NOW^XLFDT
20 Q
21 ;
22 ;***** RETURNS A LIST OF ITEMS FROM THE 'ROR LIST ITEM' FILE
23 ; RPC: [ROR LIST ITEMS]
24 ;
25 ; .RESULTS Reference to a local variable where the results
26 ; are returned to.
27 ;
28 ; REGIEN Registry IEN
29 ;
30 ; TYPE Type of the items:
31 ; 3 Lab Group
32 ; 4 Drug Group
33 ;
34 ; Return Values:
35 ;
36 ; A negative value of the first "^"-piece of the RESULTS(0)
37 ; indicates an error (see the RPCSTK^RORERR procedure for more
38 ; details).
39 ;
40 ; Otherwise, number of items is returned in the RESULTS(0)
41 ; and the subsequent nodes of the array contain the items.
42 ;
43 ; RESULTS(0) Number of item
44 ;
45 ; RESULTS(i) List Item
46 ; ^01: IEN
47 ; ^02: Text
48 ; ^03: Code
49 ;
50LSTITEMS(RESULTS,REGIEN,TYPE) ;
51 N CNT,CODE,ITEMS,RC,RORERRDL
52 D CLEAR^RORERR("LSTITEMS^RORRP012",1)
53 K RESULTS S RESULTS(0)=0
54 ;--- Check the parameters
55 S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
56 . ;--- Registry IEN
57 . I $G(REGIEN)'>0 D Q
58 . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
59 . S REGIEN=+REGIEN
60 . ;--- Type
61 . I $G(TYPE)'>0 D Q
62 . . S RC=$$ERROR^RORERR(-88,,,,"TYPE",$G(TYPE))
63 . S TYPE=+TYPE
64 ;--- Load the list items
65 S RC=$$ITEMLIST^RORUTL09(TYPE,REGIEN,.ITEMS)
66 ;--- Populate the output array
67 S CODE="",CNT=0
68 F S CODE=$O(ITEMS(CODE)) Q:CODE="" D
69 . S CNT=CNT+1,RESULTS(CNT)=$P(ITEMS(CODE),U,1,2)
70 . S $P(RESULTS(CNT),U,3)=CODE
71 S RESULTS(0)=CNT
72 Q
73 ;
74 ;***** CHECKS FOR PRODUCTION ACCOUNT
75 ; RPC: [ROR PRODUCTION ACCOUNT]
76 ;
77 ; .RESULTS Reference to a local variable where the results
78 ; are returned to.
79 ;
80 ; Return Values:
81 ;
82 ; 1 is returned in RESULTS(0) in case of a production account.
83 ; Otherwise, zero is returned.
84 ;
85PROD(RESULTS) ;
86 S RESULTS(0)=+$$PROD^XUPROD()
87 Q
88 ;
89 ;***** CHECKS IF THE RESCHEDULING CODE IS VALID
90 ; ROR: [ROR TASK VALIDATE RESCHEDULING]
91 ;
92 ; .RESULTS Reference to a local variable where the results
93 ; are returned to.
94 ;
95 ; SCHCODE Rescheduling code
96 ;
97 ; [SCHDT] Date when a task is scheduled to run for the
98 ; first time (FileMan). By default (if $G(SCHDT)'>0),
99 ; the current date/time is used.
100 ;
101 ; Return Values:
102 ;
103 ; A negative value of the first "^"-piece of the RESULTS(0) indicates
104 ; an error (see the RPCSTK^RORERR procedure for more details).
105 ;
106 ; Otherwise, either 1 (the rescheduling code is valid) or 0 (the
107 ; code is not valid) is returned in the RESULTS(0). If the code is
108 ; valid then the next date/time to run the task (FileMan format)
109 ; is returned in the RESULTS(1).
110 ;
111VALIDSCH(RESULTS,SCHCODE,SCHDT) ;
112 N NEXT,RORMSG,TMP K RESULTS
113 I $G(SCHCODE)="" S RESULTS(0)=1 Q
114 S RESULTS(0)=0
115 ;--- Check if the rescheduling code is correct
116 S:$G(SCHDT)'>0 SCHDT=$$NOW^XLFDT
117 S NEXT=$$SCH^XLFDT(SCHCODE,SCHDT,1)
118 Q:NEXT'>0
119 ;--- Make sure that a task will not be rescheduled in less
120 ;--- than 60 seconds (to be able to delete it if necessary)
121 S TMP=$$SCH^XLFDT(SCHCODE,NEXT,1)
122 S:$$FMDIFF^XLFDT(TMP,NEXT,2)'<60 RESULTS(0)=1,RESULTS(1)=NEXT
123 Q
Note: See TracBrowser for help on using the repository browser.