source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRC5C1.m@ 1608

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1PRC5C1 ;WISC/PLT-PRC5C continue ; 10/13/94 9:13 AM
2V ;;5.0;IFCAP;**27**;4/21/95
3 QUIT ;invalid entry
4 ;
5EN(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 ;
18EN1 ;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 ;
26EN2 ;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
30EN3 ;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 ;
Note: See TracBrowser for help on using the repository browser.