PRPFSITE.m

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 ---PRPFSITE   995     printed  Apr 09, 2024@21:04:30                                                                                                                                                                                                     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