PRCUTL1 ;WISC/AKS-Utility to update file 410.1 ;5-11-92/08:04
 ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
EN1(X) ;X, THE TRANSACTION NUMBER ROOT, MUST BE IN THE FOLLOWING FORMATS:
 ;  1.   3N "-" 2N "-" 3.4N
 ;  2.   3N "-" 6AN
 ;  3.   3N "-FC"
 ;  4.   3N "-RQ"
 ;  5.   3N "-" 2N "-" N "-" 3.4N "-" 6N
 ;  6.   3N "-" 2N "-" N "-" 3.4N "-NONE"
 ;
 ;THIS ROUTINE WILL:
 ;  1.   IF THE ROOT EXISTS THE COUNT FIELD WILL BE INCREMENTED AND
 ;       THE NEW COUNT WILL BE CONCATINATED TO THE ROOT.
 ;  2.   IF THE ROOT DOESN'T EXIST IT WILL BE ADDED AS A NEW RECORD
 ;       AND COUNT WILL BE SET TO 1.  THE COUNT WILL BE CONCATINATED
 ;       TO THE ROOT.
 ;  3.   IF THERE IS SOMETHING WRONG THE ROOT WILL BE SET TO "".
 ;THE CONCATINATED COUNT WILL BE 4N WITH LEADING ZEROS AS NEEDED.
 ;
 ;FOR ANY CHANGE TO COUNT (INCREMENTING IT OR SETTING IT TO 1) THE
 ;DATE FIELD WILL BE SET TO TODAY.
 ;
 N REPINO,Y,COUNT,CL1,DIC
 S REPINO=X
 K DR S DIC="^PRCS(410.1,",DIC(0)="LZ",DLAYGO=410.1 D ^DIC K DIC,DLAYGO I Y>0 S COUNT=$S($P(Y,"^",3):1,1:$P(Y(0),"^",2)+1),DA=+Y
 I Y'>0 W !!,"'TRANSACTION NUMBER' file is corrupt.",!,"Duplicate enteries found for entry "_X S X="" Q
 S DIE="^PRCS(410.1,",DR="1///^S X=COUNT;2///TODAY" D ^DIE K DIE,DA,DR
 S COUNT="0000"_COUNT,CL1=$L(COUNT),COUNT=$E(COUNT,CL1-3,CL1),X=REPINO_"-"_COUNT
 QUIT
EN2(X) ;THIS ENTRY POINT DOES THE SAME THING AS EN1 EXCEPT WITHOUT ANY LOCAL
 ;OUTPUT TO THE CRT.
 N REPINO,Y,COUNT,CL1,DIC
 S REPINO=X
 K DR S DIC="^PRCS(410.1,",DIC(0)="LZ",DLAYGO=410.1 D ^DIC K DIC,DLAYGO I Y>0 S COUNT=$S($P(Y,"^",3):1,1:$P(Y(0),"^",2)+1),DA=+Y
 I Y'>0 S X="" Q
 S DIE="^PRCS(410.1,",DR="1///^S X=COUNT;2////^S X=DT" D ^DIE K DIE,DA,DR
 S COUNT="0000"_COUNT,CL1=$L(COUNT),COUNT=$E(COUNT,CL1-3,CL1),X=REPINO_"-"_COUNT