source: WorldVistAEHR/trunk/r/LIBRARY-LBR-LBRS/LBR25P9V.m@ 1604

Last change on this file since 1604 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1LBR25P9V ;ALB/MRY - Patch #9 Old 440 vendor conversion ;[08/30/02 14:38 pm ]
2 ;;2.5;Library;**9**.Mar 11, 1996
3 ;
4 ; This routine will assist sites in converting their pre CoreFLS
5 ; vendor names over to the new CoreFLS vendor fields. Its purpose
6 ; is to pull a list of old vendor names from the free text vendor
7 ; (440) file, allow the user to assign a CoreFLS equivalient from
8 ; local (CoreFLS) vendor (392.31) file. Once the temporary file
9 ; is built, populating the entries will place the values in the CoreFLS
10 ; fields. Review the documentation found in patch LBR*2.5*9. The
11 ; temporary file is only retained for 90 days. All tasks are intended
12 ; to be completed within the 90 day timeframe.
13 ;
14 N LBRSTOP D INTRO I $G(LBRSTOP) Q
15 ;
16TOP S OPT=$$ASK
17 I OPT="P" S %=$$PULL
18 I OPT="A" S %=$$ASSOC
19 I OPT="C" S %=$$POP
20 I OPT="L" S %=$$LIST
21 I OPT="Q" G TOP
22 G END
23ASK() ;
24 N DIR,Y,DIRUT
25 S DIR(0)="SOM^P:PULL LIST OF OLD LIBRARY (440) VENDORS;L:DISPLAY PULL LIST;A:ASSOCIATE OLD LIBRARY (440) VENDORS TO COREFLS VENDORS;C:POPULATE COREFLS VENDOR FIELDS;Q:QUIT"
26 S DIR("?",1)=" Enter 'P' to generate a list of 440 vendors entered in the Library files."
27 S DIR("?",2)=" Enter 'L' to Display Pull List."
28 S DIR("?",3)=" Enter 'A' to associate a 440 Vendor name to a CoreFLS Vendor name."
29 S DIR("?",4)=" Enter 'C' to populate to CoreFLS Vendor fields."
30 S DIR("?",5)=" Enter 'Q' to quit."
31 D ^DIR K DIR I $D(DIRUT)!'$D(Y) Q -1
32 Q Y
33 ;
34INTRO ;
35 N X
36 S X="CSLVQ" X ^%ZOSF("TEST") I '$T D S LBRSTOP=1 Q
37 . W !,"** COMMUNICATIONS SERVICE LIBRARY (CSL) PACKAGE NOT INSTALLED **"
38 Q
39 ;
40PULL() ;
41 N LBRIEN,X
42 I $D(^XTMP("LBR25P9")) W !!,"^XTMP('LBR25P9') already pulled!" Q 1
43 S ^XTMP("LBR25P9",0)=$$FMADD^XLFDT(DT,90)_"^"_DT
44 W !!,"Looking through ^LBRY(680)..."
45 S LBRIEN=0 F S LBRIEN=$O(^LBRY(680,LBRIEN)) Q:'LBRIEN D
46 . S X=$P($G(^LBRY(680,LBRIEN,2)),"^",5)
47 . I X'="" S ^XTMP("LBR25P9",1,X)="",^(X,680,LBRIEN)=""
48 W !,"Looking through ^LBRY(681)..."
49 S LBRIEN=0 F S LBRIEN=$O(^LBRY(681,LBRIEN)) Q:'LBRIEN D
50 . S X=$P($G(^LBRY(681,LBRIEN,1)),"^",5)
51 . I X'="" S ^XTMP("LBR25P9",1,X)="",^(X,681,LBRIEN)=""
52 Q 1
53 ;
54ASSOC() ;
55 N LBR440,DTOUT,DUOUT,ANS,LBRNEW,DIC,X
56 I '$D(^XTMP("LBR25P9")) W !!,"Pull List not created!" Q 1
57 S LBR440=0 F S LBR440=$O(^XTMP("LBR25P9",1,LBR440)) Q:LBR440="" D AS1 Q:$D(DTOUT)!$D(DUOUT)!(ANS=-1)
58 Q 1
59AS1 W !!,"OLD VENDOR (440) NAME: ",LBR440
60 S (LBRNEW,ANS)=0 I ^XTMP("LBR25P9",1,LBR440)="" D Q:$D(DTOUT)!($D(DUOUT))
61 . S DIC="^DGBT(392.31,",DIC(0)="QEAMZ"
62 . D ^DIC Q:$D(DTOUT)!$D(DUOUT)!(Y=-1)
63 . S ^XTMP("LBR25P9",1,LBR440)=Y(0,0)_"^"_+Y,LBRNEW=1
64 S X=^XTMP("LBR25P9",1,LBR440)
65 W:LBRNEW !,"OLD VENDOR (440) NAME: ",LBR440
66 W !,"NEW COREFLS VENDOR NAME: ",$P(X,"^")
67 I X'="" S ANS=$$ACCEPT Q:ANS=-1 I 'ANS S ^XTMP("LBR25P9",1,LBR440)="" G AS1
68 Q
69ACCEPT() ;
70 N DIR,ACCEPT,Y,DTOUT,DUOUT
71 S DIR(0)="SB^A:ACCEPT;R:REMOVE",DIR("A")="ACCEPT, OR REMOVE?",DIR("B")="A"
72 D ^DIR S ACCEPT=$S(Y="A":1,$D(DUOUT)!($D(DTOUT)):-1,1:0)
73 Q ACCEPT
74 ;
75POP() ;
76 I '$D(^XTMP("LBR25P9")) W !!,"Pull List not created!" Q
77 W !!,"Adding CoreFLS Vendor names to ^LBRY(680), and ^LBRY(681)..."
78 S LBR440=0
79 F S LBR440=$O(^XTMP("LBR25P9",1,LBR440)) Q:LBR440="" S X=^XTMP("LBR25P9",1,LBR440) I X'="" D
80 . S FLSNAM=$P(X,"^"),FLSIEN=$P(X,"^",2)
81 . I $P($G(^DGBT(392.31,FLSIEN,0)),"^")'=FLSNAM Q
82 . S LBRFILE="" F S LBRFILE=$O(^XTMP("LBR25P9",1,LBR440,LBRFILE)) Q:'LBRFILE D
83 . . S LBRIEN="" F S LBRIEN=$O(^XTMP("LBR25P9",1,LBR440,LBRFILE,LBRIEN)) Q:'LBRIEN D
84 . . . S LBRIENS=LBRIEN_"," K FDATA
85 . . . I LBRFILE=680 S FDATA(680,LBRIENS,2.6)=FLSIEN
86 . . . I LBRFILE=681 S FDATA(681,LBRIENS,3.01)=FLSIEN
87 . . . I $D(FDATA) D FILE^DIE("","FDATA","ERROR")
88 Q 1
89 ;
90LIST() ;
91 I '$D(^XTMP("LBR25P9")) W !!,"Pull List not created!" Q 1
92 N %ZIS,ZTRN,ZTDESC
93 S %ZIS="QM" D ^%ZIS G:POP END
94 I $D(IO("Q")) S ZTRTN="PRINT^LBR25P9V",ZTDESC="LBR25P9V VENDOR LIST" D ^%ZTLOAD
95 K ZTSK,IO("Q") D HOME^%ZIS
96 U IO
97 ;
98PRINT ;
99 N PAG,HDR,HDR1,HDR2,LBR440,FLSDATA,FLSNAM,DIRUT
100 S PAG=0,HDR="OLD VENDORS (440) AND CORRESPONDING CoreFLS VENDORS LIST"
101 S HDR1="OLD VENDOR NAME",HDR2="NEW CoreFLS VENDOR NAME"
102 S LBR440="" F S LBR440=$O(^XTMP("LBR25P9",1,LBR440)) Q:LBR440="" D Q:$D(DIRUT)
103 . S FLSNAM=$P(^XTMP("LBR25P9",1,LBR440),"^")
104 . D PLINE
105 Q 1
106 ;
107PLINE ;
108 I PAG=0 D HDR
109 W !,$E(LBR440,1,35),?40,$E(FLSNAM,1,35)
110 D CHKL Q
111 ;
112HDR ;
113 W:$E(IOST,1,2)["C-"!(PAG>0) @IOF S PAG=PAG+1
114 W !,?(IOM-$L(HDR)/2),HDR,?(IOM-10),"PAGE ",PAG
115 W !!,HDR1,?40,HDR2
116 W !,$TR($J("",IOM)," ","-")
117 Q
118 ;
119CHKL ;
120 I IOSL<($Y+5),$E(IOST,1,2)="C-" D PAUSE^VALM1 Q:$D(DIRUT) W @IOF D HDR Q
121 I $E(IOST,1,2)'="C",IOSL<($Y+5) D HDR
122 Q
123 ;
124END ;
125 I $D(ZTQUEUED) S ZTREQ="@" Q
126 D ^%ZISC Q
127 Q
Note: See TracBrowser for help on using the repository browser.