| [613] | 1 | PRCUTL1 ;WISC/AKS-Utility to update file 410.1 ;5-11-92/08:04
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN1(X) ;X, THE TRANSACTION NUMBER ROOT, MUST BE IN THE FOLLOWING FORMATS:
|
|---|
| 5 | ; 1. 3N "-" 2N "-" 3.4N
|
|---|
| 6 | ; 2. 3N "-" 6AN
|
|---|
| 7 | ; 3. 3N "-FC"
|
|---|
| 8 | ; 4. 3N "-RQ"
|
|---|
| 9 | ; 5. 3N "-" 2N "-" N "-" 3.4N "-" 6N
|
|---|
| 10 | ; 6. 3N "-" 2N "-" N "-" 3.4N "-NONE"
|
|---|
| 11 | ;
|
|---|
| 12 | ;THIS ROUTINE WILL:
|
|---|
| 13 | ; 1. IF THE ROOT EXISTS THE COUNT FIELD WILL BE INCREMENTED AND
|
|---|
| 14 | ; THE NEW COUNT WILL BE CONCATINATED TO THE ROOT.
|
|---|
| 15 | ; 2. IF THE ROOT DOESN'T EXIST IT WILL BE ADDED AS A NEW RECORD
|
|---|
| 16 | ; AND COUNT WILL BE SET TO 1. THE COUNT WILL BE CONCATINATED
|
|---|
| 17 | ; TO THE ROOT.
|
|---|
| 18 | ; 3. IF THERE IS SOMETHING WRONG THE ROOT WILL BE SET TO "".
|
|---|
| 19 | ;THE CONCATINATED COUNT WILL BE 4N WITH LEADING ZEROS AS NEEDED.
|
|---|
| 20 | ;
|
|---|
| 21 | ;FOR ANY CHANGE TO COUNT (INCREMENTING IT OR SETTING IT TO 1) THE
|
|---|
| 22 | ;DATE FIELD WILL BE SET TO TODAY.
|
|---|
| 23 | ;
|
|---|
| 24 | N REPINO,Y,COUNT,CL1,DIC
|
|---|
| 25 | S REPINO=X
|
|---|
| 26 | 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
|
|---|
| 27 | I Y'>0 W !!,"'TRANSACTION NUMBER' file is corrupt.",!,"Duplicate enteries found for entry "_X S X="" Q
|
|---|
| 28 | S DIE="^PRCS(410.1,",DR="1///^S X=COUNT;2///TODAY" D ^DIE K DIE,DA,DR
|
|---|
| 29 | S COUNT="0000"_COUNT,CL1=$L(COUNT),COUNT=$E(COUNT,CL1-3,CL1),X=REPINO_"-"_COUNT
|
|---|
| 30 | QUIT
|
|---|
| 31 | EN2(X) ;THIS ENTRY POINT DOES THE SAME THING AS EN1 EXCEPT WITHOUT ANY LOCAL
|
|---|
| 32 | ;OUTPUT TO THE CRT.
|
|---|
| 33 | N REPINO,Y,COUNT,CL1,DIC
|
|---|
| 34 | S REPINO=X
|
|---|
| 35 | 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
|
|---|
| 36 | I Y'>0 S X="" Q
|
|---|
| 37 | S DIE="^PRCS(410.1,",DR="1///^S X=COUNT;2////^S X=DT" D ^DIE K DIE,DA,DR
|
|---|
| 38 | S COUNT="0000"_COUNT,CL1=$L(COUNT),COUNT=$E(COUNT,CL1-3,CL1),X=REPINO_"-"_COUNT
|
|---|
