source: FOIAVistA/tag/r/LIBRARY-LBR-LBRS/LBRYUTL.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.4 KB
Line 
1LBRYUTL ;SSI/ALA-UTILITY PROGRAM FOR LIBRARY PKG ;[ 09/08/98 2:45 PM ]
2 ;;2.5;Library;**2,6**;Mar 11, 1996
3JDN(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))
25RJD(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
49TRN ; 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
59FTRN ; 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
71PAUSE 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
Note: See TracBrowser for help on using the repository browser.