Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORPUT01

RORPUT01.m

Go to the documentation of this file. 
  1. RORPUT01 ;HCIOFO/SG - EDIT LOINC AND DRUG CODE MULTIPLES ; 5/19/06 11:48am
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** ADDS THE RECORDS TO THE MULTIPLE
  1.  ;
  1.  ; REGIEN        Registry IEN
  1.  ; SUBFILE       Subfile number
  1.  ; LSTREF        Reference to a list or the list itself (see the
  1.  ;               $$COMPNEXT^RORPUT01 function for more details).
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1. ADD(REGIEN,SUBFILE,LSTREF) ;
  1.  N BUF,IENS,ITEM,LI,NEXT,RC,RORFDA,RORMSG,TLI
  1.  S NEXT=$$COMPNEXT(LSTREF)  Q:NEXT<0 NEXT
  1.  S IENS="?+1,"_(+REGIEN)_",",RC=0
  1.  F TLI=1:1  X NEXT  Q:$G(BUF)'[";;"  D  Q:RC<0
  1.  . S BUF=$P(BUF,";;",2)
  1.  . D MES^RORKIDS(BUF)
  1.  . S BUF=$TR(BUF," ")
  1.  . F LI=1:1  S ITEM=$P(BUF,",",LI)  Q:ITEM=""  D  Q:RC<0
  1.  . . S RORFDA(SUBFILE,IENS,.01)=ITEM
  1.  . . D UPDATE^DIE(,"RORFDA",,"RORMSG")
  1.  . . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,SUBFILE,IENS)
  1.  Q RC
  1.  ;
  1.  ;***** RESTORES THE CDC DEFINITION
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1. CDCDEF() ;
  1.  N RC,RESULTS,RORBUF
  1.  D BMES^RORKIDS("Restoring the CDC definition...")
  1.  ;--- Restore the definition from the transport global
  1.  M RORBUF=@XPDGREF@("RORCDCDEF")
  1.  S RORBUF="HIV CDC Form Template"
  1.  D SETPARM^RORRP038(.RESULTS,"ICRCDCDEF","PKG",.RORBUF)
  1.  Q:$G(RESULTS(0))<0 +RESULTS(0)
  1.  ;--- Success
  1.  D MES^RORKIDS("The definition has been restored successfully.")
  1.  Q 0
  1.  ;
  1.  ;***** COMPILES THE 'NEXT' LOGIC
  1.  ;
  1.  ; PARAM         Parameter defining the list of codes. It should be
  1.  ;               either a list of codes separated by commas or a full
  1.  ;               reference (TAG^ROUTINE) to a routine label after
  1.  ;               which the list is located. In the latter case, the
  1.  ;               list itself should look like this:
  1.  ;
  1.  ;                         ;
  1.  ;                         ;***** SHORT DESCRIPTION OF THE LIST
  1.  ;                 LABEL   ;
  1.  ;                         ;;  Code1, Code2, ...
  1.  ;                         ;;  CodeN, ...
  1.  ;                         ;
  1.  ;
  1.  ;               There should be at least one line that does not
  1.  ;               contain ";;" after the list (or no lines at all).
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;       ""  The list is empty
  1.  ;     '=""  A string that should be XECUTE'd to get the next
  1.  ;           buffer with the list data
  1.  ;
  1. COMPNEXT(PARAM) ;
  1.  N I,N,NEXT,RC  Q:PARAM?." " ""
  1.  ;--- Reference to a routine label
  1.  I PARAM?1.8UN1"^"1.8UN  D  Q NEXT
  1.  . S NEXT="S BUF=$T("_$P(PARAM,U)_"+TLI"_U_$P(PARAM,U,2)_")"
  1.  ;--- List of codes separated by commas
  1.  S N=$L(PARAM,","),RC=0
  1.  F I=1:1:N  I '($P(PARAM,",",I)?." "1.N." ")  S RC=-88  Q
  1.  I RC<0,I=N  S:$P(PARAM,",",N)?." " RC=0,N=N-1
  1.  I N>0,RC'<0  D  Q NEXT
  1.  . S NEXT="S BUF=$P("""_";;"_$P(PARAM,",",1,N)_""",U,TLI)"
  1.  ;--- Invalid parameter
  1.  Q $$ERROR^RORERR(-88,,,,"List of Codes",PARAM)
  1.  ;
  1.  ;***** ADDS ITEMS TO 'EXTRACTED RESULT' MULTIPLE OF FILE #798.1
  1.  ;
  1.  ; [RORREG]      Registry IEN and registry name separated by the '^'
  1.  ;               (RegistryIEN^RegistryName).
  1.  ;
  1.  ; [RORLNCAD]    Either a list of LOINC codes (without check digits)
  1.  ;               separated by commas or a full reference (TAG^ROUTINE)
  1.  ;               to a routine label after which the list is located.
  1.  ;
  1.  ;               All spaces are removed from the lines of the list.
  1.  ;               See the $$COMPNEXT^RORPUT01 function for more
  1.  ;               details.
  1.  ;
  1.  ; If some of these parameters are omitted or equal to an empty
  1.  ; strings, their values must be defined as the RORPARM("KIDS")
  1.  ; sub-nodes of the same name.
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1. LOINCADD(RORREG,RORLNCAD) ;
  1.  N RC
  1.  D BMES^RORKIDS("Adding new LOINC codes to the EXTRACTED RESULT multiple...")
  1.  ;--- Get the parameters
  1.  S:'$G(RORREG) RORREG=$$PARAM^RORKIDS("RORREG")
  1.  S:$G(RORLNCAD)="" RORLNCAD=$$PARAM^RORKIDS("RORLNCAD")
  1.  ;--- Add new LOINC codes
  1.  S RC=$$ADD(+RORREG,798.112,RORLNCAD)  Q:RC<0 RC
  1.  ;--- Success
  1.  D MES^RORKIDS("The LOINC list has been updated successfully.")
  1.  Q 0
  1.  ;
  1.  ;***** REMOVES ITEMS FROM 'EXTRACTED RESULT' MULTIPLE OF FILE #798.1
  1.  ;
  1.  ; [RORREG]      Registry IEN and registry name separated by the '^'
  1.  ;               (RegistryIEN^RegistryName).
  1.  ;
  1.  ; [RORLNCRM]    Either a list of LOINC codes (without check digits)
  1.  ;               separated by commas or a full reference (TAG^ROUTINE)
  1.  ;               to a routine label after which the list is located.
  1.  ;
  1.  ;               All spaces are removed from the lines of the list.
  1.  ;               See the $$COMPNEXT^RORPUT01 function for more
  1.  ;               details.
  1.  ;
  1.  ; If some of these parameters are omitted or equal to an empty
  1.  ; strings, their values must be defined as the RORPARM("KIDS")
  1.  ; sub-nodes of the same name.
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1. LOINCREM(RORREG,RORLNCRM) ;
  1.  N BUF,DA,DIK,IENS,IR,LCI,LOINC,NEXT,RC,RORBUF,RORMSG,TLI
  1.  D BMES^RORKIDS("Removing obsolete codes from the EXTRACTED RESULT multiple...")
  1.  ;--- Get the parameters
  1.  S:'$G(RORREG) RORREG=$$PARAM^RORKIDS("RORREG")
  1.  S:$G(RORLNCRM)="" RORLNCRM=$$PARAM^RORKIDS("RORLNCRM")
  1.  ;--- Delete unnecessary LOINC codes
  1.  S RC=$$REMOVE(+RORREG,798.112,RORLNCRM)  Q:RC<0 RC
  1.  ;--- Success
  1.  D MES^RORKIDS("The LOINC list has been updated successfully.")
  1.  Q 0
  1.  ;
  1.  ;***** REMOVES THE RECORDS FROM THE MULTIPLE
  1.  ;
  1.  ; REGIEN        Registry IEN
  1.  ; SUBFILE       Subfile number
  1.  ; LSTREF        Reference to a list or the list itself (see the
  1.  ;               $$COMPNEXT^RORPUT01 function for more details).
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1. REMOVE(REGIEN,SUBFILE,LSTREF) ;
  1.  N BUF,DA,DIK,IENS,IR,ITEM,LI,NEXT,RC,RORBUF,RORMSG,TLI
  1.  S NEXT=$$COMPNEXT(LSTREF)  Q:NEXT<0 NEXT
  1.  S IENS=","_(+REGIEN)_",",RC=0
  1.  F TLI=1:1  X NEXT  Q:$G(BUF)'[";;"  D  Q:RC<0
  1.  . S BUF=$P(BUF,";;",2)
  1.  . D MES^RORKIDS(BUF)
  1.  . S BUF=$TR(BUF," ")
  1.  . F LI=1:1  S ITEM=$P(BUF,",",LI)  Q:ITEM=""  D  Q:RC<0
  1.  . . K RORBUF
  1.  . . D FIND^DIC(SUBFILE,IENS,"@","QX",ITEM,,"B",,,"RORBUF","RORMSG")
  1.  . . I $G(DIERR)  S RC=$$DBS^RORERR("RORMSG",-9,,,SUBFILE,IENS)  Q
  1.  . . S IR="",DIK=$$ROOT^DILFD(SUBFILE,IENS),DA(1)=+REGIEN
  1.  . . F  S IR=$O(RORBUF("DILIST",2,IR))  Q:IR=""  D
  1.  . . . S DA=RORBUF("DILIST",2,IR)  D ^DIK
  1.  Q RC
  1.  ;
  1.  ;***** UPDATES (POPULATES) THE LOCAL REGISTRY
  1.  ;
  1.  ; [RORREG]      Registry IEN and registry name separated by the '^'
  1.  ;               (RegistryIEN^RegistryName).
  1.  ; [MAXNTSK]     Maximum number of registry update subtasks
  1.  ; [SUSPEND]     Suspend update (sub)tasks during the peak hours
  1.  ;               (StartTime^EndTime)
  1.  ;
  1.  ; If some of these parameters are omitted or equal to an empty
  1.  ; strings, their values must be defined as the RORPARM("KIDS")
  1.  ; sub-nodes of the same name.
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1. UPDATE(RORREG,MAXNTSK,SUSPEND) ;
  1.  N EC,REGLST
  1.  D BMES^RORKIDS("Updating the local registry...")
  1.  ;--- Get the parameters
  1.  S:'$G(RORREG) RORREG=$$PARAM^RORKIDS("RORREG")
  1.  S:RORREG REGLST($P(RORREG,U,2))=+RORREG
  1.  S:$G(MAXNTSK)="" MAXNTSK=$$PARAM^RORKIDS("MAXNTSK")
  1.  S:$G(SUSPEND)="" SUSPEND=$$PARAM^RORKIDS("SUSPEND")
  1.  ;--- Update the registry
  1.  S RC=$$UPDATE^RORUPD(.REGLST,,MAXNTSK,SUSPEND)  Q:RC<0 RC
  1.  ;--- Success
  1.  D MES^RORKIDS("Registry update completed.")
  1.  Q 0