| [613] | 1 | RORRP031 ;HCIOFO/SG - RPC: LOCAL LAB TEST NAMES ; 2/10/04 8:59am
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine uses the following IAs:
|
|---|
| 5 | ;
|
|---|
| 6 | ; #91 Access to the LABORATORY TEST file
|
|---|
| 7 | ;
|
|---|
| 8 | Q
|
|---|
| 9 | ;
|
|---|
| 10 | ;***** PROCESSES THE ERROR(S) AND UNLOCKS THE RECORD(S)
|
|---|
| 11 | ERROR(RESULTS,RC) ;
|
|---|
| 12 | D RPCSTK^RORERR(.RESULTS,RC)
|
|---|
| 13 | D UNLOCK^RORLOCK(.RORLOCK)
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | ;***** RETURNS THE LIST OF LOCAL TEST NAMES
|
|---|
| 17 | ; RPC: [ROR LIST LOCAL LAB TESTS]
|
|---|
| 18 | ;
|
|---|
| 19 | ; .RESULTS Reference to a local variable where the results
|
|---|
| 20 | ; are returned to.
|
|---|
| 21 | ;
|
|---|
| 22 | ; REGIEN Registry IEN
|
|---|
| 23 | ;
|
|---|
| 24 | ; [GROUP] Code of the Lab Group. If this parameter is
|
|---|
| 25 | ; defined and greater than zero then only the tests
|
|---|
| 26 | ; associated with this group will be returned.
|
|---|
| 27 | ;
|
|---|
| 28 | ; The ^TMP("DILIST",$J) global node is used by the procedure.
|
|---|
| 29 | ;
|
|---|
| 30 | ; Return Values:
|
|---|
| 31 | ;
|
|---|
| 32 | ; A negative value of the first "^"-piece of the RESULTS(0)
|
|---|
| 33 | ; indicates an error (see the RPCSTK^RORERR procedure for more
|
|---|
| 34 | ; details).
|
|---|
| 35 | ;
|
|---|
| 36 | ; Otherwise, number of lab tests is returned in the @RESULTS@(0)
|
|---|
| 37 | ; and the subsequent nodes of the global array contain the tests.
|
|---|
| 38 | ;
|
|---|
| 39 | ; @RESULTS@(0) Number of Local Tests
|
|---|
| 40 | ;
|
|---|
| 41 | ; @RESULTS@(i) Test Descriptor
|
|---|
| 42 | ; ^01: IEN in the LOCAL TEST NAME multiple
|
|---|
| 43 | ; ^02: Local test name
|
|---|
| 44 | ; ^03: IEN of the local test
|
|---|
| 45 | ; ^04: Code of the Lab Group
|
|---|
| 46 | ;
|
|---|
| 47 | LTLIST(RESULTS,REGIEN,GROUP) ;
|
|---|
| 48 | N GROUPIEN,IENS,IR,RC,RORERRDL,RORMSG,SCR,TMP
|
|---|
| 49 | D CLEAR^RORERR("LTLIST^RORRP031",1)
|
|---|
| 50 | K RESULTS S RESULTS=$NA(^TMP("DILIST",$J)) K @RESULTS
|
|---|
| 51 | ;
|
|---|
| 52 | ;--- Check the parameters
|
|---|
| 53 | S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
|
|---|
| 54 | . ;--- Registry IEN
|
|---|
| 55 | . I $G(REGIEN)'>0 D Q
|
|---|
| 56 | . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
|
|---|
| 57 | . S REGIEN=+REGIEN
|
|---|
| 58 | . ;--- Code of the Lab Group
|
|---|
| 59 | . S GROUP=+$G(GROUP)
|
|---|
| 60 | . S GROUPIEN=$S(GROUP>0:$$ITEMIEN^RORUTL09(3,REGIEN,GROUP),1:0)
|
|---|
| 61 | . I GROUPIEN<0 D Q
|
|---|
| 62 | . . S RC=$$ERROR^RORERR(GROUPIEN)
|
|---|
| 63 | ;
|
|---|
| 64 | ;--- Compile the screen logic (be careful with naked references)
|
|---|
| 65 | S SCR=""
|
|---|
| 66 | S:GROUPIEN>0 SCR=SCR_"I $P($G(^(0)),U,2)="_GROUPIEN_" "
|
|---|
| 67 | ;--- Get the list of tests
|
|---|
| 68 | S IENS=","_REGIEN_",",TMP="@;.01E;.01I;.02I"
|
|---|
| 69 | D LIST^DIC(798.128,IENS,TMP,"PU",,,,"B",SCR,,,"RORMSG")
|
|---|
| 70 | I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC) Q
|
|---|
| 71 | . S RC=$$DBS^RORERR("RORMSG",-9,,,798.128,IENS)
|
|---|
| 72 | ;
|
|---|
| 73 | ;--- Replace the group IEN's with the group code(s)
|
|---|
| 74 | S (IR,RC)=0
|
|---|
| 75 | F S IR=$O(@RESULTS@(IR)) Q:IR'>0 D Q:RC<0
|
|---|
| 76 | . I GROUPIEN>0 S $P(@RESULTS@(IR,0),U,4)=GROUP Q
|
|---|
| 77 | . S TMP=+$P(@RESULTS@(IR,0),U,4)
|
|---|
| 78 | . I TMP'>0 S $P(@RESULTS@(IR,0),U,4)="" Q
|
|---|
| 79 | . S RC=$$ITEMCODE^RORUTL09(TMP)
|
|---|
| 80 | . S:RC>0 $P(@RESULTS@(IR,0),U,4)=RC
|
|---|
| 81 | I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
|
|---|
| 82 | ;--- Success
|
|---|
| 83 | S TMP=+$G(^TMP("DILIST",$J,0))
|
|---|
| 84 | K ^TMP("DILIST",$J,0) S @RESULTS@(0)=TMP
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | ;***** UPDATES THE LIST OF LOCAL TEST NAMES
|
|---|
| 88 | ; RPC: [ROR UPDATE LOCAL LAB TESTS]
|
|---|
| 89 | ;
|
|---|
| 90 | ; .RESULTS Reference to a local variable where the results
|
|---|
| 91 | ; are returned to.
|
|---|
| 92 | ;
|
|---|
| 93 | ; REGIEN Registry IEN
|
|---|
| 94 | ;
|
|---|
| 95 | ; GROUP Code of the Lab Group.
|
|---|
| 96 | ;
|
|---|
| 97 | ; If this parameter is equal to 0 then every item of
|
|---|
| 98 | ; the LTLST must contain a valid group code. If an
|
|---|
| 99 | ; empty list is passed into the RPC then ALL records
|
|---|
| 100 | ; will be deleted from the LOCAL TEST NAME multiple.
|
|---|
| 101 | ;
|
|---|
| 102 | ; If this parameter is not zero then it should contain
|
|---|
| 103 | ; a valid group code. All records of the LTLST will be
|
|---|
| 104 | ; associated with this group. If an empty list is
|
|---|
| 105 | ; passed into the RPC then only records associated
|
|---|
| 106 | ; with this group will be deleted from the multiple.
|
|---|
| 107 | ;
|
|---|
| 108 | ; .LTLST( Reference to a local variable that contains
|
|---|
| 109 | ; a list of local laboratory tests
|
|---|
| 110 | ;
|
|---|
| 111 | ; i) Test Descriptor
|
|---|
| 112 | ; ^01: Ignored
|
|---|
| 113 | ; ^02: Ignored
|
|---|
| 114 | ; ^03: IEN of the local test
|
|---|
| 115 | ; ^04: Code of the Lab Group
|
|---|
| 116 | ; (see also the GROUP parameter)
|
|---|
| 117 | ;
|
|---|
| 118 | ; Return Values:
|
|---|
| 119 | ;
|
|---|
| 120 | ; A negative value of the first "^"-piece of the RESULTS(0)
|
|---|
| 121 | ; indicates an error (see the RPCSTK^RORERR procedure for more
|
|---|
| 122 | ; details).
|
|---|
| 123 | ;
|
|---|
| 124 | ; Otherwise, zero is returned in the RESULTS(0).
|
|---|
| 125 | ;
|
|---|
| 126 | LTLUPD(RESULTS,REGIEN,GROUP,LTLST) ;
|
|---|
| 127 | N DA,DIK,ECNT,GROUPIEN,GRPIEN,IENS,IR,LTL,RC,ROOT,RORERRDL,RORFDA,RORLOCK,RORMSG,TMP,TSTIEN
|
|---|
| 128 | D CLEAR^RORERR("LTLUPD^RORRP031",1) K RESULTS
|
|---|
| 129 | S ECNT=0
|
|---|
| 130 | ;
|
|---|
| 131 | ;--- Check the parameters
|
|---|
| 132 | S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
|
|---|
| 133 | . ;--- Registry IEN
|
|---|
| 134 | . I $G(REGIEN)'>0 D Q
|
|---|
| 135 | . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
|
|---|
| 136 | . S REGIEN=+REGIEN
|
|---|
| 137 | . ;--- Code of the Lab Group
|
|---|
| 138 | . S GROUPIEN=$S($G(GROUP)>0:$$ITEMIEN^RORUTL09(3,REGIEN,GROUP),1:0)
|
|---|
| 139 | . I GROUPIEN<0 D Q
|
|---|
| 140 | . . S RC=$$ERROR^RORERR(-88,,,,"GROUP",$G(GROUP))
|
|---|
| 141 | . S GROUP=+$G(GROUP)
|
|---|
| 142 | ;
|
|---|
| 143 | ;--- Lock the LOCAL TEST NAME multiple
|
|---|
| 144 | S IENS=","_REGIEN_","
|
|---|
| 145 | S RC=$$LOCK^RORLOCK(798.128,IENS)
|
|---|
| 146 | I RC D:RC>0 D RPCSTK^RORERR(.RESULTS,RC) Q
|
|---|
| 147 | . S RC=$$ERROR^RORERR(-11,,,,"the LOCAL TEST NAME multiple")
|
|---|
| 148 | ;---
|
|---|
| 149 | S RORLOCK(798.128,IENS)=""
|
|---|
| 150 | S ROOT=$$ROOT^DILFD(798.128,IENS,1)
|
|---|
| 151 | ;
|
|---|
| 152 | ;--- Prepare the data
|
|---|
| 153 | S IR="",RC=0
|
|---|
| 154 | F S IR=$O(LTLST(IR)) Q:IR="" D Q:RC<0
|
|---|
| 155 | . ;--- Check if the test is defined in the LABORATORY TEST file
|
|---|
| 156 | . S TSTIEN=+$P(LTLST(IR),U,3)
|
|---|
| 157 | . Q:$$FIND1^DIC(60,,,"`"_TSTIEN,,,"RORMSG")'>0
|
|---|
| 158 | . ;--- Assign the default Group IEN (if the GROUP is provided)
|
|---|
| 159 | . I GROUPIEN>0 S LTL(GROUPIEN,TSTIEN)="" Q
|
|---|
| 160 | . ;--- Get IEN of the Lab Group
|
|---|
| 161 | . S TMP=+$P(LTLST(IR),U,4)
|
|---|
| 162 | . S GRPIEN=$$ITEMIEN^RORUTL09(3,REGIEN,TMP)
|
|---|
| 163 | . I GRPIEN'>0 D:GRPIEN<0 Q
|
|---|
| 164 | . . S RC=$$ERROR^RORERR(GRPIEN)
|
|---|
| 165 | . ;--- Create the reference
|
|---|
| 166 | . S LTL(GRPIEN,TSTIEN)=""
|
|---|
| 167 | I RC<0 D ERROR(.RESULTS,RC) Q
|
|---|
| 168 | ;
|
|---|
| 169 | ;--- Mark the groups to be cleared
|
|---|
| 170 | I GROUPIEN'>0 S GRPIEN="" D
|
|---|
| 171 | . F S GRPIEN=$O(@ROOT@("G",GRPIEN)) Q:GRPIEN="" S LTL(GRPIEN)=""
|
|---|
| 172 | E S LTL(GROUPIEN)=""
|
|---|
| 173 | ;
|
|---|
| 174 | ;--- Update the multiple
|
|---|
| 175 | S IENS="?+1,"_REGIEN_",",ECNT=0
|
|---|
| 176 | S GRPIEN=""
|
|---|
| 177 | F S GRPIEN=$O(LTL(GRPIEN)) Q:GRPIEN="" D
|
|---|
| 178 | . ;--- Delete the old records
|
|---|
| 179 | . S DIK=$$OREF^DILF(ROOT),DA(1)=REGIEN
|
|---|
| 180 | . S TSTIEN=""
|
|---|
| 181 | . F S TSTIEN=$O(@ROOT@("G",GRPIEN,TSTIEN)) Q:TSTIEN="" D
|
|---|
| 182 | . . S DA=""
|
|---|
| 183 | . . F S DA=$O(@ROOT@("G",GRPIEN,TSTIEN,DA)) Q:DA="" D ^DIK
|
|---|
| 184 | . ;--- Store the new records
|
|---|
| 185 | . S TSTIEN=""
|
|---|
| 186 | . F S TSTIEN=$O(LTL(GRPIEN,TSTIEN)) Q:TSTIEN="" D
|
|---|
| 187 | . . S RORFDA(798.128,IENS,.01)=TSTIEN
|
|---|
| 188 | . . S RORFDA(798.128,IENS,.02)=GRPIEN
|
|---|
| 189 | . . D UPDATE^DIE(,"RORFDA",,"RORMSG")
|
|---|
| 190 | . . I $G(DIERR) D S ECNT=ECNT+1 Q
|
|---|
| 191 | . . . D DBS^RORERR("RORMSG",-9,,,798.128,IENS)
|
|---|
| 192 | ;
|
|---|
| 193 | ;--- Unlock the multiple and check for errors
|
|---|
| 194 | D UNLOCK^RORLOCK(798.128,","_REGIEN_",")
|
|---|
| 195 | I ECNT>0 D RPCSTK^RORERR(.RESULTS,-9) Q
|
|---|
| 196 | ;--- Success
|
|---|
| 197 | S RESULTS(0)=0
|
|---|
| 198 | Q
|
|---|
