source: WorldVistAEHR/trunk/r/LIBRARY-LBR-LBRS/LBRVCON3.m@ 648

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

initial load of WorldVistAEHR
File size: 3.0 KB
Line 
1LBRVCON3 ;SSI/ALA/KMB/JSR - STEPS 6 AND 7 [ 07/06/2000 3:35 PM ]
2 ;;2.5;Library;**3,8**;APR 19, 2000
3EN I '$D(^XTMP("LBRY",LBRVSTA,"ODA6","DONE")) D STP6 S ^XTMP("LBRY",LBRVSTA,"ODA6","DONE")=""
4 I '$D(^XTMP("LBRY",LBRVSTA,"ODA7","DONE")) D STP7 S ^XTMP("LBRY",LBRVSTA,"ODA7","DONE")=""
5 S ^XTMP("LBRY",LBRVSTA,"DONE")=$H
6 Q
7STP6 S ODA=$P(^XTMP("LBRY",LBRVSTA,"ODA6"),"^",1)
8 D MES^LBRPUTL("I am beginning Step 6....for "_LBRVSTA_" at "_$$HTE^XLFDT($H)_" please wait ")
9 F I="AC","B","C","D","E" K ^LBRY(681,I)
10 S $P(^LBRY(681,0),"^",3)=1,$P(^LBRY(682,0),"^",3)=1
11GDA6 S ODA=$O(^A7RLBRY(LBRVSTA,681,ODA)) Q:ODA'>0
12 S USR=$P($G(^A7RLBRY(LBRVSTA,681,ODA,1)),U,3)
13 I USR'="" D
14 . S USR=$$STRIP^XLFSTR(USR,"*")
15 . S USRN=$O(^VA(200,"B",USR,""))
16 . I USRN'="" S $P(^A7RLBRY(LBRVSTA,681,ODA,1),U,3)=USRN
17 S VND=$P($G(^A7RLBRY(LBRVSTA,681,ODA,1)),U,5)
18 I VND'="" D
19 . S VND=$$STRIP^XLFSTR(VND,"*") ; PER INTEGRATION TEAM REQUEST
20 . S VNDN=$O(^PRC(440,"B",VND,""))
21 . I VNDN'="" S $P(^A7RLBRY(LBRVSTA,681,ODA,1),U,5)=VND
22MNDA ; Get next available DA
23 S DINUM=$P(^LBRY(681,0),"^",3)
24MNDRET F S DINUM=DINUM+1 Q:'$D(^LBRY(681,DINUM,0))
25 S X=DINUM,DLAYGO=681,DIC(0)="L",DIC="^LBRY(681,"
26 D FILE^DICN S (DA,NDA)=+Y
27 I NDA=-1 S DINUM=X G MNDRET
28 S %X="^A7RLBRY(LBRVSTA,681,"_ODA_",",%Y="^LBRY(681,"_NDA_"," D %XY^%RCR
29 F I="AC","B" K ^LBRY(681,NDA,2,I)
30 S $P(^LBRY(681,NDA,2,0),"^",2)="681.02IPA"
31 S $P(^LBRY(681,NDA,0),U)=NDA
32 F S TDA=$O(^A7RLBRY(LBRVSTA,682,"ZC",ODA,TDA)) Q:TDA="" D
33 . S TDA1="" F S TDA1=$O(^A7RLBRY(LBRVSTA,682,"ZC",ODA,TDA,TDA1)) Q:TDA1="" D
34 .. S $P(^A7RLBRY(LBRVSTA,682,TDA,4,TDA1,0),U,3)=NDA
35 .. K ^A7RLBRY(LBRVSTA,682,"ZC",ODA,TDA,TDA1)
36 S $P(^XTMP("LBRY",LBRVSTA,"ODA6"),"^",1)=ODA G GDA6
37STP7 S ODA=$P(^XTMP("LBRY",LBRVSTA,"ODA7"),"^",1)
38 D MES^LBRPUTL("I am beginning Step 7....for "_LBRVSTA_" at "_$$HTE^XLFDT($H)_" please wait ")
39GDA7 S ODA=$O(^A7RLBRY(LBRVSTA,682,ODA)) Q:'ODA
40 S FLAG=""
41 S:ODA?.N FLAG="Y"
42 Q:FLAG=""
43 S USR=$P($G(^A7RLBRY(LBRVSTA,682,ODA,1)),U,6)
44 I USR'="" D
45 . S USR=$$STRIP^XLFSTR(USR,"*")
46 . Q:USR=""
47 . S USRN=$O(^VA(200,"B",USR,""))
48 . I USRN'="" S $P(^A7RLBRY(LBRVSTA,682,ODA,1),U,6)=USRN
49 S LDA=0 F S LDA=$O(^A7RLBRY(LBRVSTA,682,ODA,4,LDA)) Q:LDA'>0 D
50 . S USR=$P($G(^A7RLBRY(LBRVSTA,682,ODA,4,LDA,0)),U,4)
51 . ;Q:USR=""
52 . I USR'="" D
53 . . S USR=$$STRIP^XLFSTR(USR,"*")
54 . . Q:USR=""
55 . . S USRN=$O(^VA(200,"B",USR,""))
56 . . I USRN'="" S $P(^A7RLBRY(LBRVSTA,682,ODA,4,LDA,0),U,4)=USRN
57 . S USR=$P($G(^A7RLBRY(LBRVSTA,682,ODA,4,LDA,0)),U,8)
58 . I USR'="" D
59 . . S USR=$$STRIP^XLFSTR(USR,"*")
60 . . Q:USR=""
61 . . S USRN=$O(^VA(200,"B",USR,""))
62 . . I USRN'="" S $P(^A7RLBRY(LBRVSTA,682,ODA,4,LDA,0),U,8)=USRN
63NNDA ; Get next available DA
64 S DINUM=$P(^LBRY(682,0),"^",3)
65RET F S DINUM=DINUM+1 Q:'$D(^LBRY(682,DINUM,0))
66 S X=DINUM,DLAYGO=682,DIC(0)="L",DIC="^LBRY(682,"
67 D FILE^DICN S (DA,NDA)=+Y
68 I NDA=-1 S DINUM=X G RET
69 Q:'ODA
70 S %X="^A7RLBRY(LBRVSTA,682,"_ODA_",",%Y="^LBRY(682,"_NDA_"," D %XY^%RCR
71 K ^LBRY(682,NDA,4,"B")
72 S LBRYINT=1
73 S $P(^LBRY(682,NDA,0),U)=NDA D ^LBRYX33
74 S $P(^XTMP("LBRY",LBRVSTA,"ODA7"),"^",1)=ODA G GDA7
Note: See TracBrowser for help on using the repository browser.