| 1 | PRPFSITE ;ALTOONA/CTB RETURNS VARIABLES PRPF("QTR"), PRPF("SITE"),PRPF("FY") ;11/22/96 4:45 PM [ 02/13/97 9:46 PM ]
|
|---|
| 2 | V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
|
|---|
| 3 | D DUZ Q:'%
|
|---|
| 4 | I '$D(^PRPFT(470.5,0)) S ^PRPFT(470.5,0)="PATIENT FUNDS TEMPORARY TRANSACTION^470.5"
|
|---|
| 5 | I '$D(DT) D NOW^PRPFQ S DT=X
|
|---|
| 6 | OUT S %=1 Q
|
|---|
| 7 | ;
|
|---|
| 8 | A ;CREATE SIGNATURE BLOCK NAME
|
|---|
| 9 | S %X=$P(^VA(200,PRPF("PER"),0),"^"),%X=$P(%X,",",2)_" "_$P(%X,",")_$P(%X,",",3),$P(^VA(200,PRPF("PER"),20),"^",2)=%X K %X Q
|
|---|
| 10 | DUZ ;LOOKUP AND SET PRPF("PER")=PERSON FILE IRN
|
|---|
| 11 | S %=1 I $D(DUZ)#2,+DUZ>0,$D(^VA(200,DUZ,0)) S PRPF("PER")=DUZ I '$D(^VA(200,PRPF("PER"),0)) K PRPF("PER")
|
|---|
| 12 | I '$D(PRPF("PER")) S %=0 W:'$D(%INT) !,*7,"YOU ARE NOT IN THE 'PERSON' FILE. CONTACT YOUR SITE MANAGER",! K %INT Q
|
|---|
| 13 | I '$D(^VA(200,PRPF("PER"),20)) D A K %INT Q
|
|---|
| 14 | I $P(^VA(200,PRPF("PER"),20),"^",2)="" S %X=$P(^VA(200,PRPF("PER"),0),"^"),%X=$P(%X,",",2)_" "_$P(%X,",")_$P(%X,",",3),$P(^(20),"^",2)=%X K %X
|
|---|
| 15 | S PRPF("NAME")=$P(^VA(200,PRPF("PER"),20),"^",2) K %INT Q
|
|---|
