Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRC5C1

PRC5C1.m

Go to the documentation of this file.
PRC5C1 ;WISC/PLT-PRC5C continue ; 10/13/94  9:13 AM
V ;;5.0;IFCAP;**27**;4/21/95
 QUIT  ;invalid entry 
 ;
EN(PRCZ) ;PRCZ='FND', 'PCL', 'PAC' OR 'CPF'
 N PRCRI,PRCA,PRCB,A
 S PRCRI(420.92)=0,PRCERR=""
 F  S PRCRI(420.92)=$O(^PRCU(420.92,"B",PRCZ,PRCRI(420.92))) Q:'PRCRI(420.92)  D
 . S PRCA=^PRCU(420.92,PRCRI(420.92),0)
 . QUIT:$P(PRCA,"^",7)=""
 . S PRCA($P(PRCA,"^",7))=$P(PRCA,"^",4)
 . S:$G(PRCB)="" PRCB=$P($P(PRCA,"^",7),"-",2)
 . QUIT
 S:$G(PRCB)="" PRCB=1
 F A=1:1:PRCB S PRCA=A_"-"_PRCB S:$G(PRCA(PRCA))="" PRCERR=1
 QUIT
 ;
EN1 ;check prelode distributed standard dictionaty (prc*4*28 installation)
 N A
 S PRCERR=""
 F A=420.13,420.131:.001:420.138 I '$D(^PRCD(A,0)) S PRCERR=1 QUIT
 I 'PRCERR F A=420.14:.01:420.19 I '$D(^PRCD(A,0)) S PRCERR=1 QUIT
 I 'PRCERR F A=420.1999 I '$D(^PRCD(A,0)) S PRCERR=1 QUIT
 QUIT
 ;
EN2 ;check fms security code in file 411
 N PRCRI
 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
 QUIT
EN3 ;REINDEX FILE 420 SPECIAL CONTROL POINT "AD"
 D EN^DDIOL("REINDEX SPECIAL CONTROL POINT INDEX 'AD' STARTS AT "_$$NOW^PRC5A)
 N PRCRI
 S PRCRI(420)=0
 F  S PRCRI(420)=$O(^PRC(420,PRCRI(420))) Q:'PRCRI(420)  D
 . S PRCRI(420.01)=0
 . 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)
 .. N DIK,DA
 .. S DIK="^PRC(420,"_PRCRI(420)_",1,",DIK(1)="13^AD"
 .. S DA(1)=PRCRI(420),DA=PRCRI(420.01)
 .. D EN^DIK
 .. QUIT
 . QUIT
 D EN^DDIOL("REINDEX SPECIAL CONTROL POINT INDEX 'AD' ENDS AT "_$$NOW^PRC5A)
 QUIT
 ;