- 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 Feb 18, 2025@23:10:25 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)