Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XOBESIG

XOBESIG.m

Go to the documentation of this file. 
  1. XOBESIG ;Oakland/mko-ELECTRONIC SIGNATURE CODES ;9:29 AM  14 Jul 2006
  1.  ;;1.0;Electronic Signature;;Jul 14, 2006
  1.  ;;Foundations Electronic Signature Release v1.0 [Build: 1.0.0.024]
  1.  ;
  1. ISDEF(RESULT) ; -- Returns whether the user has an Electronic Signature Code defined.
  1.  ; Returns:
  1.  ;   0 : if the user has no esig defined
  1.  ;   1 : if the user does have an esig defined
  1.  ;  -2 : if DUZ doesn't refer to a valid user
  1.  ;
  1.  ; Remote Procedure: XOBE ESIG IS DEFINED
  1.  ;
  1.  NEW XOBESIG,XOBEMSG,DIERR
  1.  KILL RESULT
  1.  ;
  1.  ; -- Get current esig
  1.  SET XOBESIG=$$GET1^DIQ(200,+$GET(DUZ)_",",20.4,"I","","XOBEMSG")
  1.  ;
  1.  ; -- Check result
  1.  IF $GET(DIERR),$DATA(XOBEMSG("DIERR","E",601)) SET RESULT=-2
  1.  ELSE  IF XOBESIG]"" SET RESULT=1
  1.  ELSE  SET RESULT=0
  1.  QUIT
  1.  ;
  1. GETCODE(RESULT) ; -- Get user's Electronic Signature Code
  1.  ; Return:
  1.  ;   Electronic signature code
  1.  ;   -2 : if DUZ doesn't refer to a valid user
  1.  ;
  1.  ; Remote Procedure: XOBE ESIG GET CODE
  1.  ;
  1.  NEW XOBESIG,XOBEMSG,DIERR
  1.  KILL RESULT
  1.  ;
  1.  ; -- Get current esig
  1.  SET XOBESIG=$$GET1^DIQ(200,+$GET(DUZ)_",",20.4,"I","","XOBEMSG")
  1.  ;
  1.  ; -- Return result
  1.  IF $GET(DIERR),$DATA(XOBEMSG("DIERR","E",601)) SET RESULT=-2
  1.  ELSE  IF XOBESIG="" SET RESULT=""
  1.  ELSE  SET RESULT=$$ENCRYP^XUSRB1(XOBESIG)
  1.  QUIT
  1.  ;
  1. SETCODE(RESULT,XOBESIG) ; -- Save user's Electronic Signature Code
  1.  ; Return:
  1.  ;   1 : if new ESig was correctly filed
  1.  ;   0 : if new ESig code is not valid
  1.  ;  -1 : if new ESig is the same as the old one
  1.  ;  -2 : if DUZ doesn't refer to a valid user
  1.  ;
  1.  ; Remote Procedure: XOBE ESIG SET CODE
  1.  ;
  1.  NEW X,XOBEIENS,XOBEOLD,XOBEFDA,XOBEMSG,DIERR
  1.  KILL RESULT
  1.  ;
  1.  ; -- Get the old esig code
  1.  SET XOBEIENS=+$GET(DUZ)_","
  1.  SET XOBEOLD=$$GET1^DIQ(200,XOBEIENS,20.4,"I","","XOBEMSG")
  1.  IF $GET(DIERR) DO  QUIT
  1.  . IF $DATA(XOBEMSG("DIERR","E",601)) SET RESULT=-2
  1.  . ELSE  SET RESULT=0
  1.  ;
  1.  ; -- Validate format of new esig
  1.  IF $GET(XOBESIG)="" SET RESULT=0 QUIT
  1.  SET X=$$DECRYP^XUSRB1(XOBESIG)
  1.  IF X'?.UNP!($LENGTH(X)>20)!($LENGTH(X)<6) SET RESULT=0 QUIT
  1.  ;
  1.  ; -- Make sure old and new are different
  1.  DO HASH^XUSHSHP
  1.  IF X=XOBEOLD SET RESULT=-1 QUIT
  1.  ;
  1.  ; -- Save the new code
  1.  SET XOBEFDA(200,XOBEIENS,20.4)=X
  1.  DO FILE^DIE("","XOBEFDA","XOBEMSG")
  1.  IF $GET(DIERR) SET RESULT=0 QUIT
  1.  ;
  1.  SET RESULT=1
  1.  QUIT
  1.  ;
  1. GETDATA(RESULT) ; -- Return electronic signature block-related data
  1.  ; Return:
  1.  ;   Electronic signature block-related data
  1.  ;   -2 : if DUZ doesn't refer to a valid user
  1.  ;
  1.  ; Remote Procedure: XOBE ESIG GET DATA
  1.  ;
  1.  NEW XOBEIENS,XOBEFLDS,XOBETARG,XOBEMSG,DIERR
  1.  KILL RESULT
  1.  ;
  1.  ; -- Setup input variables to GETS^DIQ call
  1.  SET XOBEIENS=+$GET(DUZ)_","
  1.  SET XOBEFLDS="1;20.2;20.3;.132;.137;.138"
  1.  ;
  1.  ; -- Get data
  1.  DO GETS^DIQ(200,XOBEIENS,XOBEFLDS,"I","XOBETARG","XOBEMSG")
  1.  IF $GET(DIERR) DO  QUIT
  1.  . IF $DATA(XOBEMSG("DIERR","E",601)) SET RESULT=-2
  1.  . ELSE  SET RESULT=""
  1.  ;
  1.  ; -- Put data into RESULT array
  1.  SET RESULT(1)=$$VALUE($GET(XOBETARG(200,XOBEIENS,1,"I"))) ;initial
  1.  SET RESULT(2)=$$VALUE($GET(XOBETARG(200,XOBEIENS,20.2,"I"))) ;sig blk printed name
  1.  SET RESULT(3)=$$VALUE($GET(XOBETARG(200,XOBEIENS,20.3,"I"))) ;sig blk title
  1.  SET RESULT(4)=$$VALUE($GET(XOBETARG(200,XOBEIENS,.132,"I"))) ;office phone
  1.  SET RESULT(5)=$$VALUE($GET(XOBETARG(200,XOBEIENS,.137,"I"))) ;voice pager
  1.  SET RESULT(6)=$$VALUE($GET(XOBETARG(200,XOBEIENS,.138,"I"))) ;digital pager
  1.  QUIT
  1.  ;
  1. VALUE(X) ; -- Return X or if X is "", return @
  1.  QUIT $SELECT($GET(X)="":"@",1:X)
  1.  ;
  1. SETDATA(RESULT,XOBEVALS) ; -- Save electronic signature block-related data
  1.  ; Return:
  1.  ;            1 : if successfully filed
  1.  ;           -2 : if DUZ doesn't refer to a valid user
  1.  ;   error text : if Filer call failed
  1.  ;
  1.  ; Remote Procedure: XOBE ESIG SET DATA
  1.  ;
  1.  NEW XOBEFDA,DIERR,XOBEMSG,XOBEIENS
  1.  KILL RESULT
  1.  SET XOBEIENS=+$GET(DUZ)_","
  1.  ;
  1.  ; -- Setup up FDA for FILE^DIE call
  1.  SET XOBEFDA(200,XOBEIENS,1)=$GET(XOBEVALS("initial"))
  1.  SET XOBEFDA(200,XOBEIENS,20.2)=$GET(XOBEVALS("signature block printed name"))
  1.  SET XOBEFDA(200,XOBEIENS,20.3)=$GET(XOBEVALS("signature block title"))
  1.  SET XOBEFDA(200,XOBEIENS,.132)=$GET(XOBEVALS("office phone"))
  1.  SET XOBEFDA(200,XOBEIENS,.137)=$GET(XOBEVALS("voice pager"))
  1.  SET XOBEFDA(200,XOBEIENS,.138)=$GET(XOBEVALS("digital pager"))
  1.  ;
  1.  ; -- File the data
  1.  DO FILE^DIE("ET","XOBEFDA","XOBEMSG")
  1.  ;
  1.  ; -- Handle errors
  1.  IF $GET(DIERR) DO  QUIT
  1.  . ; -- Entry not found error
  1.  . IF $DATA(XOBEMSG("DIERR","E",601)) SET RESULT(1)=-2 QUIT
  1.  . ;
  1.  . ; -- Put error message into RESULT array
  1.  . NEW ERR,LN
  1.  . SET ERR=0 FOR  SET ERR=$ORDER(XOBEMSG("DIERR",ERR)) QUIT:'ERR  DO
  1.  .. DO ADDTEXT("Error #"_XOBEMSG("DIERR",ERR),.RESULT)
  1.  .. DO ADDTEXT("--------------",.RESULT)
  1.  .. SET LN=0 FOR  SET LN=$ORDER(XOBEMSG("DIERR",ERR,"TEXT",LN)) QUIT:'LN  DO
  1.  ... DO ADDTEXT(XOBEMSG("DIERR",ERR,"TEXT",LN),.RESULT)
  1.  .. ;
  1.  .. ; -- If the error returned is 701 (invalid input),
  1.  .. ; -- put the ? help for the field into the RESULT array
  1.  .. IF XOBEMSG("DIERR",ERR)=701 DO ADDHELP(.XOBEMSG,ERR,.RESULT)
  1.  ;
  1.  ; -- Values were successfully saved
  1.  SET RESULT(1)=1
  1.  QUIT
  1.  ;
  1. ADDHELP(XOBEMSG,ERR,RESULT) ;
  1.  NEW FILE,IENS,FIELD,LINE,MSG,DIERR,DIHELP
  1.  ;
  1.  ; -- Get file/field information from the XOBEMSG array
  1.  SET FILE=$GET(XOBEMSG("DIERR",ERR,"PARAM","FILE"))
  1.  SET IENS=$GET(XOBEMSG("DIERR",ERR,"PARAM","IENS"))
  1.  SET FIELD=$GET(XOBEMSG("DIERR",ERR,"PARAM","FIELD"))
  1.  ;
  1.  ; -- Get the ? help for the field
  1.  DO HELP^DIE(FILE,IENS,FIELD,"?","MSG")
  1.  ;
  1.  ; -- Add the ? help to the RESULT array
  1.  SET LINE=0 FOR  SET LINE=$ORDER(MSG("DIHELP",LINE)) Q:'LINE  DO
  1.  . DO ADDTEXT(MSG("DIHELP",LINE),.RESULT)
  1.  DO ADDTEXT("",.RESULT)
  1.  QUIT
  1.  ;
  1. ADDTEXT(TEXT,RESULT) ;Add TEXT to RESULT array
  1.  NEW NODE
  1.  SET NODE=$ORDER(RESULT(" "),-1)+1
  1.  SET RESULT(NODE)=$GET(TEXT)
  1.  QUIT
  1.  ;
  1. VALIDATE(RESULT,XOBESIG) ; -- Return whether passed ESig is valid
  1.  ; Return:
  1.  ;   1 if ESig is valid
  1.  ;   0 if ESig is invalid
  1.  ;  -1 if ESig is null
  1.  ;  -2 if DUZ doesn't refer to a valid user
  1.  ; This entry point is not currently used.
  1.  ;
  1.  NEW X,XOBECURR,XOBEIENS,XOBEMSG,DIERR
  1.  KILL RESULT
  1.  ;
  1.  ; -- Get esig from New Person file
  1.  SET XOBEIENS=+$GET(DUZ)_","
  1.  SET XOBECURR=$$GET1^DIQ(200,XOBEIENS,20.4,"I","","XOBEMSG")
  1.  ;
  1.  ; -- Check that DUZ refers to a valid user
  1.  IF $GET(DIERR),$DATA(XOBEMSG("DIERR","E",601)) SET RESULT=-2 QUIT
  1.  ;
  1.  ; -- Check for null esig
  1.  IF XOBECURR="" SET RESULT=-1 QUIT
  1.  ;
  1.  ; -- Check whether old matches value passed in
  1.  SET X=$$DECRYP^XUSRB1(XOBESIG)
  1.  DO HASH^XUSHSHP
  1.  SET RESULT=X=XOBECURR
  1.  QUIT