source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTRPT3.m@ 1608

Last change on this file since 1608 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.5 KB
RevLine 
[613]1RTRPT3 ;MJK/TROY ISC;Management Report Options; ; 5/18/87 8:58 AM ;
2 ;;v 2.0;Record Tracking;;10/22/91
36 ;Records Charged Out By Home Location
4 D HOME G Q6:'$D(RTHOME) D SORT G Q6:RTSORT="^"
5 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? "
6 D SET^RTRD G Q6:$E(X)="^",61:$E(X)="Y"
7 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")
8 S DHD="Charged Out Records [Home Location: "_$P(RTHOME,"^",2)_"] [Sorted by: "_$S(RTSORT="B":"BORROWER",RTSORT="T":"TERMINAL DIGITS",1:"NAME")_"]"
9 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
10Q6 K DIC,DIS,RTI,RTWND,RTMOVE,DHD,RTHOME,RTSORT,BY,FLDS,TO,FR
11 K RTOP,RTRD,X,X1,Y,L Q
1261 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")_"]"
13 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
14 ;
153 ;;Overdue List
16 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)=""
17 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)"
18 S DIS(1)="I '$D(^DPT(+^RT(D0,0),.1))"
19 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
20 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="^"
21 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")_"]"
22 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))
23 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
24Q3 K RTI,DIS,DHD,RTOP,RTHOME,RTDV,RTSORT,RTWND,RTMOVE,FLDS,BY,FR,TO,DIC,X,X1 Q
25 ;
26HOME 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
27 S (RTOP,Y,RTHOME)=+Y D BOR^RTB S RTHOME=RTHOME_"^"_Y Q
28 ;
29DIV 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
30 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
31 I Y>0 S RTOP=+Y,RTDV=$P(Y,"^",2)
32 Q
33 ;
34SORT 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
35 ;
36ON I ^%ZOSF("OS")["M/11+" D ON^%XECOPT Q
37 Q
38OFF I ^%ZOSF("OS")["M/11+" D OFF^%XECOPT Q
39 Q
Note: See TracBrowser for help on using the repository browser.