39 lines
1.8 KiB
Mathematica
39 lines
1.8 KiB
Mathematica
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
|