[613] | 1 | RORRP040 ;HCIOFO/SG - RPC: LOCAL REGISTRY FIELDS ; 8/25/05 12:23pm
|
---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
---|
| 3 | ;
|
---|
| 4 | Q
|
---|
| 5 | ;
|
---|
| 6 | ;***** LOADS THE LIST OF LOCAL FIELD DEFINITIONS
|
---|
| 7 | ; RPC: [ROR LIST LOCAL FIELDS]
|
---|
| 8 | ;
|
---|
| 9 | ; .RESULTS Reference to a local variable where the results
|
---|
| 10 | ; are returned to.
|
---|
| 11 | ;
|
---|
| 12 | ; REGIEN Registry IEN
|
---|
| 13 | ;
|
---|
| 14 | ; FLAGS Flags that control processing:
|
---|
| 15 | ; I Include inactive field definitions
|
---|
| 16 | ;
|
---|
| 17 | ; [LOCK] Lock the local fields before loading the data and
|
---|
| 18 | ; leave them locked.
|
---|
| 19 | ;
|
---|
| 20 | ; Return Values:
|
---|
| 21 | ;
|
---|
| 22 | ; A negative value of the first "^"-piece of the RESULTS(0) node
|
---|
| 23 | ; indicates an error (see the RPCSTK^RORERR procedure for details).
|
---|
| 24 | ;
|
---|
| 25 | ; If the local field table cannot be locked then the second
|
---|
| 26 | ; "^"-piece of the @RESULTS@(0) will be greater than 0 and the
|
---|
| 27 | ; node will contain the lock descriptor.
|
---|
| 28 | ;
|
---|
| 29 | ; @RESULTS@(0) Result Descriptor
|
---|
| 30 | ; ^01: Number of local fields
|
---|
| 31 | ; ^02: Lock Descriptor (see the
|
---|
| 32 | ; ... LOCK^RORLOCK for details)
|
---|
| 33 | ;
|
---|
| 34 | ; The subsequent nodes will contain local field definitions.
|
---|
| 35 | ;
|
---|
| 36 | ; See the description of the ROR LIST LOCAL FIELDS remote procedure
|
---|
| 37 | ; for more details.
|
---|
| 38 | ;
|
---|
| 39 | LFLIST(RESULTS,REGIEN,FLAGS,LOCK) ;
|
---|
| 40 | N CNT,IEN,IENS,LOCKRC,NAME,RC,ROOT,RORBUF,RORERRDL,RORMSG,TMP
|
---|
| 41 | D CLEAR^RORERR("LFLIST^RORRP040",1)
|
---|
| 42 | K RESULTS S RESULTS=$$ALLOC^RORTMP()
|
---|
| 43 | ;
|
---|
| 44 | ;=== Check the parameters
|
---|
| 45 | S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
|
---|
| 46 | . ;--- Registry IEN
|
---|
| 47 | . I $G(REGIEN)'>0 D Q
|
---|
| 48 | . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
|
---|
| 49 | . S REGIEN=+REGIEN
|
---|
| 50 | . ;--- Flags
|
---|
| 51 | . S FLAGS=$G(FLAGS)
|
---|
| 52 | ;
|
---|
| 53 | ;=== Lock the ROR LOCAL FIELD file
|
---|
| 54 | I $G(LOCK) D I LOCKRC<0 D RPCSTK^RORERR(.RESULTS,LOCKRC) Q
|
---|
| 55 | . S LOCKRC=$$LOCK^RORLOCK(799.53)
|
---|
| 56 | ;
|
---|
| 57 | ;=== Load the list of field definitions
|
---|
| 58 | S DT=$$DT^XLFDT
|
---|
| 59 | S ROOT=$$ROOT^DILFD(799.53,,1)
|
---|
| 60 | S NAME="",(CNT,RC)=0
|
---|
| 61 | F S NAME=$O(@ROOT@("KEY",REGIEN,NAME)) Q:NAME="" D Q:RC<0
|
---|
| 62 | . S IEN=0
|
---|
| 63 | . F S IEN=$O(@ROOT@("KEY",REGIEN,NAME,IEN)) Q:IEN'>0 D Q:RC<0
|
---|
| 64 | . . S IENS=IEN_"," K RORBUF,RORMSG
|
---|
| 65 | . . D GETS^DIQ(799.53,IENS,".01;.02;1","I","RORBUF","RORMSG")
|
---|
| 66 | . . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,798.53) Q
|
---|
| 67 | . . ;--- Skip inactive field definition if necessary
|
---|
| 68 | . . I FLAGS'["I" D I TMP>0 Q:TMP'>DT
|
---|
| 69 | . . . S TMP=+$G(RORBUF(799.53,IENS,.02,"I"))
|
---|
| 70 | . . ;--- Add the definition to the list
|
---|
| 71 | . . S CNT=CNT+1,RORBUF=IEN
|
---|
| 72 | . . S $P(RORBUF,U,2)=$G(RORBUF(799.53,IENS,.01,"I"))
|
---|
| 73 | . . S $P(RORBUF,U,3)=$G(RORBUF(799.53,IENS,.02,"I"))
|
---|
| 74 | . . S $P(RORBUF,U,4)=$G(RORBUF(799.53,IENS,1,"I"))
|
---|
| 75 | . . S @RESULTS@(CNT)=RORBUF
|
---|
| 76 | I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
|
---|
| 77 | ;
|
---|
| 78 | ;=== Success
|
---|
| 79 | S @RESULTS@(0)=CNT_U_$G(LOCKRC)
|
---|
| 80 | Q
|
---|
| 81 | ;
|
---|
| 82 | ;***** UPDATES THE LIST OF LOCAL FIELD DEFINITIONS
|
---|
| 83 | ; RPC: [ROR UPDATE LOCAL FIELDS]
|
---|
| 84 | ;
|
---|
| 85 | ; .RESULTS Reference to a local variable
|
---|
| 86 | ;
|
---|
| 87 | ; REGIEN Registry IEN
|
---|
| 88 | ;
|
---|
| 89 | ; [CANCEL] Cancel the update and unlock the local fields
|
---|
| 90 | ;
|
---|
| 91 | ; [.LFLST] Reference to a local variable that contains
|
---|
| 92 | ; a list of local fields
|
---|
| 93 | ; .LFLST(
|
---|
| 94 | ;
|
---|
| 95 | ; i) Local Field Descriptor
|
---|
| 96 | ; ^01: IEN
|
---|
| 97 | ; ^02: Name
|
---|
| 98 | ; ^03: Inactivation Date (FileMan)
|
---|
| 99 | ; ^04: Description
|
---|
| 100 | ;
|
---|
| 101 | ; See the description of the ROR UPDATE LOCAL FIELDS remote procedure
|
---|
| 102 | ; for more details.
|
---|
| 103 | ;
|
---|
| 104 | ; Return Values:
|
---|
| 105 | ;
|
---|
| 106 | ; A negative value of the first "^"-piece of the RESULTS(0) node
|
---|
| 107 | ; indicates an error (see the RPCSTK^RORERR procedure for details).
|
---|
| 108 | ;
|
---|
| 109 | ; Otherwise, zero is returned in the RESULTS(0).
|
---|
| 110 | ;
|
---|
| 111 | LFLUPD(RESULTS,REGIEN,CANCEL,LFLST) ;
|
---|
| 112 | N ECNT,I,IEN,RC,RORERRDL,TMP
|
---|
| 113 | K RESULTS
|
---|
| 114 | D CLEAR^RORERR("LFLUPD^RORRP040",1)
|
---|
| 115 | S (ECNT,RC)=0
|
---|
| 116 | ;
|
---|
| 117 | ;=== Check the parameters
|
---|
| 118 | S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
|
---|
| 119 | . ;--- Registry IEN
|
---|
| 120 | . I $G(REGIEN)'>0 D Q
|
---|
| 121 | . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
|
---|
| 122 | . S REGIEN=+REGIEN
|
---|
| 123 | . ;--- List of local fields
|
---|
| 124 | . S I=0
|
---|
| 125 | . F S I=$O(LFLST(I)) Q:I'>0 D
|
---|
| 126 | . . S IEN=+$P(LFLST(I),U) S:IEN>0 LFLST("AI",IEN)=I
|
---|
| 127 | ;
|
---|
| 128 | D:'$G(CANCEL)
|
---|
| 129 | . N DA,DIK,IENS,NAME,RORFDA,RORMSG,XREF
|
---|
| 130 | . ;--- Delete the old records
|
---|
| 131 | . S DIK=$$ROOT^DILFD(799.53)
|
---|
| 132 | . S XREF=DIK_"""KEY"","_REGIEN_")"
|
---|
| 133 | . S NAME=""
|
---|
| 134 | . F S NAME=$O(@XREF@(NAME)) Q:NAME="" D
|
---|
| 135 | . . S DA=""
|
---|
| 136 | . . F S DA=$O(@XREF@(NAME,DA)) Q:DA="" D
|
---|
| 137 | . . . D:'$D(LFLST("AI",DA)) LVDEL(DA),^DIK
|
---|
| 138 | . ;--- Store the new records
|
---|
| 139 | . S NODE=$$CREF^DILF(DIK)
|
---|
| 140 | . S I=0
|
---|
| 141 | . F S I=$O(LFLST(I)) Q:I'>0 D
|
---|
| 142 | . . S IEN=+$P(LFLST(I),U)
|
---|
| 143 | . . S IENS=$S(IEN'>0:"+1,",$D(@NODE@(IEN)):IEN_",",1:"+1,")
|
---|
| 144 | . . K RORFDA,RORMSG
|
---|
| 145 | . . S RORFDA(799.53,IENS,.01)=$P(LFLST(I),U,2) ; NAME
|
---|
| 146 | . . S RORFDA(799.53,IENS,.02)=$P(LFLST(I),U,3) ; DATE OF INACTIV.
|
---|
| 147 | . . S RORFDA(799.53,IENS,.03)=REGIEN ; REGISTRY
|
---|
| 148 | . . S RORFDA(799.53,IENS,1)=$P(LFLST(I),U,4) ; DESCRIPTION
|
---|
| 149 | . . I $E(IENS,1)="+" D
|
---|
| 150 | . . . D UPDATE^DIE(,"RORFDA",,"RORMSG")
|
---|
| 151 | . . E D FILE^DIE(,"RORFDA","RORMSG")
|
---|
| 152 | . . I $G(DIERR) D S ECNT=ECNT+1
|
---|
| 153 | . . . D DBS^RORERR("RORMSG",-9,,,799.53,IENS)
|
---|
| 154 | ;
|
---|
| 155 | ;=== Unlock the file and check for errors
|
---|
| 156 | D UNLOCK^RORLOCK(799.53)
|
---|
| 157 | I ECNT>0 D RPCSTK^RORERR(.RESULTS,-9) Q
|
---|
| 158 | ;--- Success
|
---|
| 159 | S RESULTS(0)=0
|
---|
| 160 | Q
|
---|
| 161 | ;
|
---|
| 162 | ;***** DELETES THE LOCAL FIELD FROM THE PATIENTS' RECORDS
|
---|
| 163 | ;
|
---|
| 164 | ; LFIEN IEN of the local field (file #799.53)
|
---|
| 165 | ;
|
---|
| 166 | LVDEL(LFIEN) ;
|
---|
| 167 | N DA,DIK,XREF
|
---|
| 168 | S XREF=$$ROOT^DILFD(798)_"""ALF"","_LFIEN_")"
|
---|
| 169 | S DA(1)=""
|
---|
| 170 | F S DA(1)=$O(@XREF@(DA(1))) Q:DA(1)="" D
|
---|
| 171 | . S DA="",DIK=$$ROOT^DILFD(798.02,","_DA(1)_",")
|
---|
| 172 | . F S DA=$O(@XREF@(DA(1),DA)) Q:DA="" D ^DIK
|
---|
| 173 | Q
|
---|