TMGRPC3B ;TMG/kst/Support Functions for GUI_Config ;08/31/08 ; 5/29/10 6:40pm
         ;;1.0;TMG-LIB;**1**;08/31/08
 ;
 ;"TMG RPC FUNCTIONS for a GUI config program
 ;
 ;"Kevin Toppenberg MD
 ;"GNU Lessor General Public License (LGPL) applies
 ;"7/20/08
 ;
 ;"=======================================================================
 ;" RPC -- Public Functions.
 ;"=======================================================================
 ;" <none>
 ;"=======================================================================
 ;"PRIVATE API FUNCTIONS
 ;"=======================================================================
 ;"GETUSRLT(TMGOUT,TMGPARAMS) -- fill list with users on the system.
 ;"GETRECLT(TMGOUT,TMGPARAMS) -- fill list with records in file on the system
 ;"GET1USER(TMGOUT,TMGIEN) -- Get one user's record
 ;"GET1REC(TMGOUT,TMGPARAMS) -- get one record in file
 ;"XTRCTFLD(TMGOUT,TMGARRAY,TMGFLAG) -- convert output from GETS^DIQ into another format
 ;"GFLSUBST(TMGOUT,TMGPARAMS) -- return a subset of entries a file's .01 names
 ;
 ;"=======================================================================
 ;"=======================================================================
 ;"Dependencies:
 ;"  TMGRPC3* only
 ;
 ;"=======================================================================
 ;"=======================================================================
 ;
 ;"=======================================================================
 ;
GETUSRLT(TMGOUT,TMGPARAMS) ;"GET USER LIST
        ;"Purpose: to fill list with users on the system.
        ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
        ;"       TMGPARAMS -- either "" or "NODISUSER" if not to return DISUSER=YES users
        ;"Output: TMGOUT is filled as follows:
        ;"          TMGOUT(0)="1^Success" or "-1^Message"
        ;"          TMGOUT(1)=Name^IEN^200^DISUSER  DISUSER will be 1 for "Y" or 0 for "N"
        ;"          TMGOUT(2)=Name^IEN^200^DISUSER
        ;"Results: none
 ;
        NEW TMGACTIVEONLY SET TMGACTIVEONLY=($GET(TMGPARAMS)="NODISUSER")
        NEW TMGINDEX SET TMGINDEX=1
        NEW TMGNAME SET TMGNAME=""
        FOR  SET TMGNAME=$ORDER(^VA(200,"B",TMGNAME)) QUIT:(TMGNAME="")  DO
        . NEW TMGIEN SET TMGIEN=""
        . FOR  SET TMGIEN=$ORDER(^VA(200,"B",TMGNAME,TMGIEN)) QUIT:(+TMGIEN'>0)  DO
        . . NEW TMGDISUSER SET TMGDISUSER=$PIECE($GET(^VA(200,TMGIEN,0)),"^",7)
        . . IF (TMGACTIVEONLY)&(TMGDISUSER) QUIT
        . . NEW TMGNAME SET TMGNAME=$PIECE($GET(^VA(200,TMGIEN,0)),"^",1)
        . . SET TMGOUT(TMGINDEX)=TMGNAME_"^"_TMGIEN_"^200^"_TMGDISUSER
        . . SET TMGINDEX=TMGINDEX+1
 ;
        SET TMGOUT(0)="1^Success"
 ;
        QUIT
 ;
GETRECLT(TMGOUT,TMGPARAMS) ;"GET RECS LIST
        ;"Purpose: to fill list with records in file on the system.
        ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
        ;"       TMGPARAMS -- Filenumber
        ;"Output: TMGOUT is filled as follows:
        ;"          TMGOUT(0)="1^Success" or "-1^Message"
        ;"          TMGOUT(1)=.01Value^IEN^FileNum
        ;"          TMGOUT(2)=.01Value^IEN^FileNum
        ;"Results: none
 ;
        NEW TMGINDEX SET TMGINDEX=1
        NEW TMGNAME SET TMGNAME=""
        NEW TMGFNUM SET TMGFNUM=+$GET(TMGPARAMS)
        IF TMGFNUM'>0 DO  GOTO GRLDONE
        . SET TMGOUT(0)="-1^Valid file number not found"
        NEW TMGREF SET TMGREF=$GET(^DIC(TMGFNUM,0,"GL"))
        SET TMGREF=$$CREF^DILF(TMGREF)
        IF TMGREF="" DO  GOTO GRLDONE
        . SET TMGOUT(0)="-1^Unable to find global reference for file: "_TMGFNUM
        NEW TMGLOC,TMGPIECE
        SET TMGLOC=$PIECE(^DD(TMGFNUM,.01,0),"^",4)
        SET TMGPIECE=$PIECE(TMGLOC,";",2)
        SET TMGLOC=$PIECE(TMGLOC,";",1)
        FOR  SET TMGNAME=$ORDER(@TMGREF@("B",TMGNAME)) QUIT:(TMGNAME="")  DO
        . NEW TMGIEN SET TMGIEN=""
        . FOR  SET TMGIEN=$ORDER(@TMGREF@("B",TMGNAME,TMGIEN)) QUIT:(+TMGIEN'>0)  DO
        . . NEW TMGNAME SET TMGNAME=$PIECE($GET(@TMGREF@(TMGIEN,TMGLOC)),"^",TMGPIECE)
        . . SET TMGOUT(TMGINDEX)=TMGNAME_"^"_TMGIEN_"^"_TMGFNUM
        . . SET TMGINDEX=TMGINDEX+1
 ;
        SET TMGOUT(0)="1^Success"
GRLDONE ;
        QUIT
 ;
GET1USER(TMGOUT,TMGIEN) ;"GET ONE USER
        ;"Purpose: to get record of one user
        ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
        ;"       TMGIEN -- the IEN in file 200 to get
        ;"Output: TMGOUT is filled as follows:
        ;"          TMGOUT(0)="1^Success" or "-1^Message"
        ;"          TMGOUT(1)=File^IENS^FieldNum^ExternalValue^DDInfo...
        ;"          TMGOUT(2)=File^IENS^FieldNum^ExternalValue^DDInfo...
        ;"Note: the fields to return are decided HERE
        ;"Results: none
 ;
        NEW TMGIENS SET TMGIENS=+$GET(TMGIEN)_","
        DO GET1REC(.TMGOUT,"200^"_TMGIENS)
        QUIT
 ;
 ;
GET1REC(TMGOUT,TMGPARAMS) ;
        ;"Purpose: to get one record in file
        ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
        ;"       TMGPARAMS: File^IENS
        ;"         File -- the file or subfile to retrieve from
        ;"         IENS -- if File is a subfile, then IENS should be full IENS to get (e.g. '2,103,')
        ;"                 if File is not a subfile, then IENS can be just IEN or IEN_","
        ;"Output: TMGOUT is filled as follows:
        ;"          TMGOUT(0)="1^Success" or "-1^Message"
        ;"          TMGOUT(1)=File^IENS^FieldNum^ExternalValue^DDInfo...
        ;"          TMGOUT(2)=File^IENS^FieldNum^ExternalValue^DDInfo...
        ;"Note: the fields to return are decided HERE
        ;"Results: none
 ;
        SET TMGOUT(0)="1^Success"  ;"default to success
        NEW TMGARRAY,TMGMSG
        NEW TMGREF SET TMGREF="TMGARRAY"
        SET TMGPARAMS=$GET(TMGPARAMS)
        SET ^TMG("TMP","RPC","GET1REC")=TMGPARAMS
        NEW TMGFILE SET TMGFILE=$PIECE(TMGPARAMS,"^",1)
        IF +TMGFILE'>0 DO  GOTO GORDONE
        . SET TMGOUT(0)="-1^No file number supplied"
        NEW TMGIENS SET TMGIENS=$PIECE(TMGPARAMS,"^",2)
        IF TMGIENS="" DO  GOTO GORDONE
        . SET TMGOUT(0)="-1^No IENS supplied"
 ;
        DO GETS^DIQ(TMGFILE,TMGIENS,"**","IE",TMGREF,"TMGMSG")
 ;
        IF $DATA(TMGMSG("DIERR")) DO  GOTO GORDONE
        . SET TMGOUT(0)="-1^See Fileman message"
        . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
 ;
        DO XTRCTFLD(.TMGOUT,.TMGARRAY,"E")
 ;
GORDONE ;
        QUIT
 ;
 ;
XTRCTFLD(TMGOUT,TMGARRAY,TMGFLAG) ;"EXTRACT FIELDS
        ;"Purpose: convert output from GETS^DIQ into another format
 ;
        NEW TMGINDEX SET TMGINDEX=1
        NEW TMGFILE,TMGFIELD,TMGIENS
        SET TMGFILE=""
        FOR  SET TMGFILE=$ORDER(TMGARRAY(TMGFILE)) QUIT:(TMGFILE="")  DO
        . SET TMGIENS=""
        . FOR  SET TMGIENS=$ORDER(TMGARRAY(TMGFILE,TMGIENS)) QUIT:(TMGIENS="")  DO
        . . SET TMGFIELD=0
        . . FOR  SET TMGFIELD=$ORDER(^DD(TMGFILE,TMGFIELD)) QUIT:(+TMGFIELD'>0)  DO
        . . . IF $GET(TMGARRAY(TMGFILE,TMGIENS,TMGFIELD,TMGFLAG))="" DO
        . . . . SET TMGARRAY(TMGFILE,TMGIENS,TMGFIELD,TMGFLAG)=""
        . . SET TMGFIELD=""
        . . FOR  SET TMGFIELD=$ORDER(TMGARRAY(TMGFILE,TMGIENS,TMGFIELD)) QUIT:(TMGFIELD="")  DO
        . . . NEW TMGVALUE SET TMGVALUE=$GET(TMGARRAY(TMGFILE,TMGIENS,TMGFIELD,TMGFLAG))
        . . . NEW TMGDDINFO SET TMGDDINFO=$PIECE($GET(^DD(TMGFILE,TMGFIELD,0)),"^",1,4)
        . . . IF $PIECE(TMGDDINFO,"^",2)["D" DO  ;"convert data format to one Delphi can use
        . . . . IF TMGFLAG="I" QUIT
        . . . . NEW X SET X=$GET(TMGARRAY(TMGFILE,TMGIENS,TMGFIELD,"I"))
        . . . . SET TMGVALUE=$$FMTE^XLFDT(X,5)
        . . . SET TMGOUT(TMGINDEX)=TMGFILE_"^"_TMGIENS_"^"_TMGFIELD_"^"_TMGVALUE
        . . . SET TMGOUT(TMGINDEX)=TMGOUT(TMGINDEX)_"^"_TMGDDINFO
        . . . SET TMGINDEX=TMGINDEX+1
 ;
        QUIT
 ;
GFLSUBST(TMGOUT,TMGPARAMS) ;"GET FILE SUBSET
        ;"Purpose: to return a subset of entries a file's .01 names
        ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
        ;"       TMGPARAMS -- FileNum^StartFrom^Direction^maxCount
        ;"              TMGFNUM - filename file to traverse
        ;"              StartFrom -- text to $ORDER() from  -- OPTIONAL
        ;"              Direction -- $ORDER(xx,Direction) direction (should be 1 or -1) -- OPTIONAL
        ;"              maxCt -- OPTIONAL -- the max number of entries to return.
        ;"Output: TMGOUT is filled as follows:
        ;"          TMGOUT(0)="1^Success" or "-1^Message"
        ;"          TMGOUT(1)=IEN^Value
        ;"          TMGOUT(2)=IEN^Value
        ;"          ...
        ;"Results: none
        ;"NOTE: does NOT work with sub files.
 ;
        NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
        IF TMGFILE'>0 DO  GOTO GFSDONE
        . SET TMGOUT(0)="-1^No file number supplied"
        NEW TMGFROM SET TMGFROM=$PIECE(TMGPARAMS,"^",2)
        NEW TMGDIR SET TMGDIR=$PIECE(TMGPARAMS,"^",3)
        IF TMGDIR'=-1 SET TMGDIR=1
        NEW TMGMAXCT SET TMGMAXCT=+$PIECE(TMGPARAMS,"^",4)
        IF TMGMAXCT=0 SET TMGMAXCT=44
        NEW TMGISPTR SET TMGISPTR=($PIECE($GET(^DD(TMGFILE,.01,0)),"^",2)["P")
        NEW TMGSTARTIEN SET TMGSTARTIEN=""
        IF TMGISPTR DO
        . IF $LENGTH(TMGFROM,";")>2 SET TMGSTARTIEN=+$PIECE(TMGFROM,";",2)
        . IF TMGFROM?1.N1";".E SET TMGFROM=+TMGFROM
 ;
        NEW TMGI SET TMGI=0
        ;"NEW TMGLAST SET TMGLAST=""
        ;"NEW prev SET prev=""
        NEW TMGREF SET TMGREF=$GET(^DIC(TMGFILE,0,"GL"))
        SET TMGREF=$$CREF^DILF(TMGREF)  ;"convert open --> closed reference
        IF TMGREF="" DO  GOTO GFSDONE
        . SET TMGOUT(0)="-1^Unable to obtain global ref for file #"_TMGFILE
 ;
        FOR  SET TMGFROM=$ORDER(@TMGREF@("B",TMGFROM),TMGDIR) QUIT:(TMGFROM="")!(TMGI'<TMGMAXCT)  DO
        . NEW TMGIEN SET TMGIEN=TMGSTARTIEN
        . FOR  SET TMGIEN=$ORDER(@TMGREF@("B",TMGFROM,TMGIEN),TMGDIR) QUIT:(+TMGIEN'>0)!(TMGI'<TMGMAXCT)  DO
        . . SET TMGI=TMGI+1
        . . SET TMGOUT(TMGI)=TMGIEN_"^"
        . . IF TMGISPTR SET TMGOUT(TMGI)=TMGOUT(TMGI)_TMGFROM_";"_TMGIEN_";"
        . . SET TMGOUT(TMGI)=TMGOUT(TMGI)_$$GET1^DIQ(TMGFILE,TMGIEN_",",.01)
        . . ;"SET TMGOUT(TMGI)=$$GET1^DIQ(TMGFILE,IEN_",",.01)
 ;
        SET TMGOUT(0)="1^Success"
GFSDONE ;
        QUIT
 ;
 ;