XUSESIG3 ;EPIP/WLC - ROUTINE TO ENTER OR CHNAGE ELECTRONIC SIGNATURE REVISED; 10 Feb 2017 11:15 AM ; 21 Feb 2017 8:31 AM
;;8.0;KERNEL;**679,703**;02/02/17;Build 35
Q
PNM ; Signature Block Printed Name & Title edit
;S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Enter Employee to edit: "
;D ^DIC Q:Y<1
;S DA=+Y
N DIE S DIE=200,DR="20.2;20.3" D ^DIE
Q
;
DEG ; Old method
N DIE
S DIE=200,DR="10.6" D ^DIE
Q
;
DEGREE ; test input for DEGREE field
N DEF,DIR,X,Y,I,FLAG
S FLAG=0,DEF=$$GET1^DIQ(200,DA,10.6)
F I=1:1 D Q:FLAG
. W !!,$$GET1^DIQ(200,DA,.01),!
. W !,"Current entry for DEGREE is: ",DEF
. W !! S DIR("A")="(A)ppend/Enter or (R)eplace " S DIR(0)="F:O^1:1^I ""AaRr""'[X K X"
. S DIR("?",1)="Enter ""A"" to create a new entry or to append an additional"
. S DIR("?",2)="degree to the existing string. Enter ""R"" to start over and"
. S DIR("?",3)="replace the entire contents of degree with a new value"
. S DIR("?")="or ""R"" with no value to delete the contents of DEGREE."
. D ^DIR
. I $D(DIRUT) S FLAG=1 Q
. I Y="R"!(Y="r") D
. . S FDA(200,DA_",",10.6)="" D FILE^DIE("","FDA",) K DIR("B") S DEF=""
. S DIR(0)="PO^20.11:EMOZ",DIR("A")="Enter degree mnemonic ",DIR("?")="Enter the type of degree using a mnemonic/acronym."
. D ^DIR
. I $D(DIRUT) S FLAG=1 Q
. S DELIM=" " S:$G(DEF)="" DELIM=""
. S DEF=DEF_DELIM_$P(^DIC(20.11,+Y,0),U,3)
. I $L(DEF)>10 S DEF=$$GET1^DIQ(200,DA_",",10.6) W !,"***** Entry too long. Try Again. *****",!,"Entry must be less than ten (10) characters." Q
. I $$COMP(DEF) S DEF=$$GET1^DIQ(200,DA_",",10.6) W !,"***** Entry contains duplicates. Try Again. *****",!
. N FDA,FDAERR S FDA(200,DA_",",10.6)=DEF D FILE^DIE("","FDA","FDAERR")
. I '$D(FDAERR) Q
. I $D(FDAERR) W !,"Error in filing data. Please try again." Q
Q
;
COMP(X) ;
; Compares input string to determine if it contains dups
N FLAG,CNT,CNT1,CNT2,T1 S FLAG=0
S CNT=$L(X," ")
I CNT=1 Q FLAG
F CNT1=1:1:CNT-1 Q:'$D(X) S T1=$P(X," ",CNT1) F CNT2=CNT1+1:1:CNT I T1=$P(X," ",CNT2) S FLAG=1
Q FLAG
;
PATM(X) ;
N FLAG S FLAG=0
I X'?1.10U.4(1" "1.4U) S FLAG=1
Q FLAG
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSESIG3 2162 printed Sep 23, 2025@19:48:43 Page 2
XUSESIG3 ;EPIP/WLC - ROUTINE TO ENTER OR CHNAGE ELECTRONIC SIGNATURE REVISED; 10 Feb 2017 11:15 AM ; 21 Feb 2017 8:31 AM
+1 ;;8.0;KERNEL;**679,703**;02/02/17;Build 35
+2 QUIT
PNM ; Signature Block Printed Name & Title edit
+1 ;S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Enter Employee to edit: "
+2 ;D ^DIC Q:Y<1
+3 ;S DA=+Y
+4 NEW DIE
SET DIE=200
SET DR="20.2;20.3"
DO ^DIE
+5 QUIT
+6 ;
DEG ; Old method
+1 NEW DIE
+2 SET DIE=200
SET DR="10.6"
DO ^DIE
+3 QUIT
+4 ;
DEGREE ; test input for DEGREE field
+1 NEW DEF,DIR,X,Y,I,FLAG
+2 SET FLAG=0
SET DEF=$$GET1^DIQ(200,DA,10.6)
+3 FOR I=1:1
Begin DoDot:1
+4 WRITE !!,$$GET1^DIQ(200,DA,.01),!
+5 WRITE !,"Current entry for DEGREE is: ",DEF
+6 WRITE !!
SET DIR("A")="(A)ppend/Enter or (R)eplace "
SET DIR(0)="F:O^1:1^I ""AaRr""'[X K X"
+7 SET DIR("?",1)="Enter ""A"" to create a new entry or to append an additional"
+8 SET DIR("?",2)="degree to the existing string. Enter ""R"" to start over and"
+9 SET DIR("?",3)="replace the entire contents of degree with a new value"
+10 SET DIR("?")="or ""R"" with no value to delete the contents of DEGREE."
+11 DO ^DIR
+12 IF $DATA(DIRUT)
SET FLAG=1
QUIT
+13 IF Y="R"!(Y="r")
Begin DoDot:2
+14 SET FDA(200,DA_",",10.6)=""
DO FILE^DIE("","FDA",)
KILL DIR("B")
SET DEF=""
End DoDot:2
+15 SET DIR(0)="PO^20.11:EMOZ"
SET DIR("A")="Enter degree mnemonic "
SET DIR("?")="Enter the type of degree using a mnemonic/acronym."
+16 DO ^DIR
+17 IF $DATA(DIRUT)
SET FLAG=1
QUIT
+18 SET DELIM=" "
if $GET(DEF)=""
SET DELIM=""
+19 SET DEF=DEF_DELIM_$PIECE(^DIC(20.11,+Y,0),U,3)
+20 IF $LENGTH(DEF)>10
SET DEF=$$GET1^DIQ(200,DA_",",10.6)
WRITE !,"***** Entry too long. Try Again. *****",!,"Entry must be less than ten (10) characters."
QUIT
+21 IF $$COMP(DEF)
SET DEF=$$GET1^DIQ(200,DA_",",10.6)
WRITE !,"***** Entry contains duplicates. Try Again. *****",!
+22 NEW FDA,FDAERR
SET FDA(200,DA_",",10.6)=DEF
DO FILE^DIE("","FDA","FDAERR")
+23 IF '$DATA(FDAERR)
QUIT
+24 IF $DATA(FDAERR)
WRITE !,"Error in filing data. Please try again."
QUIT
End DoDot:1
if FLAG
QUIT
+25 QUIT
+26 ;
COMP(X) ;
+1 ; Compares input string to determine if it contains dups
+2 NEW FLAG,CNT,CNT1,CNT2,T1
SET FLAG=0
+3 SET CNT=$LENGTH(X," ")
+4 IF CNT=1
QUIT FLAG
+5 FOR CNT1=1:1:CNT-1
if '$DATA(X)
QUIT
SET T1=$PIECE(X," ",CNT1)
FOR CNT2=CNT1+1:1:CNT
IF T1=$PIECE(X," ",CNT2)
SET FLAG=1
+6 QUIT FLAG
+7 ;
PATM(X) ;
+1 NEW FLAG
SET FLAG=0
+2 IF X'?1.10U.4(1" "1.4U)
SET FLAG=1
+3 QUIT FLAG
+4 ;
