source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORUTL09.m@ 699

Last change on this file since 699 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1RORUTL09 ;HCIOFO/SG - LIST ITEM UTILITIES ; 4/26/05 10:46am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** RETURNS CODE AND TEXT OF THE ITEM IN THE FILE #799.1
7 ;
8 ; ITEMIEN IEN of the item
9 ; [.TEXT] Text of the item is returned via this parameter
10 ;
11 ; Return Values:
12 ; <0 Error code
13 ; "" Code is not available
14 ; >0 Code of the item
15 ;
16ITEMCODE(ITEMIEN,TEXT) ;
17 S TEXT="" Q:ITEMIEN'>0 ""
18 Q:'$D(^ROR(799.1,+ITEMIEN,0)) ""
19 N IENS,RC,RORBUF,RORMSG
20 S IENS=(+ITEMIEN)_","
21 D GETS^DIQ(799.1,IENS,".01;.04",,"RORBUF","RORMSG")
22 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.1,IENS)
23 S TEXT=$G(RORBUF(799.1,IENS,.01))
24 Q $G(RORBUF(799.1,IENS,.04))
25 ;
26 ;***** RETURNS IEN AND TEXT OF THE ITEM IN THE FILE #799.1
27 ;
28 ; TYPE Type of the item
29 ; REGIEN Registry IEN
30 ; CODE Code of the item
31 ; [.TEXT] Text of the item is returned via this parameter
32 ;
33 ; Return Values:
34 ; <0 Error code
35 ; >0 IEN of the item
36 ;
37ITEMIEN(TYPE,REGIEN,CODE,TEXT) ;
38 N RC,RORBUF,RORMSG,SRCHVAL
39 S TEXT="",SRCHVAL(1)=+TYPE,SRCHVAL(2)=+REGIEN,SRCHVAL(3)=+CODE
40 D FIND^DIC(799.1,,"@;.01","QX",.SRCHVAL,2,"KEY",,,"RORBUF","RORMSG")
41 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.1)
42 S RC=+$G(RORBUF("DILIST",0))
43 S:RC=1 TEXT=$G(RORBUF("DILIST","ID",1,.01))
44 Q $S(RC<1:-80,RC>1:-81,1:+RORBUF("DILIST",2,1))
45 ;
46 ;***** RETURNS A LIST OF ITEMS FROM THE FILE #799.1
47 ;
48 ; TYPE Type of the items:
49 ; 3 Lab Group
50 ; 4 Drug Group
51 ;
52 ; REGIEN Registry IEN
53 ;
54 ; .ROR8DST Reference to a destination array.
55 ; Items are returned into this array in the following
56 ; format: ROR8DST(ItemCode)=ItemIEN^ItemText
57 ;
58 ; [CDT] "Current" Date/Time (NOW by default)
59 ;
60 ; If this date/time is equal or later that the
61 ; inactivation date from the item record (only if
62 ; there is any) then the item is considered inactive
63 ; and will be skipped.
64 ;
65 ; To include both active and inactive items in the
66 ; list, pass a negative number as the value of this
67 ; parameter.
68 ;
69 ; Return Values:
70 ; <0 Error code
71 ; 0 Ok
72 ;
73ITEMLIST(TYPE,REGIEN,ROR8DST,CDT) ;
74 N CODE,IEN,IENS,INCTVDT,NODE,RC,RORBUF,RORMSG
75 S NODE=$NA(^ROR(799.1,"KEY",TYPE,REGIEN)) K ROR8DST
76 S:'$G(CDT) CDT=$$NOW^XLFDT
77 ;--- Load the active list items
78 S CODE="",RC=0
79 F S CODE=$O(@NODE@(CODE)) Q:CODE="" D Q:RC<0
80 . S IEN=$O(@NODE@(CODE,"")) Q:'IEN
81 . S IENS=IEN_"," K RORBUF
82 . ;--- Load text and inactivation date
83 . D GETS^DIQ(799.1,IENS,".01;1","IE","RORBUF","RORMSG")
84 . I $G(DIERR) D Q
85 . . S RC=$$DBS^RORERR("RORMSG",-9,,,799.1,IENS)
86 . ;--- Skip inactive items
87 . S INCTVDT=$G(RORBUF(799.1,IENS,1,"I"))
88 . I INCTVDT>0 Q:CDT'<INCTVDT
89 . ;--- Create a record in the destination array
90 . S ROR8DST(CODE)=IEN_U_$G(RORBUF(799.1,IENS,.01,"E"))
91 Q $S(RC<0:RC,1:0)
Note: See TracBrowser for help on using the repository browser.