source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPUXRE.m@ 1582

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

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1PRCPUXRE ;WISC/RFJ-xref for file 445.2 and 445.3 ;24 May 93
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7XREFAX(DA,X,FIELD,SETKILL) ; build xref for 445.2
8 ; da = internal entry number
9 ; x = value of data in field
10 ; field = field number for x
11 ; setkill = "SET" to set; "KILL" (or anything other than set) to kill
12 N %,DATE,INVPT,TYPETRAN
13 S %=$G(^PRCP(445.2,DA,0)) I %="" Q
14 S INVPT=+$P(%,"^"),TYPETRAN=$P(%,"^",4),DATE=+$P($P(%,"^",17),".")
15 D
16 . I FIELD=.01 S INVPT=X Q
17 . I FIELD=2.5 S DATE=X Q
18 . I FIELD=3 S TYPETRAN=X
19 I 'INVPT!(TYPETRAN="")!('DATE) Q
20 I SETKILL="SET" S ^PRCP(445.2,"AX",INVPT,DATE,TYPETRAN,DA)="" Q
21 K ^PRCP(445.2,"AX",INVPT,DATE,TYPETRAN,DA)
22 Q
23 ;
24 ;
25XREFASR(DA,X,FIELD,SETKILL) ; build xref for file 445.3
26 ; da = internal entry number
27 ; x = value of data in field
28 ; field = field number for x
29 ; setkill = "SET" to set; "KILL" (or anything other than set) to kill
30 N %,PATDA,SURGDA
31 S %=$G(^PRCP(445.3,DA,2)) I %="" Q
32 S PATDA=+$P(%,"^"),SURGDA=+$P(%,"^",2)
33 D
34 . I FIELD=129 S PATDA=X Q
35 . I FIELD=130 S SURGDA=X Q
36 I 'PATDA!('SURGDA) Q
37 I SETKILL="SET" S ^PRCP(445.3,"ASR",PATDA,SURGDA,DA)="" Q
38 K ^PRCP(445.3,"ASR",PATDA,SURGDA,DA)
39 Q
Note: See TracBrowser for help on using the repository browser.