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