| [796] | 1 | TMGRPC3B ;TMG/kst/Support Functions for GUI_Config ;08/31/08 ; 5/29/10 6:40pm
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;08/31/08
|
|---|
| 3 | ;
|
|---|
| 4 | ;"TMG RPC FUNCTIONS for a GUI config program
|
|---|
| 5 | ;
|
|---|
| 6 | ;"Kevin Toppenberg MD
|
|---|
| 7 | ;"GNU Lessor General Public License (LGPL) applies
|
|---|
| 8 | ;"7/20/08
|
|---|
| 9 | ;
|
|---|
| 10 | ;"=======================================================================
|
|---|
| 11 | ;" RPC -- Public Functions.
|
|---|
| 12 | ;"=======================================================================
|
|---|
| 13 | ;" <none>
|
|---|
| 14 | ;"=======================================================================
|
|---|
| 15 | ;"PRIVATE API FUNCTIONS
|
|---|
| 16 | ;"=======================================================================
|
|---|
| 17 | ;"GETUSRLT(TMGOUT,TMGPARAMS) -- fill list with users on the system.
|
|---|
| 18 | ;"GETRECLT(TMGOUT,TMGPARAMS) -- fill list with records in file on the system
|
|---|
| 19 | ;"GET1USER(TMGOUT,TMGIEN) -- Get one user's record
|
|---|
| 20 | ;"GET1REC(TMGOUT,TMGPARAMS) -- get one record in file
|
|---|
| 21 | ;"XTRCTFLD(TMGOUT,TMGARRAY,TMGFLAG) -- convert output from GETS^DIQ into another format
|
|---|
| 22 | ;"GFLSUBST(TMGOUT,TMGPARAMS) -- return a subset of entries a file's .01 names
|
|---|
| 23 | ;
|
|---|
| 24 | ;"=======================================================================
|
|---|
| 25 | ;"=======================================================================
|
|---|
| 26 | ;"Dependencies:
|
|---|
| 27 | ;" TMGRPC3* only
|
|---|
| 28 | ;
|
|---|
| 29 | ;"=======================================================================
|
|---|
| 30 | ;"=======================================================================
|
|---|
| 31 | ;
|
|---|
| 32 | ;"=======================================================================
|
|---|
| 33 | ;
|
|---|
| 34 | GETUSRLT(TMGOUT,TMGPARAMS) ;"GET USER LIST
|
|---|
| 35 | ;"Purpose: to fill list with users on the system.
|
|---|
| 36 | ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
|
|---|
| 37 | ;" TMGPARAMS -- either "" or "NODISUSER" if not to return DISUSER=YES users
|
|---|
| 38 | ;"Output: TMGOUT is filled as follows:
|
|---|
| 39 | ;" TMGOUT(0)="1^Success" or "-1^Message"
|
|---|
| 40 | ;" TMGOUT(1)=Name^IEN^200^DISUSER DISUSER will be 1 for "Y" or 0 for "N"
|
|---|
| 41 | ;" TMGOUT(2)=Name^IEN^200^DISUSER
|
|---|
| 42 | ;"Results: none
|
|---|
| 43 | ;
|
|---|
| 44 | NEW TMGACTIVEONLY SET TMGACTIVEONLY=($GET(TMGPARAMS)="NODISUSER")
|
|---|
| 45 | NEW TMGINDEX SET TMGINDEX=1
|
|---|
| 46 | NEW TMGNAME SET TMGNAME=""
|
|---|
| 47 | FOR SET TMGNAME=$ORDER(^VA(200,"B",TMGNAME)) QUIT:(TMGNAME="") DO
|
|---|
| 48 | . NEW TMGIEN SET TMGIEN=""
|
|---|
| 49 | . FOR SET TMGIEN=$ORDER(^VA(200,"B",TMGNAME,TMGIEN)) QUIT:(+TMGIEN'>0) DO
|
|---|
| 50 | . . NEW TMGDISUSER SET TMGDISUSER=$PIECE($GET(^VA(200,TMGIEN,0)),"^",7)
|
|---|
| 51 | . . IF (TMGACTIVEONLY)&(TMGDISUSER) QUIT
|
|---|
| 52 | . . NEW TMGNAME SET TMGNAME=$PIECE($GET(^VA(200,TMGIEN,0)),"^",1)
|
|---|
| 53 | . . SET TMGOUT(TMGINDEX)=TMGNAME_"^"_TMGIEN_"^200^"_TMGDISUSER
|
|---|
| 54 | . . SET TMGINDEX=TMGINDEX+1
|
|---|
| 55 | ;
|
|---|
| 56 | SET TMGOUT(0)="1^Success"
|
|---|
| 57 | ;
|
|---|
| 58 | QUIT
|
|---|
| 59 | ;
|
|---|
| 60 | GETRECLT(TMGOUT,TMGPARAMS) ;"GET RECS LIST
|
|---|
| 61 | ;"Purpose: to fill list with records in file on the system.
|
|---|
| 62 | ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
|
|---|
| 63 | ;" TMGPARAMS -- Filenumber
|
|---|
| 64 | ;"Output: TMGOUT is filled as follows:
|
|---|
| 65 | ;" TMGOUT(0)="1^Success" or "-1^Message"
|
|---|
| 66 | ;" TMGOUT(1)=.01Value^IEN^FileNum
|
|---|
| 67 | ;" TMGOUT(2)=.01Value^IEN^FileNum
|
|---|
| 68 | ;"Results: none
|
|---|
| 69 | ;
|
|---|
| 70 | NEW TMGINDEX SET TMGINDEX=1
|
|---|
| 71 | NEW TMGNAME SET TMGNAME=""
|
|---|
| 72 | NEW TMGFNUM SET TMGFNUM=+$GET(TMGPARAMS)
|
|---|
| 73 | IF TMGFNUM'>0 DO GOTO GRLDONE
|
|---|
| 74 | . SET TMGOUT(0)="-1^Valid file number not found"
|
|---|
| 75 | NEW TMGREF SET TMGREF=$GET(^DIC(TMGFNUM,0,"GL"))
|
|---|
| 76 | SET TMGREF=$$CREF^DILF(TMGREF)
|
|---|
| 77 | IF TMGREF="" DO GOTO GRLDONE
|
|---|
| 78 | . SET TMGOUT(0)="-1^Unable to find global reference for file: "_TMGFNUM
|
|---|
| 79 | NEW TMGLOC,TMGPIECE
|
|---|
| 80 | SET TMGLOC=$PIECE(^DD(TMGFNUM,.01,0),"^",4)
|
|---|
| 81 | SET TMGPIECE=$PIECE(TMGLOC,";",2)
|
|---|
| 82 | SET TMGLOC=$PIECE(TMGLOC,";",1)
|
|---|
| 83 | FOR SET TMGNAME=$ORDER(@TMGREF@("B",TMGNAME)) QUIT:(TMGNAME="") DO
|
|---|
| 84 | . NEW TMGIEN SET TMGIEN=""
|
|---|
| 85 | . FOR SET TMGIEN=$ORDER(@TMGREF@("B",TMGNAME,TMGIEN)) QUIT:(+TMGIEN'>0) DO
|
|---|
| 86 | . . NEW TMGNAME SET TMGNAME=$PIECE($GET(@TMGREF@(TMGIEN,TMGLOC)),"^",TMGPIECE)
|
|---|
| 87 | . . SET TMGOUT(TMGINDEX)=TMGNAME_"^"_TMGIEN_"^"_TMGFNUM
|
|---|
| 88 | . . SET TMGINDEX=TMGINDEX+1
|
|---|
| 89 | ;
|
|---|
| 90 | SET TMGOUT(0)="1^Success"
|
|---|
| 91 | GRLDONE ;
|
|---|
| 92 | QUIT
|
|---|
| 93 | ;
|
|---|
| 94 | GET1USER(TMGOUT,TMGIEN) ;"GET ONE USER
|
|---|
| 95 | ;"Purpose: to get record of one user
|
|---|
| 96 | ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
|
|---|
| 97 | ;" TMGIEN -- the IEN in file 200 to get
|
|---|
| 98 | ;"Output: TMGOUT is filled as follows:
|
|---|
| 99 | ;" TMGOUT(0)="1^Success" or "-1^Message"
|
|---|
| 100 | ;" TMGOUT(1)=File^IENS^FieldNum^ExternalValue^DDInfo...
|
|---|
| 101 | ;" TMGOUT(2)=File^IENS^FieldNum^ExternalValue^DDInfo...
|
|---|
| 102 | ;"Note: the fields to return are decided HERE
|
|---|
| 103 | ;"Results: none
|
|---|
| 104 | ;
|
|---|
| 105 | NEW TMGIENS SET TMGIENS=+$GET(TMGIEN)_","
|
|---|
| 106 | DO GET1REC(.TMGOUT,"200^"_TMGIENS)
|
|---|
| 107 | QUIT
|
|---|
| 108 | ;
|
|---|
| 109 | ;
|
|---|
| 110 | GET1REC(TMGOUT,TMGPARAMS) ;
|
|---|
| 111 | ;"Purpose: to get one record in file
|
|---|
| 112 | ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
|
|---|
| 113 | ;" TMGPARAMS: File^IENS
|
|---|
| 114 | ;" File -- the file or subfile to retrieve from
|
|---|
| 115 | ;" IENS -- if File is a subfile, then IENS should be full IENS to get (e.g. '2,103,')
|
|---|
| 116 | ;" if File is not a subfile, then IENS can be just IEN or IEN_","
|
|---|
| 117 | ;"Output: TMGOUT is filled as follows:
|
|---|
| 118 | ;" TMGOUT(0)="1^Success" or "-1^Message"
|
|---|
| 119 | ;" TMGOUT(1)=File^IENS^FieldNum^ExternalValue^DDInfo...
|
|---|
| 120 | ;" TMGOUT(2)=File^IENS^FieldNum^ExternalValue^DDInfo...
|
|---|
| 121 | ;"Note: the fields to return are decided HERE
|
|---|
| 122 | ;"Results: none
|
|---|
| 123 | ;
|
|---|
| 124 | SET TMGOUT(0)="1^Success" ;"default to success
|
|---|
| 125 | NEW TMGARRAY,TMGMSG
|
|---|
| 126 | NEW TMGREF SET TMGREF="TMGARRAY"
|
|---|
| 127 | SET TMGPARAMS=$GET(TMGPARAMS)
|
|---|
| 128 | SET ^TMG("TMP","RPC","GET1REC")=TMGPARAMS
|
|---|
| 129 | NEW TMGFILE SET TMGFILE=$PIECE(TMGPARAMS,"^",1)
|
|---|
| 130 | IF +TMGFILE'>0 DO GOTO GORDONE
|
|---|
| 131 | . SET TMGOUT(0)="-1^No file number supplied"
|
|---|
| 132 | NEW TMGIENS SET TMGIENS=$PIECE(TMGPARAMS,"^",2)
|
|---|
| 133 | IF TMGIENS="" DO GOTO GORDONE
|
|---|
| 134 | . SET TMGOUT(0)="-1^No IENS supplied"
|
|---|
| 135 | ;
|
|---|
| 136 | DO GETS^DIQ(TMGFILE,TMGIENS,"**","IE",TMGREF,"TMGMSG")
|
|---|
| 137 | ;
|
|---|
| 138 | IF $DATA(TMGMSG("DIERR")) DO GOTO GORDONE
|
|---|
| 139 | . SET TMGOUT(0)="-1^See Fileman message"
|
|---|
| 140 | . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
|
|---|
| 141 | ;
|
|---|
| 142 | DO XTRCTFLD(.TMGOUT,.TMGARRAY,"E")
|
|---|
| 143 | ;
|
|---|
| 144 | GORDONE ;
|
|---|
| 145 | QUIT
|
|---|
| 146 | ;
|
|---|
| 147 | ;
|
|---|
| 148 | XTRCTFLD(TMGOUT,TMGARRAY,TMGFLAG) ;"EXTRACT FIELDS
|
|---|
| 149 | ;"Purpose: convert output from GETS^DIQ into another format
|
|---|
| 150 | ;
|
|---|
| 151 | NEW TMGINDEX SET TMGINDEX=1
|
|---|
| 152 | NEW TMGFILE,TMGFIELD,TMGIENS
|
|---|
| 153 | SET TMGFILE=""
|
|---|
| 154 | FOR SET TMGFILE=$ORDER(TMGARRAY(TMGFILE)) QUIT:(TMGFILE="") DO
|
|---|
| 155 | . SET TMGIENS=""
|
|---|
| 156 | . FOR SET TMGIENS=$ORDER(TMGARRAY(TMGFILE,TMGIENS)) QUIT:(TMGIENS="") DO
|
|---|
| 157 | . . SET TMGFIELD=0
|
|---|
| 158 | . . FOR SET TMGFIELD=$ORDER(^DD(TMGFILE,TMGFIELD)) QUIT:(+TMGFIELD'>0) DO
|
|---|
| 159 | . . . IF $GET(TMGARRAY(TMGFILE,TMGIENS,TMGFIELD,TMGFLAG))="" DO
|
|---|
| 160 | . . . . SET TMGARRAY(TMGFILE,TMGIENS,TMGFIELD,TMGFLAG)=""
|
|---|
| 161 | . . SET TMGFIELD=""
|
|---|
| 162 | . . FOR SET TMGFIELD=$ORDER(TMGARRAY(TMGFILE,TMGIENS,TMGFIELD)) QUIT:(TMGFIELD="") DO
|
|---|
| 163 | . . . NEW TMGVALUE SET TMGVALUE=$GET(TMGARRAY(TMGFILE,TMGIENS,TMGFIELD,TMGFLAG))
|
|---|
| 164 | . . . NEW TMGDDINFO SET TMGDDINFO=$PIECE($GET(^DD(TMGFILE,TMGFIELD,0)),"^",1,4)
|
|---|
| 165 | . . . IF $PIECE(TMGDDINFO,"^",2)["D" DO ;"convert data format to one Delphi can use
|
|---|
| 166 | . . . . IF TMGFLAG="I" QUIT
|
|---|
| 167 | . . . . NEW X SET X=$GET(TMGARRAY(TMGFILE,TMGIENS,TMGFIELD,"I"))
|
|---|
| 168 | . . . . SET TMGVALUE=$$FMTE^XLFDT(X,5)
|
|---|
| 169 | . . . SET TMGOUT(TMGINDEX)=TMGFILE_"^"_TMGIENS_"^"_TMGFIELD_"^"_TMGVALUE
|
|---|
| 170 | . . . SET TMGOUT(TMGINDEX)=TMGOUT(TMGINDEX)_"^"_TMGDDINFO
|
|---|
| 171 | . . . SET TMGINDEX=TMGINDEX+1
|
|---|
| 172 | ;
|
|---|
| 173 | QUIT
|
|---|
| 174 | ;
|
|---|
| 175 | GFLSUBST(TMGOUT,TMGPARAMS) ;"GET FILE SUBSET
|
|---|
| 176 | ;"Purpose: to return a subset of entries a file's .01 names
|
|---|
| 177 | ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
|
|---|
| 178 | ;" TMGPARAMS -- FileNum^StartFrom^Direction^maxCount
|
|---|
| 179 | ;" TMGFNUM - filename file to traverse
|
|---|
| 180 | ;" StartFrom -- text to $ORDER() from -- OPTIONAL
|
|---|
| 181 | ;" Direction -- $ORDER(xx,Direction) direction (should be 1 or -1) -- OPTIONAL
|
|---|
| 182 | ;" maxCt -- OPTIONAL -- the max number of entries to return.
|
|---|
| 183 | ;"Output: TMGOUT is filled as follows:
|
|---|
| 184 | ;" TMGOUT(0)="1^Success" or "-1^Message"
|
|---|
| 185 | ;" TMGOUT(1)=IEN^Value
|
|---|
| 186 | ;" TMGOUT(2)=IEN^Value
|
|---|
| 187 | ;" ...
|
|---|
| 188 | ;"Results: none
|
|---|
| 189 | ;"NOTE: does NOT work with sub files.
|
|---|
| 190 | ;
|
|---|
| 191 | NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
|
|---|
| 192 | IF TMGFILE'>0 DO GOTO GFSDONE
|
|---|
| 193 | . SET TMGOUT(0)="-1^No file number supplied"
|
|---|
| 194 | NEW TMGFROM SET TMGFROM=$PIECE(TMGPARAMS,"^",2)
|
|---|
| 195 | NEW TMGDIR SET TMGDIR=$PIECE(TMGPARAMS,"^",3)
|
|---|
| 196 | IF TMGDIR'=-1 SET TMGDIR=1
|
|---|
| 197 | NEW TMGMAXCT SET TMGMAXCT=+$PIECE(TMGPARAMS,"^",4)
|
|---|
| 198 | IF TMGMAXCT=0 SET TMGMAXCT=44
|
|---|
| 199 | NEW TMGISPTR SET TMGISPTR=($PIECE($GET(^DD(TMGFILE,.01,0)),"^",2)["P")
|
|---|
| 200 | NEW TMGSTARTIEN SET TMGSTARTIEN=""
|
|---|
| 201 | IF TMGISPTR DO
|
|---|
| 202 | . IF $LENGTH(TMGFROM,";")>2 SET TMGSTARTIEN=+$PIECE(TMGFROM,";",2)
|
|---|
| 203 | . IF TMGFROM?1.N1";".E SET TMGFROM=+TMGFROM
|
|---|
| 204 | ;
|
|---|
| 205 | NEW TMGI SET TMGI=0
|
|---|
| 206 | ;"NEW TMGLAST SET TMGLAST=""
|
|---|
| 207 | ;"NEW prev SET prev=""
|
|---|
| 208 | NEW TMGREF SET TMGREF=$GET(^DIC(TMGFILE,0,"GL"))
|
|---|
| 209 | SET TMGREF=$$CREF^DILF(TMGREF) ;"convert open --> closed reference
|
|---|
| 210 | IF TMGREF="" DO GOTO GFSDONE
|
|---|
| 211 | . SET TMGOUT(0)="-1^Unable to obtain global ref for file #"_TMGFILE
|
|---|
| 212 | ;
|
|---|
| 213 | FOR SET TMGFROM=$ORDER(@TMGREF@("B",TMGFROM),TMGDIR) QUIT:(TMGFROM="")!(TMGI'<TMGMAXCT) DO
|
|---|
| 214 | . NEW TMGIEN SET TMGIEN=TMGSTARTIEN
|
|---|
| 215 | . FOR SET TMGIEN=$ORDER(@TMGREF@("B",TMGFROM,TMGIEN),TMGDIR) QUIT:(+TMGIEN'>0)!(TMGI'<TMGMAXCT) DO
|
|---|
| 216 | . . SET TMGI=TMGI+1
|
|---|
| 217 | . . SET TMGOUT(TMGI)=TMGIEN_"^"
|
|---|
| 218 | . . IF TMGISPTR SET TMGOUT(TMGI)=TMGOUT(TMGI)_TMGFROM_";"_TMGIEN_";"
|
|---|
| 219 | . . SET TMGOUT(TMGI)=TMGOUT(TMGI)_$$GET1^DIQ(TMGFILE,TMGIEN_",",.01)
|
|---|
| 220 | . . ;"SET TMGOUT(TMGI)=$$GET1^DIQ(TMGFILE,IEN_",",.01)
|
|---|
| 221 | ;
|
|---|
| 222 | SET TMGOUT(0)="1^Success"
|
|---|
| 223 | GFSDONE ;
|
|---|
| 224 | QUIT
|
|---|
| 225 | ;
|
|---|
| 226 | ;
|
|---|
