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 ---[H[J[2J[HRTDPA32 1201 printed Oct 16, 2024@18:34:38 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
