| 1 | PRCPUXRE ;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 | ;
|
|---|
| 7 | XREFAX(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 | ;
|
|---|
| 25 | XREFASR(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
|
|---|
