1 | LBRYUTL ;SSI/ALA-UTILITY PROGRAM FOR LIBRARY PKG ;[ 09/08/98 2:45 PM ]
|
---|
2 | ;;2.5;Library;**2,6**;Mar 11, 1996
|
---|
3 | JDN(LBRFDATE) ; Create 7 digit Julian date from FileMan internal date
|
---|
4 | ; Requires LBRFDATE=FileMan internal date. Returns LBRJDATE as Julian day number
|
---|
5 | N LBRLDAY,LBRMDAYS,LBRMO,LBRYR,I,LBRDAYS,LBRJDATE
|
---|
6 | ; set default total # of days per month in ^-pieced string
|
---|
7 | S LBRMDAYS="31^28^31^30^31^30^31^31^30^31^30^31"
|
---|
8 | ; extract FMan 3 digit year and convert to Julian 4 digit year
|
---|
9 | S LBRYR=$E(LBRFDATE,1,3)+1700
|
---|
10 | ; extract month and day from FMan date
|
---|
11 | S LBRMO=$E(LBRFDATE,4,5)
|
---|
12 | S LBRLDAY=$E(LBRFDATE,6,7)
|
---|
13 | ; check for leap years & centuries and change days per month string
|
---|
14 | I (((LBRYR#4=0)&(LBRYR#100'=0))!((LBRYR#100=0)&(LBRYR#400=0))) S $P(LBRMDAYS,U,2)=29
|
---|
15 | S LBRDAYS=0
|
---|
16 | ; sum up the days since Jan 1 to the current month
|
---|
17 | I LBRMO'=1 S LBRDAYS=0 F I=1:1:LBRMO-1 S LBRDAYS=LBRDAYS+$P(LBRMDAYS,U,I)
|
---|
18 | ; add the sum to the date of the current month
|
---|
19 | ; to obtain the total number of days since Jan 1
|
---|
20 | ; then create a Julian date year+days since Jan 1
|
---|
21 | ;Insert placeholder 0's as nessecary
|
---|
22 | I ((LBRDAYS+LBRLDAY)<10) Q (LBRYR_"00"_(LBRDAYS+LBRLDAY))
|
---|
23 | I ((LBRDAYS+LBRLDAY)<100) Q (LBRYR_"0"_(LBRDAYS+LBRLDAY))
|
---|
24 | Q (LBRYR_(LBRDAYS+LBRLDAY))
|
---|
25 | RJD(LBRJDATE) ; Create FileMan internal date from 7 digit Julian date
|
---|
26 | ; Requires LBRJDATE=Year_Number of days from begin of year
|
---|
27 | N LBRMDAYS,LDY,I,LBRNLDY,LBRFDATE,LBRYR
|
---|
28 | ; extract 4 digit Julian year
|
---|
29 | S LBRYR=$E(LBRJDATE,1,4)
|
---|
30 | ; set default total # of days per month in ^-pieced string
|
---|
31 | S LBRMDAYS="31^28^31^30^31^30^31^31^30^31^30^31"
|
---|
32 | ; check for leap years & centuries and change days per month string
|
---|
33 | I (((LBRYR#4=0)&(LBRYR#100'=0))!((LBRYR#100=0)&(LBRYR#400=0))) S $P(LBRMDAYS,U,2)=29
|
---|
34 | ; convert 4 digit Julian year to 3 digit FMan year
|
---|
35 | S LBRYR=LBRYR-1700
|
---|
36 | ; calculate the month from total number of days
|
---|
37 | ; keep subtracting until <0
|
---|
38 | S LBRNLDY=$E(LBRJDATE,5,7) F I=1:1:12 S LBRNLDY=(LBRNLDY-$P(LBRMDAYS,U,I)) Q:LBRNLDY<0
|
---|
39 | ; to obtain the day of month, add back last months day total
|
---|
40 | S LBRNLDY=LBRNLDY+$P(LBRMDAYS,U,I)
|
---|
41 | S LBRMO=I
|
---|
42 | ; calculate if '0' placeholders are necessary 29811 -> 2980101
|
---|
43 | I LBRNLDY=0 S LBRNLDY=$P(LBRMDAYS,U,LBRMO-1),LBRMO=LBRMO-1
|
---|
44 | I LBRMO<10 S LBRFDATE=LBRYR_"0"_LBRMO
|
---|
45 | I (LBRMO'<10) S LBRFDATE=LBRYR_LBRMO
|
---|
46 | I LBRNLDY<10 S LBRFDATE=LBRFDATE_"0"_LBRNLDY
|
---|
47 | I (LBRNLDY'<10) S LBRFDATE=LBRFDATE_LBRNLDY
|
---|
48 | Q LBRFDATE
|
---|
49 | TRN ; Get next transaction number for transaction file local site
|
---|
50 | S DIC(0)="L",DLAYGO=682.1,DIC="^LBRY(682.1,"
|
---|
51 | L ^LBRY(682.1,0):5 I '$T G TRN
|
---|
52 | S DINUM=+$P(^LBRY(682.1,0),U,3) F I=1:1 S DINUM=DINUM+I Q:'$D(^LBRY(682.1,DINUM,0))
|
---|
53 | L
|
---|
54 | S X=DINUM D FILE^DICN S LBRYDA=+Y K X,Y,DLAYGO
|
---|
55 | S DA=LBRYDA,DIC="^LBRY(682.1,",DIE=DIC
|
---|
56 | S DR=$S($G(SRVFLG)=1:"[LBRYLTF]",1:"[LBRYREC]") D ^DIE
|
---|
57 | I $G(SRVFLG)=1 S $P(^LBRY(682.1,LBRYDA,1),U,2)=LBRYCLS
|
---|
58 | K DINUM,DA,SRVFLG Q
|
---|
59 | FTRN ; Get next transaction number for transaction file in FORUM
|
---|
60 | S DIC(0)="L",DLAYGO=682.1,DIC="^LBRY(682.1,"
|
---|
61 | L ^LBRY(682.1,0):5 I '$T G FTRN
|
---|
62 | S DINUM=+$P(^LBRY(682.1,0),U,3) F I=1:1 S DINUM=DINUM+I Q:'$D(^LBRY(682.1,DINUM,0))
|
---|
63 | L
|
---|
64 | S X=DINUM D FILE^DICN S LBRYDA=+Y K X,Y,DLAYGO
|
---|
65 | S DA=LBRYDA,DIC="^LBRY(682.1,",DIE=DIC
|
---|
66 | S DR=$S($G(SRVFLG)=1:"[LBRYRECV]",1:"[LBRYSND]") D ^DIE
|
---|
67 | S $P(^LBRY(682.1,LBRYDA,1),U,2)=$G(LBRYCLS)
|
---|
68 | S $P(^LBRY(682.1,LBRYDA,0),U,7)=$G(STN)
|
---|
69 | K DINUM,SRVFLG,DA
|
---|
70 | Q
|
---|
71 | PAUSE W !,XZ S DTOUT=0 R X:DTIME E W $C(7) S DTOUT=1 Q
|
---|
72 | Q:X="" Q:X="^" W !,"Enter carriage return to ",XZ
|
---|
73 | G PAUSE
|
---|