RTDPA32.m

RTDPA32 ;MJK/TROY ISC;Borrower File Lookup; ; 5/19/87  2:48 PM ;

 ;;v 2.0;Record Tracking;**16**;10/22/91 

BOR D EQUALS^RTUTL3 W !,"[",$P(RTMV0,"^")," OPTION]"

BOR1 S DIC="^RTV(195.9,",DIC(0)="IZDALEMQ",DIC("DR")="3////"_+RTAPL,DIC("S")="S Z0=^(0),Z=$P($P(Z0,U),"";"",2) I $P(Z0,U,3)="_+RTAPL_" D DICS1^RTDPA31",DIC("V")="S RTA="_+RTAPL_" D DICV^RTDPA31 K RTA",DIC("A")="Select Borrower: "

 D ^DIC K DIC Q:Y<0  S RTB=+Y,Y=0 D CHK:$D(^RTV(195.9,RTB,0)) I 'Y K RTB W *7 G BOR1

 D DR^RTDPA3 Q

 ;

DUPCHK ;Input Transform for Application field for file 195.9 (BORROWERS)

 Q:'$D(^RTV(195.9,"ABOR",$P(^RTV(195.9,DA,0),"^"),X))  Q:$O(^(X,0))=DA  K X Q:'$D(^RTV(195.9,+$O(^(0)),0))

 W !!,"This borrower is already in borrower file." D CHK K:'Y X Q

 ;

CHK ;The current naked reference must be the zeroth node of an entry

 ;in the BORROWERS/FILE AREAS file (#195.9)

 S Y=1 I $P(^(0),"^",10)="i" W !?5,"...borrower has been inactivated" S Y=0 Q

 I $P(^(0),"^",10)="r" W !?5,"...borrower's privileges have been revoked" S Y=0 Q

 I $D(^("KEY")),$P(^("KEY"),U)]"",'$D(^XUSEC($P(^("KEY"),U),DUZ)) W !?5,"...you do not have the necessary security privileges",!?8,"to choose this borrower!" S Y=0 Q

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RTDPA32   1201     printed  Apr 09, 2024@21:36:31                                                                                                                                                                                                     Page 2

RTDPA32   ;MJK/TROY ISC;Borrower File Lookup; ; 5/19/87  2:48 PM ;

 +1       ;;v 2.0;Record Tracking;**16**;10/22/91 

BOR        DO EQUALS^RTUTL3

           WRITE !,"[",$PIECE(RTMV0,"^")," OPTION]"

BOR1       SET DIC="^RTV(195.9,"

           SET DIC(0)="IZDALEMQ"

           SET DIC("DR")="3////"_+RTAPL

           SET DIC("S")="S Z0=^(0),Z=$P($P(Z0,U),"";"",2) I $P(Z0,U,3)="_+RTAPL_" D DICS1^RTDPA31"

           SET DIC("V")="S RTA="_+RTAPL_" D DICV^RTDPA31 K RTA"

           SET DIC("A")="Select Borrower: "

 +1        DO ^DIC

           KILL DIC

           if Y<0

               QUIT 

           SET RTB=+Y

           SET Y=0

           if $DATA(^RTV(195.9,RTB,0))

               DO CHK

           IF 'Y

               KILL RTB

               WRITE *7

               GOTO BOR1

 +2        DO DR^RTDPA3

           QUIT 

 +3       ;

DUPCHK    ;Input Transform for Application field for file 195.9 (BORROWERS)

 +1        if '$DATA(^RTV(195.9,"ABOR",$PIECE(^RTV(195.9,DA,0),"^"),X))

               QUIT 

           if $ORDER(^(X,0))=DA

               QUIT 

           KILL X

           if '$DATA(^RTV(195.9,+$ORDER(^(0)),0))

               QUIT 

 +2        WRITE !!,"This borrower is already in borrower file."

           DO CHK

           if 'Y

               KILL X

           QUIT 

 +3       ;

CHK       ;The current naked reference must be the zeroth node of an entry

 +1       ;in the BORROWERS/FILE AREAS file (#195.9)

 +2        SET Y=1

           IF $PIECE(^(0),"^",10)="i"

               WRITE !?5,"...borrower has been inactivated"

               SET Y=0

               QUIT 

 +3        IF $PIECE(^(0),"^",10)="r"

               WRITE !?5,"...borrower's privileges have been revoked"

               SET Y=0

               QUIT 

 +4        IF $DATA(^("KEY"))

               IF $PIECE(^("KEY"),U)]""

                   IF '$DATA(^XUSEC($PIECE(^("KEY"),U),DUZ))

                       WRITE !?5,"...you do not have the necessary security privileges",!?8,"to choose this borrower!"

                       SET Y=0

                       QUIT 

 +5        QUIT