1 | PRC5C1 ;WISC/PLT-PRC5C continue ; 10/13/94 9:13 AM
|
---|
2 | V ;;5.0;IFCAP;**27**;4/21/95
|
---|
3 | QUIT ;invalid entry
|
---|
4 | ;
|
---|
5 | EN(PRCZ) ;PRCZ='FND', 'PCL', 'PAC' OR 'CPF'
|
---|
6 | N PRCRI,PRCA,PRCB,A
|
---|
7 | S PRCRI(420.92)=0,PRCERR=""
|
---|
8 | F S PRCRI(420.92)=$O(^PRCU(420.92,"B",PRCZ,PRCRI(420.92))) Q:'PRCRI(420.92) D
|
---|
9 | . S PRCA=^PRCU(420.92,PRCRI(420.92),0)
|
---|
10 | . QUIT:$P(PRCA,"^",7)=""
|
---|
11 | . S PRCA($P(PRCA,"^",7))=$P(PRCA,"^",4)
|
---|
12 | . S:$G(PRCB)="" PRCB=$P($P(PRCA,"^",7),"-",2)
|
---|
13 | . QUIT
|
---|
14 | S:$G(PRCB)="" PRCB=1
|
---|
15 | F A=1:1:PRCB S PRCA=A_"-"_PRCB S:$G(PRCA(PRCA))="" PRCERR=1
|
---|
16 | QUIT
|
---|
17 | ;
|
---|
18 | EN1 ;check prelode distributed standard dictionaty (prc*4*28 installation)
|
---|
19 | N A
|
---|
20 | S PRCERR=""
|
---|
21 | F A=420.13,420.131:.001:420.138 I '$D(^PRCD(A,0)) S PRCERR=1 QUIT
|
---|
22 | I 'PRCERR F A=420.14:.01:420.19 I '$D(^PRCD(A,0)) S PRCERR=1 QUIT
|
---|
23 | I 'PRCERR F A=420.1999 I '$D(^PRCD(A,0)) S PRCERR=1 QUIT
|
---|
24 | QUIT
|
---|
25 | ;
|
---|
26 | EN2 ;check fms security code in file 411
|
---|
27 | N PRCRI
|
---|
28 | S PRCRI(411)=0 F S PRCRI(411)=$O(^PRC(411,PRCRI(411))) QUIT:PRCRI(411)>999999!'PRCRI(411) I '$P($G(^(PRCRI(411),9)),"^",2) S PRCERR=1 QUIT
|
---|
29 | QUIT
|
---|
30 | EN3 ;REINDEX FILE 420 SPECIAL CONTROL POINT "AD"
|
---|
31 | D EN^DDIOL("REINDEX SPECIAL CONTROL POINT INDEX 'AD' STARTS AT "_$$NOW^PRC5A)
|
---|
32 | N PRCRI
|
---|
33 | S PRCRI(420)=0
|
---|
34 | F S PRCRI(420)=$O(^PRC(420,PRCRI(420))) Q:'PRCRI(420) D
|
---|
35 | . S PRCRI(420.01)=0
|
---|
36 | . F S PRCRI(420.01)=$O(^PRC(420,PRCRI(420),1,PRCRI(420.01))) Q:'PRCRI(420.01) D:$P($G(^(PRCRI(420.01),0)),"^",12)
|
---|
37 | .. N DIK,DA
|
---|
38 | .. S DIK="^PRC(420,"_PRCRI(420)_",1,",DIK(1)="13^AD"
|
---|
39 | .. S DA(1)=PRCRI(420),DA=PRCRI(420.01)
|
---|
40 | .. D EN^DIK
|
---|
41 | .. QUIT
|
---|
42 | . QUIT
|
---|
43 | D EN^DDIOL("REINDEX SPECIAL CONTROL POINT INDEX 'AD' ENDS AT "_$$NOW^PRC5A)
|
---|
44 | QUIT
|
---|
45 | ;
|
---|