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

RORRP032.m

Go to the documentation of this file. 
  1. RORRP032 ;HCIOFO/SG - RPC: LOCAL DRUG NAMES ; 11/3/05 2:26pm
  1.  ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #4533         ZERO^PSS50 (supported)
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** PROCESSES THE ERROR(S) AND UNLOCKS THE RECORD(S)
  1. ERROR(RESULTS,RC) ;
  1.  D RPCSTK^RORERR(.RESULTS,RC)
  1.  D UNLOCK^RORLOCK(.RORLOCK)
  1.  Q
  1.  ;
  1.  ;***** RETURNS THE LIST OF LOCAL DRUG NAMES
  1.  ; RPC: [ROR LIST LOCAL DRUGS]
  1.  ;
  1.  ; .RESULTS      Reference to a local variable where the results
  1.  ;               are returned to.
  1.  ;
  1.  ; REGIEN        Registry IEN
  1.  ;
  1.  ; [GROUP]       Code of the Drug Group. If this parameter is
  1.  ;               defined and greater than zero then only the drugs
  1.  ;               associated with this group will be returned.
  1.  ;
  1.  ; The ^TMP("DILIST",$J) global node is used by the procedure.
  1.  ;
  1.  ; Return Values:
  1.  ;
  1.  ; A negative value of the first "^"-piece of the RESULTS(0)
  1.  ; indicates an error (see the RPCSTK^RORERR procedure for more
  1.  ; details).
  1.  ;
  1.  ; Otherwise, number of drugs is returned in the @RESULTS@(0) and
  1.  ; the subsequent nodes of the global array contain the drugs.
  1.  ; 
  1.  ; @RESULTS@(0)          Number of Local Drugs
  1.  ;
  1.  ; @RESULTS@(i)          Drug Descriptor
  1.  ;                         ^01: IEN in the LOCAL DRUG NAME multiple
  1.  ;                         ^02: Local drug name
  1.  ;                         ^03: IEN of the local drug
  1.  ;                         ^04: Code of the Drug Group
  1.  ;
  1. LDLIST(RESULTS,REGIEN,GROUP) ;
  1.  N GROUPIEN,IENS,IR,RC,RORERRDL,RORMSG,SCR,TMP
  1.  D CLEAR^RORERR("LDLIST^RORRP032",1)
  1.  K RESULTS  S RESULTS=$NA(^TMP("DILIST",$J))  K @RESULTS
  1.  ;
  1.  ;--- Check the parameters
  1.  S RC=0  D  I RC<0  D RPCSTK^RORERR(.RESULTS,RC)  Q
  1.  . ;--- Registry IEN
  1.  . I $G(REGIEN)'>0  D  Q
  1.  . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
  1.  . S REGIEN=+REGIEN
  1.  . ;--- Code of the Drug Group
  1.  . S GROUP=+$G(GROUP)
  1.  . S GROUPIEN=$S(GROUP>0:$$ITEMIEN^RORUTL09(4,REGIEN,GROUP),1:0)
  1.  . I GROUPIEN<0  D  Q
  1.  . . S RC=$$ERROR^RORERR(GROUPIEN)
  1.  ;
  1.  ;--- Compile the screen logic  (be careful with naked references)
  1.  S SCR=""
  1.  S:GROUPIEN>0 SCR=SCR_"I $P($G(^(0)),U,2)="_GROUPIEN_" "
  1.  ;--- Get the list of drugs
  1.  S IENS=","_REGIEN_",",TMP="@;.01E;.01I;.02I"
  1.  D LIST^DIC(798.129,IENS,TMP,"PU",,,,"B",SCR,,,"RORMSG")
  1.  I $G(DIERR)  D  D RPCSTK^RORERR(.RESULTS,RC)  Q
  1.  . S RC=$$DBS^RORERR("RORMSG",-9,,,798.129,IENS)
  1.  ;
  1.  ;--- Replace the group IEN's with the group code(s)
  1.  S (IR,RC)=0
  1.  F  S IR=$O(@RESULTS@(IR))  Q:IR'>0  D  Q:RC<0
  1.  . I GROUPIEN>0  S $P(@RESULTS@(IR,0),U,4)=GROUP  Q
  1.  . S TMP=+$P(@RESULTS@(IR,0),U,4)
  1.  . I TMP'>0  S $P(@RESULTS@(IR,0),U,4)=""  Q
  1.  . S RC=$$ITEMCODE^RORUTL09(TMP)
  1.  . S:RC>0 $P(@RESULTS@(IR,0),U,4)=RC
  1.  I RC<0  D RPCSTK^RORERR(.RESULTS,RC)  Q
  1.  ;--- Success
  1.  S TMP=+$G(^TMP("DILIST",$J,0))
  1.  K ^TMP("DILIST",$J,0)  S @RESULTS@(0)=TMP
  1.  Q
  1.  ;
  1.  ;***** UPDATES THE LIST OF LOCAL DRUG NAMES
  1.  ; RPC: [ROR UPDATE LOCAL DRUGS]
  1.  ;
  1.  ; .RESULTS      Reference to a local variable where the results
  1.  ;               are returned to.
  1.  ;
  1.  ; REGIEN        Registry IEN
  1.  ;
  1.  ; GROUP         Code of the Drug Group.
  1.  ;
  1.  ;               If this parameter is equal to 0 then every item of
  1.  ;               the LDLST must contain a valid group code. If an
  1.  ;               empty list is passed into the RPC then ALL records
  1.  ;               will be deleted from the LOCAL DRUG NAME multiple.
  1.  ;
  1.  ;               If this parameter is not zero then it should contain 
  1.  ;               a valid group code. All records of the LDLST will be
  1.  ;               associated with this group. If an empty list is
  1.  ;               passed into the RPC then only records associated
  1.  ;               with this group will be deleted from the multiple.
  1.  ;
  1.  ; .LDLST(       Reference to a local variable that contains
  1.  ;               a list of local drugs
  1.  ;
  1.  ;   i)          Test Descriptor
  1.  ;                 ^01: Ignored
  1.  ;                 ^02: Ignored
  1.  ;                 ^03: IEN of the local drug
  1.  ;                 ^04: Code of the Drug Group
  1.  ;                      (see also the GROUP parameter)
  1.  ;
  1.  ; Return Values:
  1.  ;
  1.  ; A negative value of the first "^"-piece of the RESULTS(0)
  1.  ; indicates an error (see the RPCSTK^RORERR procedure for more
  1.  ; details).
  1.  ;
  1.  ; Otherwise, zero is returned in the RESULTS(0).
  1.  ;
  1. LDLUPD(RESULTS,REGIEN,GROUP,LDLST) ;
  1.  N DA,DIK,DRUGIEN,ECNT,GROUPIEN,GRPIEN,IENS,IR,LDL,RC,ROOT,RORERRDL,RORFDA,RORLOCK,RORMSG,RORTMP,RORTS,TMP
  1.  D CLEAR^RORERR("LDLUPD^RORRP032",1)  K RESULTS
  1.  S ECNT=0
  1.  ;
  1.  ;--- Check the parameters
  1.  S RC=0  D  I RC<0  D RPCSTK^RORERR(.RESULTS,RC)  Q
  1.  . ;--- Registry IEN
  1.  . I $G(REGIEN)'>0  D  Q
  1.  . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
  1.  . S REGIEN=+REGIEN
  1.  . ;--- Code of the Drug Group
  1.  . S GROUPIEN=$S($G(GROUP)>0:$$ITEMIEN^RORUTL09(4,REGIEN,GROUP),1:0)
  1.  . I GROUPIEN<0  D  Q
  1.  . . S RC=$$ERROR^RORERR(-88,,,,"GROUP",$G(GROUP))
  1.  . S GROUP=+$G(GROUP)
  1.  ;
  1.  ;--- Lock the LOCAL DRUG NAME multiple
  1.  S IENS=","_REGIEN_","
  1.  S RC=$$LOCK^RORLOCK(798.129,IENS)
  1.  I RC  D:RC>0  D RPCSTK^RORERR(.RESULTS,RC)  Q
  1.  . S RC=$$ERROR^RORERR(-11,,,,"the LOCAL DRUG NAME multiple")
  1.  ;---
  1.  S RORLOCK(798.129,IENS)=""
  1.  S ROOT=$$ROOT^DILFD(798.129,IENS,1)
  1.  ;
  1.  ;--- Prepare the data
  1.  S RORTMP=$$ALLOC^RORTMP(.RORTS)
  1.  S IR="",RC=0
  1.  F  S IR=$O(LDLST(IR))  Q:IR=""  D  Q:RC<0
  1.  . ;--- Check if the drug is defined in the DRUG file
  1.  . S DRUGIEN=+$P(LDLST(IR),U,3)
  1.  . D ZERO^PSS50(DRUGIEN,,,,,RORTS)
  1.  . Q:$G(@RORTMP@(0))'>0
  1.  . ;--- Assign the default Group IEN (if the GROUP is provided)
  1.  . I GROUPIEN>0  S LDL(GROUPIEN,DRUGIEN)=""  Q
  1.  . ;--- Get IEN of the Drug Group
  1.  . S TMP=+$P(LDLST(IR),U,4)
  1.  . S GRPIEN=$$ITEMIEN^RORUTL09(4,REGIEN,TMP)
  1.  . I GRPIEN'>0  D:GRPIEN<0  Q
  1.  . . S RC=$$ERROR^RORERR(GRPIEN)
  1.  . ;--- Create the reference
  1.  . S LDL(GRPIEN,DRUGIEN)=""
  1.  D FREE^RORTMP(RORTMP)
  1.  I RC<0  D ERROR(.RESULTS,RC)  Q
  1.  ;---
  1.  I GROUPIEN'>0  S GRPIEN=""  D
  1.  . F  S GRPIEN=$O(@ROOT@("G",GRPIEN))  Q:GRPIEN=""  S LDL(GRPIEN)=""
  1.  E  S LDL(GROUPIEN)=""
  1.  ;
  1.  ;--- Update the multiple
  1.  S IENS="?+1,"_REGIEN_",",ECNT=0
  1.  S GRPIEN=""
  1.  F  S GRPIEN=$O(LDL(GRPIEN))  Q:GRPIEN=""  D
  1.  . ;--- Delete the old records
  1.  . S DIK=$$OREF^DILF(ROOT),DA(1)=REGIEN
  1.  . S DRUGIEN=""
  1.  . F  S DRUGIEN=$O(@ROOT@("G",GRPIEN,DRUGIEN))  Q:DRUGIEN=""  D
  1.  . . S DA=""
  1.  . . F  S DA=$O(@ROOT@("G",GRPIEN,DRUGIEN,DA))  Q:DA=""  D ^DIK
  1.  . ;--- Store the new records
  1.  . S DRUGIEN=""
  1.  . F  S DRUGIEN=$O(LDL(GRPIEN,DRUGIEN))  Q:DRUGIEN=""  D
  1.  . . S RORFDA(798.129,IENS,.01)=DRUGIEN
  1.  . . S RORFDA(798.129,IENS,.02)=GRPIEN
  1.  . . D UPDATE^DIE(,"RORFDA",,"RORMSG")
  1.  . . I $G(DIERR)  D  S ECNT=ECNT+1  Q
  1.  . . . D DBS^RORERR("RORMSG",-9,,,798.129,IENS)
  1.  ;
  1.  ;--- Unlock the multiple and check for errors
  1.  D UNLOCK^RORLOCK(798.129,","_REGIEN_",")
  1.  I ECNT>0  D RPCSTK^RORERR(.RESULTS,-9)  Q
  1.  ;--- Success
  1.  S RESULTS(0)=0
  1.  Q