RTRPT3 ;MJK/TROY ISC;Management Report Options; ; 5/18/87 8:58 AM ;
;;v 2.0;Record Tracking;;10/22/91
6 ;Records Charged Out By Home Location
D HOME G Q6:'$D(RTHOME) D SORT G Q6:RTSORT="^"
S RTRD(1)="Yes^include all records",RTRD(2)="No^not include records currently checked into home location",RTRD("B")=2,RTRD(0)="S",RTRD("A")="Include records currently checked into the home location? "
D SET^RTRD G Q6:$E(X)="^",61:$E(X)="Y"
S DIS(0)="I $D(^RT(D0,0)),$P(^(0),U,4)="_+RTAPL_$S($P(RTHOME,"^",3)="Y":"",1:",$D(^RT(D0,""CL"")),$P(^(""CL""),U,5)'=+RTHOME")
S DHD="Charged Out Records [Home Location: "_$P(RTHOME,"^",2)_"] [Sorted by: "_$S(RTSORT="B":"BORROWER",RTSORT="T":"TERMINAL DIGITS",1:"NAME")_"]"
S FR=","_+RTHOME,TO=","_+RTHOME_".999999",DIC="^RT(",L=0,FLDS="[RT HOME LOCATION]",BY="[RT CHARGED BY HOME BY "_$S(RTSORT="B":"BOR",RTSORT="T":"TD",1:"NAME")_"]" K DTOUT D EN1^DIP
Q6 K DIC,DIS,RTI,RTWND,RTMOVE,DHD,RTHOME,RTSORT,BY,FLDS,TO,FR
K RTOP,RTRD,X,X1,Y,L Q
61 S DIS(0)="I $D(^RT(D0,0)),$P(^(0),U,4)="_+RTAPL,DHD="Home Location List [Home Location: "_$P(RTHOME,"^",2)_"] [Sorted by: "_$S(RTSORT="B":"BORROWER",RTSORT="T":"TERMINAL DIGITS",1:"NAME")_"]"
S FR=+RTHOME,TO=+RTHOME_".999999",DIC="^RT(",L=0,FLDS="[RT HOME LOCATION]",BY="[RT HOME LIST BY "_$S(RTSORT="B":"BOR",RTSORT="T":"TD",1:"NAME")_"]" K DTOUT D EN1^DIP G Q6
;
3 ;;Overdue List
K RTMOVE F RTI=0:0 S RTI=$O(^DIC(195.3,"C",+RTAPL,RTI)) Q:'RTI I $D(^DIC(195.3,RTI,0)),$P(^(0),"^",4)="y" S RTMOVE(RTI)=""
S DIS(0)="I $D(^RT(D0,0)),$D(^(""CL"")),$P(^(0),U,4)="_+RTAPL_",$P(^(0),U,6)'=$P(^(""CL""),U,5),$D(RTMOVE(+$P(^(""CL""),U,8))),$D(RTWND(+$P(^(0),U,3))),RTWND(+$P(^(0),U,3))>$P(^(""CL""),U,6)"
S DIS(1)="I '$D(^DPT(+^RT(D0,0),.1))"
S RTRD(1)="Institution^print overdue records by institution",RTRD(2)="Home^print overdue records by home location",RTRD("B")=1,RTRD(0)="S",RTRD("A")="Print Overdue List for a 'Institution' or 'Home Location'? " D SET^RTRD K RTRD
G Q3:X="^" S RTOP=$E(X) D HOME:RTOP="H",DIV:$S('$D(RTOP):0,1:RTOP="I") G Q3:'$D(RTOP) D SORT G Q3:RTSORT="^"
S DHD="Records Overdue ["_$S($D(RTHOME):"Home Location: "_$P(RTHOME,"^",2),1:"Institution: "_$P(RTDV,"^"))_"] [Sorted by: "_$S(RTSORT="B":"BORROWER",RTSORT="T":"TERMINAL DIGITS",1:"NAME")_"]"
D WINDOW^RTRPT S:$D(RTDV) X=$P(RTDV,",") S FR="2860101.0001,"_$S($D(RTHOME):+RTHOME,1:$P(X,",")),TO=RTWND_".9999"_","_$S($D(RTHOME):+RTHOME_".9999",1:$E(X,1,$L(X)-1)_$C($A($E(X,$L(X)))+1))
S L=0,DIC="^RT(",FLDS="[RT HOME LOCATION]",BY="[RT OVER BY "_$S($D(RTHOME):"HOME",1:"DIV")_" BY "_$S(RTSORT="B":"BOR",RTSORT="T":"TD",1:"NAME")_"]" K DTOUT D OFF,EN1^DIP,ON
Q3 K RTI,DIS,DHD,RTOP,RTHOME,RTDV,RTSORT,RTWND,RTMOVE,FLDS,BY,FR,TO,DIC,X,X1 Q
;
HOME K RTOP,RTHOME W ! S DIC="^RTV(195.9,",DIC(0)="IAEMQ",DIC("S")="I $P(^(0),U,3)="_+RTAPL_",$P(^(0),U,13)=""F""",DIC("A")="Select HOME Location: " D ^DIC K DIC Q:Y<0
S (RTOP,Y,RTHOME)=+Y D BOR^RTB S RTHOME=RTHOME_"^"_Y Q
;
DIV K RTOP,DIC,RTDV I $O(^DIC(195.1,+RTAPL,"INST",0)) S I=+$O(^(0)) I '$O(^(I)),$D(^DIC(4,I,0)) S (RTOP,RTDV)=$P(^(0),"^") Q
S DIC(0)="AEMQI",DIC="^DIC(4,",DIC("A")="Select Institution: ",DIC("S")="I $D(^DIC(195.1,"_+RTAPL_",""INST"",Y,0))" S:$S('$D(DUZ(2)):0,$D(^DIC(4,+DUZ(2),0)):1,1:0) DIC("B")=$P(^(0),"^") D ^DIC K DIC
I Y>0 S RTOP=+Y,RTDV=$P(Y,"^",2)
Q
;
SORT S RTRD(1)="Borrower^sort by borrower",RTRD(2)="Name^sort by name",RTRD(3)="Terminal Digits^sort by terminal digits",RTRD(0)="S",RTRD("B")=1,RTRD("A")="How do you want the listing sorted? " D SET^RTRD K RTRD S RTSORT=$E(X) Q
;
ON I ^%ZOSF("OS")["M/11+" D ON^%XECOPT Q
Q
OFF I ^%ZOSF("OS")["M/11+" D OFF^%XECOPT Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTRPT3 3662 printed Dec 13, 2024@02:34:40 Page 2
RTRPT3 ;MJK/TROY ISC;Management Report Options; ; 5/18/87 8:58 AM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
6 ;Records Charged Out By Home Location
+1 DO HOME
if '$DATA(RTHOME)
GOTO Q6
DO SORT
if RTSORT="^"
GOTO Q6
+2 SET RTRD(1)="Yes^include all records"
SET RTRD(2)="No^not include records currently checked into home location"
SET RTRD("B")=2
SET RTRD(0)="S"
SET RTRD("A")="Include records currently checked into the home location? "
+3 DO SET^RTRD
if $EXTRACT(X)="^"
GOTO Q6
if $EXTRACT(X)="Y"
GOTO 61
+4 SET DIS(0)="I $D(^RT(D0,0)),$P(^(0),U,4)="_+RTAPL_$SELECT($PIECE(RTHOME,"^",3)="Y":"",1:",$D(^RT(D0,""CL"")),$P(^(""CL""),U,5)'=+RTHOME")
+5 SET DHD="Charged Out Records [Home Location: "_$PIECE(RTHOME,"^",2)_"] [Sorted by: "_$SELECT(RTSORT="B":"BORROWER",RTSORT="T":"TERMINAL DIGITS",1:"NAME")_"]"
+6 SET FR=","_+RTHOME
SET TO=","_+RTHOME_".999999"
SET DIC="^RT("
SET L=0
SET FLDS="[RT HOME LOCATION]"
SET BY="[RT CHARGED BY HOME BY "_$SELECT(RTSORT="B":"BOR",RTSORT="T":"TD",1:"NAME")_"]"
KILL DTOUT
DO EN1^DIP
Q6 KILL DIC,DIS,RTI,RTWND,RTMOVE,DHD,RTHOME,RTSORT,BY,FLDS,TO,FR
+1 KILL RTOP,RTRD,X,X1,Y,L
QUIT
61 SET DIS(0)="I $D(^RT(D0,0)),$P(^(0),U,4)="_+RTAPL
SET DHD="Home Location List [Home Location: "_$PIECE(RTHOME,"^",2)_"] [Sorted by: "_$SELECT(RTSORT="B":"BORROWER",RTSORT="T":"TERMINAL DIGITS",1:"NAME")_"]"
+1 SET FR=+RTHOME
SET TO=+RTHOME_".999999"
SET DIC="^RT("
SET L=0
SET FLDS="[RT HOME LOCATION]"
SET BY="[RT HOME LIST BY "_$SELECT(RTSORT="B":"BOR",RTSORT="T":"TD",1:"NAME")_"]"
KILL DTOUT
DO EN1^DIP
GOTO Q6
+2 ;
3 ;;Overdue List
+1 KILL RTMOVE
FOR RTI=0:0
SET RTI=$ORDER(^DIC(195.3,"C",+RTAPL,RTI))
if 'RTI
QUIT
IF $DATA(^DIC(195.3,RTI,0))
IF $PIECE(^(0),"^",4)="y"
SET RTMOVE(RTI)=""
+2 SET DIS(0)="I $D(^RT(D0,0)),$D(^(""CL"")),$P(^(0),U,4)="_+RTAPL_",$P(^(0),U,6)'=$P(^(""CL""),U,5),$D(RTMOVE(+$P(^(""CL""),U,8))),$D(RTWND(+$P(^(0),U,3))),RTWND(+$P(^(0),U,3))>$P(^(""CL""),U,6)"
+3 SET DIS(1)="I '$D(^DPT(+^RT(D0,0),.1))"
+4 SET RTRD(1)="Institution^print overdue records by institution"
SET RTRD(2)="Home^print overdue records by home location"
SET RTRD("B")=1
SET RTRD(0)="S"
SET RTRD("A")="Print Overdue List for a 'Institution' or 'Home Location'? "
DO SET^RTRD
KILL RTRD
+5 if X="^"
GOTO Q3
SET RTOP=$EXTRACT(X)
if RTOP="H"
DO HOME
if $SELECT('$DATA(RTOP):0,1:RTOP="I")
DO DIV
if '$DATA(RTOP)
GOTO Q3
DO SORT
if RTSORT="^"
GOTO Q3
+6 SET DHD="Records Overdue ["_$SELECT($DATA(RTHOME):"Home Location: "_$PIECE(RTHOME,"^",2),1:"Institution: "_$PIECE(RTDV,"^"))_"] [Sorted by: "_$SELECT(RTSORT="B":"BORROWER",RTSORT="T":"TERMINAL DIGITS",1:"NAME")_"]"
+7 DO WINDOW^RTRPT
if $DATA(RTDV)
SET X=$PIECE(RTDV,",")
SET FR="2860101.0001,"_$SELECT($DATA(RTHOME):+RTHOME,1:$PIECE(X,","))
SET TO=RTWND_".9999"_","_$SELECT($DATA(RTHOME):+RTHOME_".9999",1:$EXTRACT(X,1,$LENGTH(X)-1)_$CHAR($ASCII($EXTRACT(X,$LENGTH(X)))+1))
+8 SET L=0
SET DIC="^RT("
SET FLDS="[RT HOME LOCATION]"
SET BY="[RT OVER BY "_$SELECT($DATA(RTHOME):"HOME",1:"DIV")_" BY "_$SELECT(RTSORT="B":"BOR",RTSORT="T":"TD",1:"NAME")_"]"
KILL DTOUT
DO OFF
DO EN1^DIP
DO ON
Q3 KILL RTI,DIS,DHD,RTOP,RTHOME,RTDV,RTSORT,RTWND,RTMOVE,FLDS,BY,FR,TO,DIC,X,X1
QUIT
+1 ;
HOME KILL RTOP,RTHOME
WRITE !
SET DIC="^RTV(195.9,"
SET DIC(0)="IAEMQ"
SET DIC("S")="I $P(^(0),U,3)="_+RTAPL_",$P(^(0),U,13)=""F"""
SET DIC("A")="Select HOME Location: "
DO ^DIC
KILL DIC
if Y<0
QUIT
+1 SET (RTOP,Y,RTHOME)=+Y
DO BOR^RTB
SET RTHOME=RTHOME_"^"_Y
QUIT
+2 ;
DIV KILL RTOP,DIC,RTDV
IF $ORDER(^DIC(195.1,+RTAPL,"INST",0))
SET I=+$ORDER(^(0))
IF '$ORDER(^(I))
IF $DATA(^DIC(4,I,0))
SET (RTOP,RTDV)=$PIECE(^(0),"^")
QUIT
+1 SET DIC(0)="AEMQI"
SET DIC="^DIC(4,"
SET DIC("A")="Select Institution: "
SET DIC("S")="I $D(^DIC(195.1,"_+RTAPL_",""INST"",Y,0))"
if $SELECT('$DATA(DUZ(2))
SET DIC("B")=$PIECE(^(0),"^")
DO ^DIC
KILL DIC
+2 IF Y>0
SET RTOP=+Y
SET RTDV=$PIECE(Y,"^",2)
+3 QUIT
+4 ;
SORT SET RTRD(1)="Borrower^sort by borrower"
SET RTRD(2)="Name^sort by name"
SET RTRD(3)="Terminal Digits^sort by terminal digits"
SET RTRD(0)="S"
SET RTRD("B")=1
SET RTRD("A")="How do you want the listing sorted? "
DO SET^RTRD
KILL RTRD
SET RTSORT=$EXTRACT(X)
QUIT
+1 ;
ON IF ^%ZOSF("OS")["M/11+"
DO ON^%XECOPT
QUIT
+1 QUIT
OFF IF ^%ZOSF("OS")["M/11+"
DO OFF^%XECOPT
QUIT
+1 QUIT
