| 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 | ; | 
|---|