| 1 | TMGRPC1B ;TMG/kst-RPC Functions ;3/28/10
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;3/28/10
|
|---|
| 3 | ;
|
|---|
| 4 | ;"TMG RPC FUNCTIONS
|
|---|
| 5 | ;
|
|---|
| 6 | ;"Copyright Kevin Toppenberg MD
|
|---|
| 7 | ;"Released under GNU General Public License (GPL)
|
|---|
| 8 | ;"
|
|---|
| 9 | ;"=======================================================================
|
|---|
| 10 | ;" RPC -- Public Functions.
|
|---|
| 11 | ;"=======================================================================
|
|---|
| 12 | ;"EVALTIUO
|
|---|
| 13 | ;"INSTALL -- Add the RPC's to the OPTION record OR CPRS GUI CHART
|
|---|
| 14 | ;"=======================================================================
|
|---|
| 15 | ;"PRIVATE API FUNCTIONS
|
|---|
| 16 | ;"=======================================================================
|
|---|
| 17 | ;"INSTALL1(RPCNAME) -- Add 1 RPC to the OPTION record OR CPRS GUI CHART
|
|---|
| 18 | ;
|
|---|
| 19 | ;"=======================================================================
|
|---|
| 20 | ;"=======================================================================
|
|---|
| 21 | ;"Dependencies:
|
|---|
| 22 | ;" DIC, TMGDEBUG
|
|---|
| 23 | ;"=======================================================================
|
|---|
| 24 | ;"=======================================================================
|
|---|
| 25 | ;
|
|---|
| 26 | EVALTIUO(TMGY,TMGOBJNM) ;"--- DEPRECIATED. Will use 'TIU TEMPLATE GETTEXT' RPC instead
|
|---|
| 27 | ;"Purpose: To return the resolved text of a TIU Text Object.
|
|---|
| 28 | ;"Input: TIUY -- This is output result for RPC caller
|
|---|
| 29 | ;" TMGOBJNM -- This is the name of the TIU TEXT OBJECT to obtain.
|
|---|
| 30 | ;"Note: lines wrapped at 200 chars length
|
|---|
| 31 | ;"Results : none
|
|---|
| 32 | ;
|
|---|
| 33 | KILL ^TMG("TMP","TABLE")
|
|---|
| 34 | zshow "*":^TMG("TMP","TABLE")
|
|---|
| 35 | NEW TMGSTR
|
|---|
| 36 | SET TMGOBJNM=$GET(TMGOBJNM)
|
|---|
| 37 | IF TMGOBJNM["|" DO GOTO STOR
|
|---|
| 38 | . SET TMGSTR="Passed TEXT OBJECT name should not contain '|' character"
|
|---|
| 39 | SET TMGSTR="|"_TMGOBJNM_"|"
|
|---|
| 40 | SET TMGSTR=$$BOIL^TIUSRVD(TMGSTR) ;" Execute Boilerplates
|
|---|
| 41 | ;
|
|---|
| 42 | STOR NEW REF SET REF=$NAME(^TMP("TMG OBJ EVAL",$J))
|
|---|
| 43 | NEW IDX SET IDX=0
|
|---|
| 44 | KILL @REF
|
|---|
| 45 | SET TMGY=REF
|
|---|
| 46 | FOR DO QUIT:(TMGSTR="")
|
|---|
| 47 | . NEW SA,SB
|
|---|
| 48 | . SET (SA,SB)=""
|
|---|
| 49 | . IF $LENGTH(TMGSTR)>200 DO
|
|---|
| 50 | . . SET SB=$EXTRACT(TMGSTR,201,999)
|
|---|
| 51 | . . SET TMGSTR=$EXTRACT(TMGSTR,1,200)
|
|---|
| 52 | . SET IDX=IDX+1
|
|---|
| 53 | . SET @REF@(IDX)=TMGSTR
|
|---|
| 54 | . SET TMGSTR=SB
|
|---|
| 55 | QUIT
|
|---|
| 56 | ;
|
|---|
| 57 | ;
|
|---|
| 58 | INSTALL ;
|
|---|
| 59 | ;"Purpose: to add the RPC's to the OPTION record OR CPRS GUI CHART
|
|---|
| 60 | DO INSTALL1("TMG EVAL TIU TEXT OBJECT")
|
|---|
| 61 | QUIT
|
|---|
| 62 | ;
|
|---|
| 63 | INSTALL1(RPCNAME) ;
|
|---|
| 64 | ;"Purpose: to add 1 RPC to the OPTION record OR CPRS GUI CHART
|
|---|
| 65 | NEW DIC,X,Y,DA
|
|---|
| 66 | SET DIC="^DIC(19,",DIC(0)="M"
|
|---|
| 67 | SET X="OR CPRS GUI CHART"
|
|---|
| 68 | DO ^DIC
|
|---|
| 69 | IF +Y'>0 DO QUIT
|
|---|
| 70 | . WRITE "ERROR. Unable to find [OR CPRS GUI CHART] in file OPTION (#19)",!
|
|---|
| 71 | . NEW TEMP READ "Press [ENTER] to continue...",TEMP:($GET(DTIME,3600))
|
|---|
| 72 | . WRITE !
|
|---|
| 73 | SET DA(1)=+Y
|
|---|
| 74 | SET DIC=DIC_DA(1)_",""RPC"","
|
|---|
| 75 | SET DIC(0)="ML" ;"LAYGO --> add entry if not found
|
|---|
| 76 | SET X=RPCNAME
|
|---|
| 77 | DO ^DIC
|
|---|
| 78 | IF +Y'>0 DO
|
|---|
| 79 | . WRITE "ERROR. Unable to add or find "_RPCNAME_" for subfile RPC in record",!
|
|---|
| 80 | . WRITE "OR CPRS GUI CHART in file OPTION (#19)",!
|
|---|
| 81 | . NEW TEMP READ "Press [ENTER] to continue...",TEMP:($GET(DTIME,3600))
|
|---|
| 82 | . WRITE !
|
|---|
| 83 | QUIT
|
|---|
