201 lines
6.6 KiB
Mathematica
201 lines
6.6 KiB
Mathematica
|
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
|