- PRPFSITE ;ALTOONA/CTB RETURNS VARIABLES PRPF("QTR"), PRPF("SITE"),PRPF("FY") ;11/22/96 4:45 PM [ 02/13/97 9:46 PM ]
- V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
- D DUZ Q:'%
- I '$D(^PRPFT(470.5,0)) S ^PRPFT(470.5,0)="PATIENT FUNDS TEMPORARY TRANSACTION^470.5"
- I '$D(DT) D NOW^PRPFQ S DT=X
- OUT S %=1 Q
- ;
- A ;CREATE SIGNATURE BLOCK NAME
- 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
- DUZ ;LOOKUP AND SET PRPF("PER")=PERSON FILE IRN
- 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")
- I '$D(PRPF("PER")) S %=0 W:'$D(%INT) !,*7,"YOU ARE NOT IN THE 'PERSON' FILE. CONTACT YOUR SITE MANAGER",! K %INT Q
- I '$D(^VA(200,PRPF("PER"),20)) D A K %INT Q
- 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
- S PRPF("NAME")=$P(^VA(200,PRPF("PER"),20),"^",2) K %INT Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRPFSITE 995 printed Mar 13, 2025@21:06:50 Page 2
- PRPFSITE ;ALTOONA/CTB RETURNS VARIABLES PRPF("QTR"), PRPF("SITE"),PRPF("FY") ;11/22/96 4:45 PM [ 02/13/97 9:46 PM ]
- V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
- +1 DO DUZ
- if '%
- QUIT
- +2 IF '$DATA(^PRPFT(470.5,0))
- SET ^PRPFT(470.5,0)="PATIENT FUNDS TEMPORARY TRANSACTION^470.5"
- +3 IF '$DATA(DT)
- DO NOW^PRPFQ
- SET DT=X
- OUT SET %=1
- QUIT
- +1 ;
- A ;CREATE SIGNATURE BLOCK NAME
- +1 SET %X=$PIECE(^VA(200,PRPF("PER"),0),"^")
- SET %X=$PIECE(%X,",",2)_" "_$PIECE(%X,",")_$PIECE(%X,",",3)
- SET $PIECE(^VA(200,PRPF("PER"),20),"^",2)=%X
- KILL %X
- QUIT
- DUZ ;LOOKUP AND SET PRPF("PER")=PERSON FILE IRN
- +1 SET %=1
- IF $DATA(DUZ)#2
- IF +DUZ>0
- IF $DATA(^VA(200,DUZ,0))
- SET PRPF("PER")=DUZ
- IF '$DATA(^VA(200,PRPF("PER"),0))
- KILL PRPF("PER")
- +2 IF '$DATA(PRPF("PER"))
- SET %=0
- if '$DATA(%INT)
- WRITE !,*7,"YOU ARE NOT IN THE 'PERSON' FILE. CONTACT YOUR SITE MANAGER",!
- KILL %INT
- QUIT
- +3 IF '$DATA(^VA(200,PRPF("PER"),20))
- DO A
- KILL %INT
- QUIT
- +4 IF $PIECE(^VA(200,PRPF("PER"),20),"^",2)=""
- SET %X=$PIECE(^VA(200,PRPF("PER"),0),"^")
- SET %X=$PIECE(%X,",",2)_" "_$PIECE(%X,",")_$PIECE(%X,",",3)
- SET $PIECE(^(20),"^",2)=%X
- KILL %X
- +5 SET PRPF("NAME")=$PIECE(^VA(200,PRPF("PER"),20),"^",2)
- KILL %INT
- QUIT
