RTDPA3 ;TROY ISC/MJK-Borrower File Look-up ; 5/19/87 11:23 AM ; 1/30/03 8:35am
;;2.0;Record Tracking;**21,33**;10/22/91
S DIC("S")="D DICS^RTDPA31",DIC("V")="D DICV^RTDPA31",DIC("DR")="3////"_RTA,DIC="^RTV(195.9," D ^DIC K DIC,RTB S:Y>0 RTB=$P(Y,"^",2) Q
;
CHK S RTA=+RTAPL,RTB=+Y_";SC(",Y=+$O(^RTV(195.9,"ABOR",RTB,RTA,0)) D SET:'Y K RTA,RTB Q
;
SET S I=$P(^RTV(195.9,0),"^",3)
LOCK S I=I+1 L +^RTV(195.9,I):1 I '$T!$D(^RTV(195.9,I)) L -^RTV(195.9,I) G LOCK
S ^RTV(195.9,I,0)=RTB_"^^"_RTA,^RTV(195.9,"B",RTB,I)="",^(0)=$P(^RTV(195.9,0),"^",1,2)_"^"_I_"^"_($P(^(0),"^",4)+1),^DISV($S($D(DUZ)'[0:DUZ,1:0),"^RTV(195.9,")=I,^RTV(195.9,"ABOR",RTB,RTA,I)=""
I RTB[";SC(" S X=^RTV(195.9,I,0),$P(X,"^",2)=+RTB,$P(X,"^",13)=$P(^SC(+RTB,0),"^",3),$P(X,"^",8,9)=$S($D(^(99)):$P(^(99),"^"),1:"")_"^"_$P(^(0),"^",11),$P(X,"^",7)=$E($P(X,"^",8),1,10)_"/"_$E($P(X,"^",9),1,10),^RTV(195.9,I,0)=X
LOCKQ L -^RTV(195.9,I) S Y=I Q
;
ATT S Y=0 Q:$S('$D(RTB):1,'$D(^RTV(195.9,+RTB,0)):1,1:0) S:$D(X)#2 RTZ("X")=X S X=^(0) I @("'$D(^"_$P($P(X,"^"),";",2)_"0))") G ATTQ
;naked reference to the borrower entry set by @(^$D(^ in tag att
S F=+$P(^(0),"^",2),A=+$P(X,"^",3) I $D(^DIC(195.1,A,"BOR",+$O(^DIC(195.1,A,"BOR","B",F,0)),0)),$P(^(0),"^",RTPCE)="y" S Y=1
ATTQ S:$D(RTZ("X")) X=RTZ("X") K RTZ("X"),F,A Q
;
DR I $P(RTMV0,"^")'["RE-CHARGE",$P(^RTV(195.9,RTB,0),"^",13)'="F" S RTPCE=4 D ATT I Y S IOP="" D ^%ZIS K IOP S RTBX=RTB D START^RTRPT2 S RTB=RTBX K RTBX,RTC,RT1,RTS,RTY
I $P(RTMV0,"^")'["RE-CHARGE" S RTPCE=2 D ATT I Y W ! S DA=+RTB,DIE="^RTV(195.9,",DR="[RT QUICK UPDATE]" D ^DIE K DE,DQ
S RTPCE=3 D ATT S RTPROVFL=Y K RTPCE Q
;
ASSCO I 'RTPROVFL!('$D(^RTV(195.9,+RTB,0))) S RTPROV="" Q
S RTA=+$P(^RTV(195.9,+RTB,0),"^",3),DIC="^RTV(195.9,",DIC("DR")="3////"_RTA,DIC(0)="IAELMQ",DIC("S")="I Y'="_+RTB_",$P(^(0),U,3)="_RTA_" D DICS^RTDPA31",DIC("V")="D DICV^RTDPA31",DIC("A")="ASSOCIATED BORROWER: "
S:$S('$D(RTPROV):0,'$D(^RTV(195.9,+RTPROV,0)):0,1:1) DIC("B")=$P(^(0),"^")
D ^DIC K DIC S RTPROV=$S(Y>0:+Y,1:"") Q
;
PRT ;entry point used by input transforms of default printer fields
;in file 195.9 - RECORD BORROWERS/FILE AREAS.
I $D(RTREMOTE) D REMOT Q
S DIC(0)="EM" D PRT1 S X=$P(Y,"^",2) K:Y<0 X Q
PRT1 S DIC="^%ZIS(1,",DIC("S")="I $D(^(""SUBTYPE"")),$D(^%ZIS(2,+^(""SUBTYPE""),0)),$E(^(0))=""P""" D ^DIC K DIC S DIC=DIE Q
;
HELP ;entry point used for help for default printer fields in file 195.9
I $D(RTREMOTE) D REMOT Q
S DIC(0)="E" D PRT1 Q
;
COUNT ;Entry point to count the number of records charged to a borrower
; 'X' is defined as the internal entry number of file 195.9
; 'X' is returned as number of records charged
S X1=X,X=0 Q:'$D(^RTV(195.9,X1,0)) S RTA=+$P(^(0),"^",3)
F RTI=0:0 S RTI=$O(^RT("ABOR",X1,RTI)) Q:'RTI I $D(^RT(RTI,0)),$P(^(0),"^",4)=RTA S X=X+1
K X1,RTI,RTA Q
;
; RT*2*33 (when S SAVY=Y Y was undefined)
REMOT ;S SAVY=Y,Y=$P(^RTV(195.9,DA,0),"^") D NAME^RTB
N Y
S Y=$P(^RTV(195.9,DA,0),"^") D NAME^RTB
W !?3,"You must enter a valid file remote Request Printer device"
W !?3,"at `",Y,"' Contact the site manager at `",Y,"'",!
;S Y=SAVY K SAVY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTDPA3 3158 printed Oct 16, 2024@18:34:37 Page 2
RTDPA3 ;TROY ISC/MJK-Borrower File Look-up ; 5/19/87 11:23 AM ; 1/30/03 8:35am
+1 ;;2.0;Record Tracking;**21,33**;10/22/91
+2 SET DIC("S")="D DICS^RTDPA31"
SET DIC("V")="D DICV^RTDPA31"
SET DIC("DR")="3////"_RTA
SET DIC="^RTV(195.9,"
DO ^DIC
KILL DIC,RTB
if Y>0
SET RTB=$PIECE(Y,"^",2)
QUIT
+3 ;
CHK SET RTA=+RTAPL
SET RTB=+Y_";SC("
SET Y=+$ORDER(^RTV(195.9,"ABOR",RTB,RTA,0))
if 'Y
DO SET
KILL RTA,RTB
QUIT
+1 ;
SET SET I=$PIECE(^RTV(195.9,0),"^",3)
LOCK SET I=I+1
LOCK +^RTV(195.9,I):1
IF '$TEST!$DATA(^RTV(195.9,I))
LOCK -^RTV(195.9,I)
GOTO LOCK
+1 SET ^RTV(195.9,I,0)=RTB_"^^"_RTA
SET ^RTV(195.9,"B",RTB,I)=""
SET ^(0)=$PIECE(^RTV(195.9,0),"^",1,2)_"^"_I_"^"_($PIECE(^(0),"^",4)+1)
SET ^DISV($SELECT($DATA(DUZ)'[0:DUZ,1:0),"^RTV(195.9,")=I
SET ^RTV(195.9,"ABOR",RTB,RTA,I)=""
+2 IF RTB[";SC("
SET X=^RTV(195.9,I,0)
SET $PIECE(X,"^",2)=+RTB
SET $PIECE(X,"^",13)=$PIECE(^SC(+RTB,0),"^",3)
SET $PIECE(X,"^",8,9)=$SELECT($DATA(^(99)):$PIECE(^(99),"^"),1:"")_"^"_$PIECE(^(0),"^",11)
SET $PIECE(X,"^",7)=$EXTRACT($PIECE(X,"^",8),1,10)_"/"_$EXTRACT($PIECE(X,"^",9),1,10)
SET ^RTV(195.9,I,0)=X
LOCKQ LOCK -^RTV(195.9,I)
SET Y=I
QUIT
+1 ;
ATT SET Y=0
if $SELECT('$DATA(RTB)
QUIT
if $DATA(X)#2
SET RTZ("X")=X
SET X=^(0)
IF @("'$D(^"_$PIECE($PIECE(X,"^"),";",2)_"0))")
GOTO ATTQ
+1 ;naked reference to the borrower entry set by @(^$D(^ in tag att
+2 SET F=+$PIECE(^(0),"^",2)
SET A=+$PIECE(X,"^",3)
IF $DATA(^DIC(195.1,A,"BOR",+$ORDER(^DIC(195.1,A,"BOR","B",F,0)),0))
IF $PIECE(^(0),"^",RTPCE)="y"
SET Y=1
ATTQ if $DATA(RTZ("X"))
SET X=RTZ("X")
KILL RTZ("X"),F,A
QUIT
+1 ;
DR IF $PIECE(RTMV0,"^")'["RE-CHARGE"
IF $PIECE(^RTV(195.9,RTB,0),"^",13)'="F"
SET RTPCE=4
DO ATT
IF Y
SET IOP=""
DO ^%ZIS
KILL IOP
SET RTBX=RTB
DO START^RTRPT2
SET RTB=RTBX
KILL RTBX,RTC,RT1,RTS,RTY
+1 IF $PIECE(RTMV0,"^")'["RE-CHARGE"
SET RTPCE=2
DO ATT
IF Y
WRITE !
SET DA=+RTB
SET DIE="^RTV(195.9,"
SET DR="[RT QUICK UPDATE]"
DO ^DIE
KILL DE,DQ
+2 SET RTPCE=3
DO ATT
SET RTPROVFL=Y
KILL RTPCE
QUIT
+3 ;
ASSCO IF 'RTPROVFL!('$DATA(^RTV(195.9,+RTB,0)))
SET RTPROV=""
QUIT
+1 SET RTA=+$PIECE(^RTV(195.9,+RTB,0),"^",3)
SET DIC="^RTV(195.9,"
SET DIC("DR")="3////"_RTA
SET DIC(0)="IAELMQ"
SET DIC("S")="I Y'="_+RTB_",$P(^(0),U,3)="_RTA_" D DICS^RTDPA31"
SET DIC("V")="D DICV^RTDPA31"
SET DIC("A")="ASSOCIATED BORROWER: "
+2 if $SELECT('$DATA(RTPROV)
SET DIC("B")=$PIECE(^(0),"^")
+3 DO ^DIC
KILL DIC
SET RTPROV=$SELECT(Y>0:+Y,1:"")
QUIT
+4 ;
PRT ;entry point used by input transforms of default printer fields
+1 ;in file 195.9 - RECORD BORROWERS/FILE AREAS.
+2 IF $DATA(RTREMOTE)
DO REMOT
QUIT
+3 SET DIC(0)="EM"
DO PRT1
SET X=$PIECE(Y,"^",2)
if Y<0
KILL X
QUIT
PRT1 SET DIC="^%ZIS(1,"
SET DIC("S")="I $D(^(""SUBTYPE"")),$D(^%ZIS(2,+^(""SUBTYPE""),0)),$E(^(0))=""P"""
DO ^DIC
KILL DIC
SET DIC=DIE
QUIT
+1 ;
HELP ;entry point used for help for default printer fields in file 195.9
+1 IF $DATA(RTREMOTE)
DO REMOT
QUIT
+2 SET DIC(0)="E"
DO PRT1
QUIT
+3 ;
COUNT ;Entry point to count the number of records charged to a borrower
+1 ; 'X' is defined as the internal entry number of file 195.9
+2 ; 'X' is returned as number of records charged
+3 SET X1=X
SET X=0
if '$DATA(^RTV(195.9,X1,0))
QUIT
SET RTA=+$PIECE(^(0),"^",3)
+4 FOR RTI=0:0
SET RTI=$ORDER(^RT("ABOR",X1,RTI))
if 'RTI
QUIT
IF $DATA(^RT(RTI,0))
IF $PIECE(^(0),"^",4)=RTA
SET X=X+1
+5 KILL X1,RTI,RTA
QUIT
+6 ;
+7 ; RT*2*33 (when S SAVY=Y Y was undefined)
REMOT ;S SAVY=Y,Y=$P(^RTV(195.9,DA,0),"^") D NAME^RTB
+1 NEW Y
+2 SET Y=$PIECE(^RTV(195.9,DA,0),"^")
DO NAME^RTB
+3 WRITE !?3,"You must enter a valid file remote Request Printer device"
+4 WRITE !?3,"at `",Y,"' Contact the site manager at `",Y,"'",!
+5 ;S Y=SAVY K SAVY
