RORUTL09 ;HCIOFO/SG - LIST ITEM UTILITIES ; 4/26/05 10:46am
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
Q
;
;***** RETURNS CODE AND TEXT OF THE ITEM IN THE FILE #799.1
;
; ITEMIEN IEN of the item
; [.TEXT] Text of the item is returned via this parameter
;
; Return Values:
; <0 Error code
; "" Code is not available
; >0 Code of the item
;
ITEMCODE(ITEMIEN,TEXT) ;
S TEXT="" Q:ITEMIEN'>0 ""
Q:'$D(^ROR(799.1,+ITEMIEN,0)) ""
N IENS,RC,RORBUF,RORMSG
S IENS=(+ITEMIEN)_","
D GETS^DIQ(799.1,IENS,".01;.04",,"RORBUF","RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.1,IENS)
S TEXT=$G(RORBUF(799.1,IENS,.01))
Q $G(RORBUF(799.1,IENS,.04))
;
;***** RETURNS IEN AND TEXT OF THE ITEM IN THE FILE #799.1
;
; TYPE Type of the item
; REGIEN Registry IEN
; CODE Code of the item
; [.TEXT] Text of the item is returned via this parameter
;
; Return Values:
; <0 Error code
; >0 IEN of the item
;
ITEMIEN(TYPE,REGIEN,CODE,TEXT) ;
N RC,RORBUF,RORMSG,SRCHVAL
S TEXT="",SRCHVAL(1)=+TYPE,SRCHVAL(2)=+REGIEN,SRCHVAL(3)=+CODE
D FIND^DIC(799.1,,"@;.01","QX",.SRCHVAL,2,"KEY",,,"RORBUF","RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.1)
S RC=+$G(RORBUF("DILIST",0))
S:RC=1 TEXT=$G(RORBUF("DILIST","ID",1,.01))
Q $S(RC<1:-80,RC>1:-81,1:+RORBUF("DILIST",2,1))
;
;***** RETURNS A LIST OF ITEMS FROM THE FILE #799.1
;
; TYPE Type of the items:
; 3 Lab Group
; 4 Drug Group
;
; REGIEN Registry IEN
;
; .ROR8DST Reference to a destination array.
; Items are returned into this array in the following
; format: ROR8DST(ItemCode)=ItemIEN^ItemText
;
; [CDT] "Current" Date/Time (NOW by default)
;
; If this date/time is equal or later that the
; inactivation date from the item record (only if
; there is any) then the item is considered inactive
; and will be skipped.
;
; To include both active and inactive items in the
; list, pass a negative number as the value of this
; parameter.
;
; Return Values:
; <0 Error code
; 0 Ok
;
ITEMLIST(TYPE,REGIEN,ROR8DST,CDT) ;
N CODE,IEN,IENS,INCTVDT,NODE,RC,RORBUF,RORMSG
S NODE=$NA(^ROR(799.1,"KEY",TYPE,REGIEN)) K ROR8DST
S:'$G(CDT) CDT=$$NOW^XLFDT
;--- Load the active list items
S CODE="",RC=0
F S CODE=$O(@NODE@(CODE)) Q:CODE="" D Q:RC<0
. S IEN=$O(@NODE@(CODE,"")) Q:'IEN
. S IENS=IEN_"," K RORBUF
. ;--- Load text and inactivation date
. D GETS^DIQ(799.1,IENS,".01;1","IE","RORBUF","RORMSG")
. I $G(DIERR) D Q
. . S RC=$$DBS^RORERR("RORMSG",-9,,,799.1,IENS)
. ;--- Skip inactive items
. S INCTVDT=$G(RORBUF(799.1,IENS,1,"I"))
. I INCTVDT>0 Q:CDT'<INCTVDT
. ;--- Create a record in the destination array
. S ROR8DST(CODE)=IEN_U_$G(RORBUF(799.1,IENS,.01,"E"))
Q $S(RC<0:RC,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUTL09 3077 printed Dec 13, 2024@01:44:02 Page 2
RORUTL09 ;HCIOFO/SG - LIST ITEM UTILITIES ; 4/26/05 10:46am
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
+5 ;***** RETURNS CODE AND TEXT OF THE ITEM IN THE FILE #799.1
+6 ;
+7 ; ITEMIEN IEN of the item
+8 ; [.TEXT] Text of the item is returned via this parameter
+9 ;
+10 ; Return Values:
+11 ; <0 Error code
+12 ; "" Code is not available
+13 ; >0 Code of the item
+14 ;
ITEMCODE(ITEMIEN,TEXT) ;
+1 SET TEXT=""
if ITEMIEN'>0
QUIT ""
+2 if '$DATA(^ROR(799.1,+ITEMIEN,0))
QUIT ""
+3 NEW IENS,RC,RORBUF,RORMSG
+4 SET IENS=(+ITEMIEN)_","
+5 DO GETS^DIQ(799.1,IENS,".01;.04",,"RORBUF","RORMSG")
+6 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,799.1,IENS)
+7 SET TEXT=$GET(RORBUF(799.1,IENS,.01))
+8 QUIT $GET(RORBUF(799.1,IENS,.04))
+9 ;
+10 ;***** RETURNS IEN AND TEXT OF THE ITEM IN THE FILE #799.1
+11 ;
+12 ; TYPE Type of the item
+13 ; REGIEN Registry IEN
+14 ; CODE Code of the item
+15 ; [.TEXT] Text of the item is returned via this parameter
+16 ;
+17 ; Return Values:
+18 ; <0 Error code
+19 ; >0 IEN of the item
+20 ;
ITEMIEN(TYPE,REGIEN,CODE,TEXT) ;
+1 NEW RC,RORBUF,RORMSG,SRCHVAL
+2 SET TEXT=""
SET SRCHVAL(1)=+TYPE
SET SRCHVAL(2)=+REGIEN
SET SRCHVAL(3)=+CODE
+3 DO FIND^DIC(799.1,,"@;.01","QX",.SRCHVAL,2,"KEY",,,"RORBUF","RORMSG")
+4 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,799.1)
+5 SET RC=+$GET(RORBUF("DILIST",0))
+6 if RC=1
SET TEXT=$GET(RORBUF("DILIST","ID",1,.01))
+7 QUIT $SELECT(RC<1:-80,RC>1:-81,1:+RORBUF("DILIST",2,1))
+8 ;
+9 ;***** RETURNS A LIST OF ITEMS FROM THE FILE #799.1
+10 ;
+11 ; TYPE Type of the items:
+12 ; 3 Lab Group
+13 ; 4 Drug Group
+14 ;
+15 ; REGIEN Registry IEN
+16 ;
+17 ; .ROR8DST Reference to a destination array.
+18 ; Items are returned into this array in the following
+19 ; format: ROR8DST(ItemCode)=ItemIEN^ItemText
+20 ;
+21 ; [CDT] "Current" Date/Time (NOW by default)
+22 ;
+23 ; If this date/time is equal or later that the
+24 ; inactivation date from the item record (only if
+25 ; there is any) then the item is considered inactive
+26 ; and will be skipped.
+27 ;
+28 ; To include both active and inactive items in the
+29 ; list, pass a negative number as the value of this
+30 ; parameter.
+31 ;
+32 ; Return Values:
+33 ; <0 Error code
+34 ; 0 Ok
+35 ;
ITEMLIST(TYPE,REGIEN,ROR8DST,CDT) ;
+1 NEW CODE,IEN,IENS,INCTVDT,NODE,RC,RORBUF,RORMSG
+2 SET NODE=$NAME(^ROR(799.1,"KEY",TYPE,REGIEN))
KILL ROR8DST
+3 if '$GET(CDT)
SET CDT=$$NOW^XLFDT
+4 ;--- Load the active list items
+5 SET CODE=""
SET RC=0
+6 FOR
SET CODE=$ORDER(@NODE@(CODE))
if CODE=""
QUIT
Begin DoDot:1
+7 SET IEN=$ORDER(@NODE@(CODE,""))
if 'IEN
QUIT
+8 SET IENS=IEN_","
KILL RORBUF
+9 ;--- Load text and inactivation date
+10 DO GETS^DIQ(799.1,IENS,".01;1","IE","RORBUF","RORMSG")
+11 IF $GET(DIERR)
Begin DoDot:2
+12 SET RC=$$DBS^RORERR("RORMSG",-9,,,799.1,IENS)
End DoDot:2
QUIT
+13 ;--- Skip inactive items
+14 SET INCTVDT=$GET(RORBUF(799.1,IENS,1,"I"))
+15 IF INCTVDT>0
if CDT'<INCTVDT
QUIT
+16 ;--- Create a record in the destination array
+17 SET ROR8DST(CODE)=IEN_U_$GET(RORBUF(799.1,IENS,.01,"E"))
End DoDot:1
if RC<0
QUIT
+18 QUIT $SELECT(RC<0:RC,1:0)
