[613] | 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 | ;
|
---|