source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRC0B1.m@ 1005

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1PRC0B1 ;WISC/PLT-UTILITY ; 06/30/94 12:40 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 QUIT ; invalid entry
5 ;
6 ;prca=~1 file number;file root;file record id;field # of multiple for adding
7 ; ~2 subfile number;subfile root;subfile RI;field # of multiple for adding
8 ; ~3 ...
9 ;.x = .01 value or array of dic and X("DR") to input for other fields
10 ;.y = value returned; -1 no new entry added, ^1=ri,^2=.01 value,^3=1 for new if added
11ADD(X,Y,PRCA,DINUM) ;add new entry
12 N DD,DO,DIC,%,D0,DA,DI,DIE,DLAYGO,DQ,DR,A,B,C,I
13 S:PRCA'?.E1"~" PRCA=PRCA_"~" S A=$L(PRCA,"~")-1
14 I A>1 F B=1:1:A-1 S C=$P(PRCA,"~",B),DA(A-B)=$P(C,";",3) S:$P(C,";",4)]"" DIC("P")=$$DICP^PRC0B1(+C,$P(C,";",4))
15 S B=$P(PRCA,"~",A),DIC=$P(B,";",2) S:DIC=""&(A=1) DIC=+B
16 S DLAYGO=PRCA,DIC(0)="FIL"
17 S:$D(X(0)) DIC(0)=X(0) S:$D(X("DR")) DIC("DR")=X("DR") K X(0),X("DR")
18 D FILE^DICN
19 QUIT
20 ;
21 ;prca = ~1 file number(option);file root;file record id
22 ; ~2 subfile number(option);subfile root;subfile RI
23 ; ~...
24 ;.x = value return; 1 if deleted, 0 if not, -2 if lock fail
25DELETE(X,PRCA) ;delete entry
26 N %,DA,DIC,Y
27 N DIK,DIA,PRCLOCK,A,B,C
28 S:PRCA'?.E1"~" PRCA=PRCA_"~" S A=$L(PRCA,"~")-1,PRCLOCK=""
29 I A>1 F B=1:1:A-1 S C=$P(PRCA,"~",B),DA(A-B)=$P(C,";",3)
30 S B=$P(PRCA,"~",A),DIK=$P(B,";",2),DA=$P(B,";",3),PRCLOCK=DIK_DA_","
31 S X=3 D ICLOCK^PRC0B(PRCLOCK,.X) I 'X S X=-2 QUIT
32 D ^DIK,DCLOCK^PRC0B(PRCLOCK)
33 S X=1
34 QUIT
35 ;
36 ;A=global root (including cross reference) ending with ','
37 ;B=start value
38FIRST(A,B) ;$O-first node after B-value
39 N C
40 S @("C=$O("_A_"B))")
41 QUIT C
42 ;
43DICP(A,B) ;EF value=2nd piece of 0-node of the multiple field's dd entry
44 QUIT $S(A&B:$P($G(^DD(A,B,0)),"^",2),1:"")
45 ;
46 ;
47DICGL(A) ;EF value=global root ending with ',' for file # A.
48 QUIT $G(^DIC(A,0,"GL"))
49 ;
Note: See TracBrowser for help on using the repository browser.