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