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

XUSESIG3.m

Go to the documentation of this file.
  1. 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
  1. Q
  1. PNM ; Signature Block Printed Name & Title edit
  1. ;S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Enter Employee to edit: "
  1. ;D ^DIC Q:Y<1
  1. ;S DA=+Y
  1. N DIE S DIE=200,DR="20.2;20.3" D ^DIE
  1. Q
  1. ;
  1. DEG ; Old method
  1. N DIE
  1. S DIE=200,DR="10.6" D ^DIE
  1. Q
  1. ;
  1. DEGREE ; test input for DEGREE field
  1. N DEF,DIR,X,Y,I,FLAG
  1. S FLAG=0,DEF=$$GET1^DIQ(200,DA,10.6)
  1. F I=1:1 D Q:FLAG
  1. . W !!,$$GET1^DIQ(200,DA,.01),!
  1. . W !,"Current entry for DEGREE is: ",DEF
  1. . W !! S DIR("A")="(A)ppend/Enter or (R)eplace " S DIR(0)="F:O^1:1^I ""AaRr""'[X K X"
  1. . S DIR("?",1)="Enter ""A"" to create a new entry or to append an additional"
  1. . S DIR("?",2)="degree to the existing string. Enter ""R"" to start over and"
  1. . S DIR("?",3)="replace the entire contents of degree with a new value"
  1. . S DIR("?")="or ""R"" with no value to delete the contents of DEGREE."
  1. . D ^DIR
  1. . I $D(DIRUT) S FLAG=1 Q
  1. . I Y="R"!(Y="r") D
  1. . . S FDA(200,DA_",",10.6)="" D FILE^DIE("","FDA",) K DIR("B") S DEF=""
  1. . S DIR(0)="PO^20.11:EMOZ",DIR("A")="Enter degree mnemonic ",DIR("?")="Enter the type of degree using a mnemonic/acronym."
  1. . D ^DIR
  1. . I $D(DIRUT) S FLAG=1 Q
  1. . S DELIM=" " S:$G(DEF)="" DELIM=""
  1. . S DEF=DEF_DELIM_$P(^DIC(20.11,+Y,0),U,3)
  1. . 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
  1. . I $$COMP(DEF) S DEF=$$GET1^DIQ(200,DA_",",10.6) W !,"***** Entry contains duplicates. Try Again. *****",!
  1. . N FDA,FDAERR S FDA(200,DA_",",10.6)=DEF D FILE^DIE("","FDA","FDAERR")
  1. . I '$D(FDAERR) Q
  1. . I $D(FDAERR) W !,"Error in filing data. Please try again." Q
  1. Q
  1. ;
  1. COMP(X) ;
  1. ; Compares input string to determine if it contains dups
  1. N FLAG,CNT,CNT1,CNT2,T1 S FLAG=0
  1. S CNT=$L(X," ")
  1. I CNT=1 Q FLAG
  1. 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
  1. Q FLAG
  1. ;
  1. PATM(X) ;
  1. N FLAG S FLAG=0
  1. I X'?1.10U.4(1" "1.4U) S FLAG=1
  1. Q FLAG
  1. ;