- 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 Feb 19, 2025@00:00:26 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