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

RORRP040.m

Go to the documentation of this file.
  1. RORRP040 ;HCIOFO/SG - RPC: LOCAL REGISTRY FIELDS ; 8/25/05 12:23pm
  1. ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
  1. ;
  1. Q
  1. ;
  1. ;***** LOADS THE LIST OF LOCAL FIELD DEFINITIONS
  1. ; RPC: [ROR LIST LOCAL FIELDS]
  1. ;
  1. ; .RESULTS Reference to a local variable where the results
  1. ; are returned to.
  1. ;
  1. ; REGIEN Registry IEN
  1. ;
  1. ; FLAGS Flags that control processing:
  1. ; I Include inactive field definitions
  1. ;
  1. ; [LOCK] Lock the local fields before loading the data and
  1. ; leave them locked.
  1. ;
  1. ; Return Values:
  1. ;
  1. ; A negative value of the first "^"-piece of the RESULTS(0) node
  1. ; indicates an error (see the RPCSTK^RORERR procedure for details).
  1. ;
  1. ; If the local field table cannot be locked then the second
  1. ; "^"-piece of the @RESULTS@(0) will be greater than 0 and the
  1. ; node will contain the lock descriptor.
  1. ;
  1. ; @RESULTS@(0) Result Descriptor
  1. ; ^01: Number of local fields
  1. ; ^02: Lock Descriptor (see the
  1. ; ... LOCK^RORLOCK for details)
  1. ;
  1. ; The subsequent nodes will contain local field definitions.
  1. ;
  1. ; See the description of the ROR LIST LOCAL FIELDS remote procedure
  1. ; for more details.
  1. ;
  1. LFLIST(RESULTS,REGIEN,FLAGS,LOCK) ;
  1. N CNT,IEN,IENS,LOCKRC,NAME,RC,ROOT,RORBUF,RORERRDL,RORMSG,TMP
  1. D CLEAR^RORERR("LFLIST^RORRP040",1)
  1. K RESULTS S RESULTS=$$ALLOC^RORTMP()
  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. . ;--- Flags
  1. . S FLAGS=$G(FLAGS)
  1. ;
  1. ;=== Lock the ROR LOCAL FIELD file
  1. I $G(LOCK) D I LOCKRC<0 D RPCSTK^RORERR(.RESULTS,LOCKRC) Q
  1. . S LOCKRC=$$LOCK^RORLOCK(799.53)
  1. ;
  1. ;=== Load the list of field definitions
  1. S DT=$$DT^XLFDT
  1. S ROOT=$$ROOT^DILFD(799.53,,1)
  1. S NAME="",(CNT,RC)=0
  1. F S NAME=$O(@ROOT@("KEY",REGIEN,NAME)) Q:NAME="" D Q:RC<0
  1. . S IEN=0
  1. . F S IEN=$O(@ROOT@("KEY",REGIEN,NAME,IEN)) Q:IEN'>0 D Q:RC<0
  1. . . S IENS=IEN_"," K RORBUF,RORMSG
  1. . . D GETS^DIQ(799.53,IENS,".01;.02;1","I","RORBUF","RORMSG")
  1. . . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,798.53) Q
  1. . . ;--- Skip inactive field definition if necessary
  1. . . I FLAGS'["I" D I TMP>0 Q:TMP'>DT
  1. . . . S TMP=+$G(RORBUF(799.53,IENS,.02,"I"))
  1. . . ;--- Add the definition to the list
  1. . . S CNT=CNT+1,RORBUF=IEN
  1. . . S $P(RORBUF,U,2)=$G(RORBUF(799.53,IENS,.01,"I"))
  1. . . S $P(RORBUF,U,3)=$G(RORBUF(799.53,IENS,.02,"I"))
  1. . . S $P(RORBUF,U,4)=$G(RORBUF(799.53,IENS,1,"I"))
  1. . . S @RESULTS@(CNT)=RORBUF
  1. I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
  1. ;
  1. ;=== Success
  1. S @RESULTS@(0)=CNT_U_$G(LOCKRC)
  1. Q
  1. ;
  1. ;***** UPDATES THE LIST OF LOCAL FIELD DEFINITIONS
  1. ; RPC: [ROR UPDATE LOCAL FIELDS]
  1. ;
  1. ; .RESULTS Reference to a local variable
  1. ;
  1. ; REGIEN Registry IEN
  1. ;
  1. ; [CANCEL] Cancel the update and unlock the local fields
  1. ;
  1. ; [.LFLST] Reference to a local variable that contains
  1. ; a list of local fields
  1. ; .LFLST(
  1. ;
  1. ; i) Local Field Descriptor
  1. ; ^01: IEN
  1. ; ^02: Name
  1. ; ^03: Inactivation Date (FileMan)
  1. ; ^04: Description
  1. ;
  1. ; See the description of the ROR UPDATE LOCAL FIELDS remote procedure
  1. ; for more details.
  1. ;
  1. ; Return Values:
  1. ;
  1. ; A negative value of the first "^"-piece of the RESULTS(0) node
  1. ; indicates an error (see the RPCSTK^RORERR procedure for details).
  1. ;
  1. ; Otherwise, zero is returned in the RESULTS(0).
  1. ;
  1. LFLUPD(RESULTS,REGIEN,CANCEL,LFLST) ;
  1. N ECNT,I,IEN,RC,RORERRDL,TMP
  1. K RESULTS
  1. D CLEAR^RORERR("LFLUPD^RORRP040",1)
  1. S (ECNT,RC)=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. . ;--- List of local fields
  1. . S I=0
  1. . F S I=$O(LFLST(I)) Q:I'>0 D
  1. . . S IEN=+$P(LFLST(I),U) S:IEN>0 LFLST("AI",IEN)=I
  1. ;
  1. D:'$G(CANCEL)
  1. . N DA,DIK,IENS,NAME,RORFDA,RORMSG,XREF
  1. . ;--- Delete the old records
  1. . S DIK=$$ROOT^DILFD(799.53)
  1. . S XREF=DIK_"""KEY"","_REGIEN_")"
  1. . S NAME=""
  1. . F S NAME=$O(@XREF@(NAME)) Q:NAME="" D
  1. . . S DA=""
  1. . . F S DA=$O(@XREF@(NAME,DA)) Q:DA="" D
  1. . . . D:'$D(LFLST("AI",DA)) LVDEL(DA),^DIK
  1. . ;--- Store the new records
  1. . S NODE=$$CREF^DILF(DIK)
  1. . S I=0
  1. . F S I=$O(LFLST(I)) Q:I'>0 D
  1. . . S IEN=+$P(LFLST(I),U)
  1. . . S IENS=$S(IEN'>0:"+1,",$D(@NODE@(IEN)):IEN_",",1:"+1,")
  1. . . K RORFDA,RORMSG
  1. . . S RORFDA(799.53,IENS,.01)=$P(LFLST(I),U,2) ; NAME
  1. . . S RORFDA(799.53,IENS,.02)=$P(LFLST(I),U,3) ; DATE OF INACTIV.
  1. . . S RORFDA(799.53,IENS,.03)=REGIEN ; REGISTRY
  1. . . S RORFDA(799.53,IENS,1)=$P(LFLST(I),U,4) ; DESCRIPTION
  1. . . I $E(IENS,1)="+" D
  1. . . . D UPDATE^DIE(,"RORFDA",,"RORMSG")
  1. . . E D FILE^DIE(,"RORFDA","RORMSG")
  1. . . I $G(DIERR) D S ECNT=ECNT+1
  1. . . . D DBS^RORERR("RORMSG",-9,,,799.53,IENS)
  1. ;
  1. ;=== Unlock the file and check for errors
  1. D UNLOCK^RORLOCK(799.53)
  1. I ECNT>0 D RPCSTK^RORERR(.RESULTS,-9) Q
  1. ;--- Success
  1. S RESULTS(0)=0
  1. Q
  1. ;
  1. ;***** DELETES THE LOCAL FIELD FROM THE PATIENTS' RECORDS
  1. ;
  1. ; LFIEN IEN of the local field (file #799.53)
  1. ;
  1. LVDEL(LFIEN) ;
  1. N DA,DIK,XREF
  1. S XREF=$$ROOT^DILFD(798)_"""ALF"","_LFIEN_")"
  1. S DA(1)=""
  1. F S DA(1)=$O(@XREF@(DA(1))) Q:DA(1)="" D
  1. . S DA="",DIK=$$ROOT^DILFD(798.02,","_DA(1)_",")
  1. . F S DA=$O(@XREF@(DA(1),DA)) Q:DA="" D ^DIK
  1. Q