RORRP032 ;HCIOFO/SG - RPC: LOCAL DRUG NAMES ; 11/3/05 2:26pm
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
; This routine uses the following IAs:
;
; #4533 ZERO^PSS50 (supported)
;
Q
;
;***** PROCESSES THE ERROR(S) AND UNLOCKS THE RECORD(S)
ERROR(RESULTS,RC) ;
D RPCSTK^RORERR(.RESULTS,RC)
D UNLOCK^RORLOCK(.RORLOCK)
Q
;
;***** RETURNS THE LIST OF LOCAL DRUG NAMES
; RPC: [ROR LIST LOCAL DRUGS]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; REGIEN Registry IEN
;
; [GROUP] Code of the Drug Group. If this parameter is
; defined and greater than zero then only the drugs
; associated with this group will be returned.
;
; The ^TMP("DILIST",$J) global node is used by the procedure.
;
; Return Values:
;
; A negative value of the first "^"-piece of the RESULTS(0)
; indicates an error (see the RPCSTK^RORERR procedure for more
; details).
;
; Otherwise, number of drugs is returned in the @RESULTS@(0) and
; the subsequent nodes of the global array contain the drugs.
;
; @RESULTS@(0) Number of Local Drugs
;
; @RESULTS@(i) Drug Descriptor
; ^01: IEN in the LOCAL DRUG NAME multiple
; ^02: Local drug name
; ^03: IEN of the local drug
; ^04: Code of the Drug Group
;
LDLIST(RESULTS,REGIEN,GROUP) ;
N GROUPIEN,IENS,IR,RC,RORERRDL,RORMSG,SCR,TMP
D CLEAR^RORERR("LDLIST^RORRP032",1)
K RESULTS S RESULTS=$NA(^TMP("DILIST",$J)) K @RESULTS
;
;--- Check the parameters
S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
. ;--- Registry IEN
. I $G(REGIEN)'>0 D Q
. . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
. S REGIEN=+REGIEN
. ;--- Code of the Drug Group
. S GROUP=+$G(GROUP)
. S GROUPIEN=$S(GROUP>0:$$ITEMIEN^RORUTL09(4,REGIEN,GROUP),1:0)
. I GROUPIEN<0 D Q
. . S RC=$$ERROR^RORERR(GROUPIEN)
;
;--- Compile the screen logic (be careful with naked references)
S SCR=""
S:GROUPIEN>0 SCR=SCR_"I $P($G(^(0)),U,2)="_GROUPIEN_" "
;--- Get the list of drugs
S IENS=","_REGIEN_",",TMP="@;.01E;.01I;.02I"
D LIST^DIC(798.129,IENS,TMP,"PU",,,,"B",SCR,,,"RORMSG")
I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$DBS^RORERR("RORMSG",-9,,,798.129,IENS)
;
;--- Replace the group IEN's with the group code(s)
S (IR,RC)=0
F S IR=$O(@RESULTS@(IR)) Q:IR'>0 D Q:RC<0
. I GROUPIEN>0 S $P(@RESULTS@(IR,0),U,4)=GROUP Q
. S TMP=+$P(@RESULTS@(IR,0),U,4)
. I TMP'>0 S $P(@RESULTS@(IR,0),U,4)="" Q
. S RC=$$ITEMCODE^RORUTL09(TMP)
. S:RC>0 $P(@RESULTS@(IR,0),U,4)=RC
I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
;--- Success
S TMP=+$G(^TMP("DILIST",$J,0))
K ^TMP("DILIST",$J,0) S @RESULTS@(0)=TMP
Q
;
;***** UPDATES THE LIST OF LOCAL DRUG NAMES
; RPC: [ROR UPDATE LOCAL DRUGS]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; REGIEN Registry IEN
;
; GROUP Code of the Drug Group.
;
; If this parameter is equal to 0 then every item of
; the LDLST must contain a valid group code. If an
; empty list is passed into the RPC then ALL records
; will be deleted from the LOCAL DRUG NAME multiple.
;
; If this parameter is not zero then it should contain
; a valid group code. All records of the LDLST will be
; associated with this group. If an empty list is
; passed into the RPC then only records associated
; with this group will be deleted from the multiple.
;
; .LDLST( Reference to a local variable that contains
; a list of local drugs
;
; i) Test Descriptor
; ^01: Ignored
; ^02: Ignored
; ^03: IEN of the local drug
; ^04: Code of the Drug Group
; (see also the GROUP parameter)
;
; Return Values:
;
; A negative value of the first "^"-piece of the RESULTS(0)
; indicates an error (see the RPCSTK^RORERR procedure for more
; details).
;
; Otherwise, zero is returned in the RESULTS(0).
;
LDLUPD(RESULTS,REGIEN,GROUP,LDLST) ;
N DA,DIK,DRUGIEN,ECNT,GROUPIEN,GRPIEN,IENS,IR,LDL,RC,ROOT,RORERRDL,RORFDA,RORLOCK,RORMSG,RORTMP,RORTS,TMP
D CLEAR^RORERR("LDLUPD^RORRP032",1) K RESULTS
S ECNT=0
;
;--- Check the parameters
S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
. ;--- Registry IEN
. I $G(REGIEN)'>0 D Q
. . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
. S REGIEN=+REGIEN
. ;--- Code of the Drug Group
. S GROUPIEN=$S($G(GROUP)>0:$$ITEMIEN^RORUTL09(4,REGIEN,GROUP),1:0)
. I GROUPIEN<0 D Q
. . S RC=$$ERROR^RORERR(-88,,,,"GROUP",$G(GROUP))
. S GROUP=+$G(GROUP)
;
;--- Lock the LOCAL DRUG NAME multiple
S IENS=","_REGIEN_","
S RC=$$LOCK^RORLOCK(798.129,IENS)
I RC D:RC>0 D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$ERROR^RORERR(-11,,,,"the LOCAL DRUG NAME multiple")
;---
S RORLOCK(798.129,IENS)=""
S ROOT=$$ROOT^DILFD(798.129,IENS,1)
;
;--- Prepare the data
S RORTMP=$$ALLOC^RORTMP(.RORTS)
S IR="",RC=0
F S IR=$O(LDLST(IR)) Q:IR="" D Q:RC<0
. ;--- Check if the drug is defined in the DRUG file
. S DRUGIEN=+$P(LDLST(IR),U,3)
. D ZERO^PSS50(DRUGIEN,,,,,RORTS)
. Q:$G(@RORTMP@(0))'>0
. ;--- Assign the default Group IEN (if the GROUP is provided)
. I GROUPIEN>0 S LDL(GROUPIEN,DRUGIEN)="" Q
. ;--- Get IEN of the Drug Group
. S TMP=+$P(LDLST(IR),U,4)
. S GRPIEN=$$ITEMIEN^RORUTL09(4,REGIEN,TMP)
. I GRPIEN'>0 D:GRPIEN<0 Q
. . S RC=$$ERROR^RORERR(GRPIEN)
. ;--- Create the reference
. S LDL(GRPIEN,DRUGIEN)=""
D FREE^RORTMP(RORTMP)
I RC<0 D ERROR(.RESULTS,RC) Q
;---
I GROUPIEN'>0 S GRPIEN="" D
. F S GRPIEN=$O(@ROOT@("G",GRPIEN)) Q:GRPIEN="" S LDL(GRPIEN)=""
E S LDL(GROUPIEN)=""
;
;--- Update the multiple
S IENS="?+1,"_REGIEN_",",ECNT=0
S GRPIEN=""
F S GRPIEN=$O(LDL(GRPIEN)) Q:GRPIEN="" D
. ;--- Delete the old records
. S DIK=$$OREF^DILF(ROOT),DA(1)=REGIEN
. S DRUGIEN=""
. F S DRUGIEN=$O(@ROOT@("G",GRPIEN,DRUGIEN)) Q:DRUGIEN="" D
. . S DA=""
. . F S DA=$O(@ROOT@("G",GRPIEN,DRUGIEN,DA)) Q:DA="" D ^DIK
. ;--- Store the new records
. S DRUGIEN=""
. F S DRUGIEN=$O(LDL(GRPIEN,DRUGIEN)) Q:DRUGIEN="" D
. . S RORFDA(798.129,IENS,.01)=DRUGIEN
. . S RORFDA(798.129,IENS,.02)=GRPIEN
. . D UPDATE^DIE(,"RORFDA",,"RORMSG")
. . I $G(DIERR) D S ECNT=ECNT+1 Q
. . . D DBS^RORERR("RORMSG",-9,,,798.129,IENS)
;
;--- Unlock the multiple and check for errors
D UNLOCK^RORLOCK(798.129,","_REGIEN_",")
I ECNT>0 D RPCSTK^RORERR(.RESULTS,-9) Q
;--- Success
S RESULTS(0)=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORRP032 6926 printed Sep 23, 2025@19:19:13 Page 2
RORRP032 ;HCIOFO/SG - RPC: LOCAL DRUG NAMES ; 11/3/05 2:26pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #4533 ZERO^PSS50 (supported)
+6 ;
+7 QUIT
+8 ;
+9 ;***** PROCESSES THE ERROR(S) AND UNLOCKS THE RECORD(S)
ERROR(RESULTS,RC) ;
+1 DO RPCSTK^RORERR(.RESULTS,RC)
+2 DO UNLOCK^RORLOCK(.RORLOCK)
+3 QUIT
+4 ;
+5 ;***** RETURNS THE LIST OF LOCAL DRUG NAMES
+6 ; RPC: [ROR LIST LOCAL DRUGS]
+7 ;
+8 ; .RESULTS Reference to a local variable where the results
+9 ; are returned to.
+10 ;
+11 ; REGIEN Registry IEN
+12 ;
+13 ; [GROUP] Code of the Drug Group. If this parameter is
+14 ; defined and greater than zero then only the drugs
+15 ; associated with this group will be returned.
+16 ;
+17 ; The ^TMP("DILIST",$J) global node is used by the procedure.
+18 ;
+19 ; Return Values:
+20 ;
+21 ; A negative value of the first "^"-piece of the RESULTS(0)
+22 ; indicates an error (see the RPCSTK^RORERR procedure for more
+23 ; details).
+24 ;
+25 ; Otherwise, number of drugs is returned in the @RESULTS@(0) and
+26 ; the subsequent nodes of the global array contain the drugs.
+27 ;
+28 ; @RESULTS@(0) Number of Local Drugs
+29 ;
+30 ; @RESULTS@(i) Drug Descriptor
+31 ; ^01: IEN in the LOCAL DRUG NAME multiple
+32 ; ^02: Local drug name
+33 ; ^03: IEN of the local drug
+34 ; ^04: Code of the Drug Group
+35 ;
LDLIST(RESULTS,REGIEN,GROUP) ;
+1 NEW GROUPIEN,IENS,IR,RC,RORERRDL,RORMSG,SCR,TMP
+2 DO CLEAR^RORERR("LDLIST^RORRP032",1)
+3 KILL RESULTS
SET RESULTS=$NAME(^TMP("DILIST",$JOB))
KILL @RESULTS
+4 ;
+5 ;--- Check the parameters
+6 SET RC=0
Begin DoDot:1
+7 ;--- Registry IEN
+8 IF $GET(REGIEN)'>0
Begin DoDot:2
+9 SET RC=$$ERROR^RORERR(-88,,,,"REGIEN",$GET(REGIEN))
End DoDot:2
QUIT
+10 SET REGIEN=+REGIEN
+11 ;--- Code of the Drug Group
+12 SET GROUP=+$GET(GROUP)
+13 SET GROUPIEN=$SELECT(GROUP>0:$$ITEMIEN^RORUTL09(4,REGIEN,GROUP),1:0)
+14 IF GROUPIEN<0
Begin DoDot:2
+15 SET RC=$$ERROR^RORERR(GROUPIEN)
End DoDot:2
QUIT
End DoDot:1
IF RC<0
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+16 ;
+17 ;--- Compile the screen logic (be careful with naked references)
+18 SET SCR=""
+19 if GROUPIEN>0
SET SCR=SCR_"I $P($G(^(0)),U,2)="_GROUPIEN_" "
+20 ;--- Get the list of drugs
+21 SET IENS=","_REGIEN_","
SET TMP="@;.01E;.01I;.02I"
+22 DO LIST^DIC(798.129,IENS,TMP,"PU",,,,"B",SCR,,,"RORMSG")
+23 IF $GET(DIERR)
Begin DoDot:1
+24 SET RC=$$DBS^RORERR("RORMSG",-9,,,798.129,IENS)
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+25 ;
+26 ;--- Replace the group IEN's with the group code(s)
+27 SET (IR,RC)=0
+28 FOR
SET IR=$ORDER(@RESULTS@(IR))
if IR'>0
QUIT
Begin DoDot:1
+29 IF GROUPIEN>0
SET $PIECE(@RESULTS@(IR,0),U,4)=GROUP
QUIT
+30 SET TMP=+$PIECE(@RESULTS@(IR,0),U,4)
+31 IF TMP'>0
SET $PIECE(@RESULTS@(IR,0),U,4)=""
QUIT
+32 SET RC=$$ITEMCODE^RORUTL09(TMP)
+33 if RC>0
SET $PIECE(@RESULTS@(IR,0),U,4)=RC
End DoDot:1
if RC<0
QUIT
+34 IF RC<0
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+35 ;--- Success
+36 SET TMP=+$GET(^TMP("DILIST",$JOB,0))
+37 KILL ^TMP("DILIST",$JOB,0)
SET @RESULTS@(0)=TMP
+38 QUIT
+39 ;
+40 ;***** UPDATES THE LIST OF LOCAL DRUG NAMES
+41 ; RPC: [ROR UPDATE LOCAL DRUGS]
+42 ;
+43 ; .RESULTS Reference to a local variable where the results
+44 ; are returned to.
+45 ;
+46 ; REGIEN Registry IEN
+47 ;
+48 ; GROUP Code of the Drug Group.
+49 ;
+50 ; If this parameter is equal to 0 then every item of
+51 ; the LDLST must contain a valid group code. If an
+52 ; empty list is passed into the RPC then ALL records
+53 ; will be deleted from the LOCAL DRUG NAME multiple.
+54 ;
+55 ; If this parameter is not zero then it should contain
+56 ; a valid group code. All records of the LDLST will be
+57 ; associated with this group. If an empty list is
+58 ; passed into the RPC then only records associated
+59 ; with this group will be deleted from the multiple.
+60 ;
+61 ; .LDLST( Reference to a local variable that contains
+62 ; a list of local drugs
+63 ;
+64 ; i) Test Descriptor
+65 ; ^01: Ignored
+66 ; ^02: Ignored
+67 ; ^03: IEN of the local drug
+68 ; ^04: Code of the Drug Group
+69 ; (see also the GROUP parameter)
+70 ;
+71 ; Return Values:
+72 ;
+73 ; A negative value of the first "^"-piece of the RESULTS(0)
+74 ; indicates an error (see the RPCSTK^RORERR procedure for more
+75 ; details).
+76 ;
+77 ; Otherwise, zero is returned in the RESULTS(0).
+78 ;
LDLUPD(RESULTS,REGIEN,GROUP,LDLST) ;
+1 NEW DA,DIK,DRUGIEN,ECNT,GROUPIEN,GRPIEN,IENS,IR,LDL,RC,ROOT,RORERRDL,RORFDA,RORLOCK,RORMSG,RORTMP,RORTS,TMP
+2 DO CLEAR^RORERR("LDLUPD^RORRP032",1)
KILL RESULTS
+3 SET ECNT=0
+4 ;
+5 ;--- Check the parameters
+6 SET RC=0
Begin DoDot:1
+7 ;--- Registry IEN
+8 IF $GET(REGIEN)'>0
Begin DoDot:2
+9 SET RC=$$ERROR^RORERR(-88,,,,"REGIEN",$GET(REGIEN))
End DoDot:2
QUIT
+10 SET REGIEN=+REGIEN
+11 ;--- Code of the Drug Group
+12 SET GROUPIEN=$SELECT($GET(GROUP)>0:$$ITEMIEN^RORUTL09(4,REGIEN,GROUP),1:0)
+13 IF GROUPIEN<0
Begin DoDot:2
+14 SET RC=$$ERROR^RORERR(-88,,,,"GROUP",$GET(GROUP))
End DoDot:2
QUIT
+15 SET GROUP=+$GET(GROUP)
End DoDot:1
IF RC<0
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+16 ;
+17 ;--- Lock the LOCAL DRUG NAME multiple
+18 SET IENS=","_REGIEN_","
+19 SET RC=$$LOCK^RORLOCK(798.129,IENS)
+20 IF RC
if RC>0
Begin DoDot:1
+21 SET RC=$$ERROR^RORERR(-11,,,,"the LOCAL DRUG NAME multiple")
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+22 ;---
+23 SET RORLOCK(798.129,IENS)=""
+24 SET ROOT=$$ROOT^DILFD(798.129,IENS,1)
+25 ;
+26 ;--- Prepare the data
+27 SET RORTMP=$$ALLOC^RORTMP(.RORTS)
+28 SET IR=""
SET RC=0
+29 FOR
SET IR=$ORDER(LDLST(IR))
if IR=""
QUIT
Begin DoDot:1
+30 ;--- Check if the drug is defined in the DRUG file
+31 SET DRUGIEN=+$PIECE(LDLST(IR),U,3)
+32 DO ZERO^PSS50(DRUGIEN,,,,,RORTS)
+33 if $GET(@RORTMP@(0))'>0
QUIT
+34 ;--- Assign the default Group IEN (if the GROUP is provided)
+35 IF GROUPIEN>0
SET LDL(GROUPIEN,DRUGIEN)=""
QUIT
+36 ;--- Get IEN of the Drug Group
+37 SET TMP=+$PIECE(LDLST(IR),U,4)
+38 SET GRPIEN=$$ITEMIEN^RORUTL09(4,REGIEN,TMP)
+39 IF GRPIEN'>0
if GRPIEN<0
Begin DoDot:2
+40 SET RC=$$ERROR^RORERR(GRPIEN)
End DoDot:2
QUIT
+41 ;--- Create the reference
+42 SET LDL(GRPIEN,DRUGIEN)=""
End DoDot:1
if RC<0
QUIT
+43 DO FREE^RORTMP(RORTMP)
+44 IF RC<0
DO ERROR(.RESULTS,RC)
QUIT
+45 ;---
+46 IF GROUPIEN'>0
SET GRPIEN=""
Begin DoDot:1
+47 FOR
SET GRPIEN=$ORDER(@ROOT@("G",GRPIEN))
if GRPIEN=""
QUIT
SET LDL(GRPIEN)=""
End DoDot:1
+48 IF '$TEST
SET LDL(GROUPIEN)=""
+49 ;
+50 ;--- Update the multiple
+51 SET IENS="?+1,"_REGIEN_","
SET ECNT=0
+52 SET GRPIEN=""
+53 FOR
SET GRPIEN=$ORDER(LDL(GRPIEN))
if GRPIEN=""
QUIT
Begin DoDot:1
+54 ;--- Delete the old records
+55 SET DIK=$$OREF^DILF(ROOT)
SET DA(1)=REGIEN
+56 SET DRUGIEN=""
+57 FOR
SET DRUGIEN=$ORDER(@ROOT@("G",GRPIEN,DRUGIEN))
if DRUGIEN=""
QUIT
Begin DoDot:2
+58 SET DA=""
+59 FOR
SET DA=$ORDER(@ROOT@("G",GRPIEN,DRUGIEN,DA))
if DA=""
QUIT
DO ^DIK
End DoDot:2
+60 ;--- Store the new records
+61 SET DRUGIEN=""
+62 FOR
SET DRUGIEN=$ORDER(LDL(GRPIEN,DRUGIEN))
if DRUGIEN=""
QUIT
Begin DoDot:2
+63 SET RORFDA(798.129,IENS,.01)=DRUGIEN
+64 SET RORFDA(798.129,IENS,.02)=GRPIEN
+65 DO UPDATE^DIE(,"RORFDA",,"RORMSG")
+66 IF $GET(DIERR)
Begin DoDot:3
+67 DO DBS^RORERR("RORMSG",-9,,,798.129,IENS)
End DoDot:3
SET ECNT=ECNT+1
QUIT
End DoDot:2
End DoDot:1
+68 ;
+69 ;--- Unlock the multiple and check for errors
+70 DO UNLOCK^RORLOCK(798.129,","_REGIEN_",")
+71 IF ECNT>0
DO RPCSTK^RORERR(.RESULTS,-9)
QUIT
+72 ;--- Success
+73 SET RESULTS(0)=0
+74 QUIT
