- 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 Jan 18, 2025@03:35:02 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