[613] | 1 | RTRPT ;MJK/TROY ISC;Management Reports Option; ; 5/20/87 4:33 PM ;
|
---|
| 2 | ;;v 2.0;Record Tracking;**1**;10/22/91
|
---|
| 3 | D DT^DICRW S X=$T(+1),DIK="^DOPT("""_$P(X," ;",1)_""","
|
---|
| 4 | G:$D(^DOPT($P(X," ;"),9)) A S ^DOPT($P(X," ;"),0)=$P(X,";",3)_"^1N^" F I=1:1 S Y=$T(@I) Q:Y="" S ^DOPT($P(X," ;"),I,0)=$P(Y,";",3,99)
|
---|
| 5 | D IXALL^DIK
|
---|
| 6 | A D OVERALL^RTPSET Q:$D(XQUIT)
|
---|
| 7 | W !! S DIC="^DOPT("""_$P($T(+1)," ;")_""",",DIC(0)="IQEAM" D ^DIC Q:Y<0 D @+Y G A
|
---|
| 8 | ;
|
---|
| 9 | ;
|
---|
| 10 | 1 ;;Missing Records Report
|
---|
| 11 | S L=0,DIC="^RTV(190.2,",FLDS="[RT MISSING]",BY="[RT MISSING]",FR="",TO="",DIS(0)="I $D(^RT(+^RTV(190.2,D0,0),0)),$P(^(0),U,4)=+RTAPL" K DTOUT D EN1^DIP K FLDS,BY,FR,TO,DIS(0),L,X,DHD Q
|
---|
| 12 | ;
|
---|
| 13 | 2 ;;Records Charged to a Borrower
|
---|
| 14 | G ^RTRPT2
|
---|
| 15 | ;
|
---|
| 16 | 3 ;;Overdue Records List
|
---|
| 17 | G 3^RTRPT3
|
---|
| 18 | ;
|
---|
| 19 | 4 ;;Pending Requests for a Borrower
|
---|
| 20 | G PEND^RTRPT1
|
---|
| 21 | ;
|
---|
| 22 | 5 ;;Pending Requests List
|
---|
| 23 | D DIV^RTP4 G Q5:'$D(RTDV) S RTDV=$P($P(^DIC(4,+RTDV,0),"^"),","),RTPCE=9 D WINDOW G Q5:RTWND=9999999
|
---|
| 24 | S RTRD(1)="Yes^include clinic appointment requests",RTRD(2)="No^not include clinic appointment requests",RTRD(0)="S",RTRD("B")=2,RTRD("A")="Do you want to include unfilled clinic requests? " D SET^RTRD K RTRD S X=$E(X) G Q5:X="^"
|
---|
| 25 | S DIS(0)="I $D(^RTV(190.1,D0,0)) S Z=^(0) I $P(Z,U,6)=""r""!($P(Z,U,6)=""n"")"_$S(X="Y":"",1:",'$P(Z,U,10)")_",$D(^RT(+Z,0)),$D(RTWND(+$P(^(0),U,3))),RTWND(+$P(^(0),U,3))'>$P(Z,U,4)"
|
---|
| 26 | S:RTDEV]"" %ZIS("B")=RTDEV S DIOEND="W !?5,""Total Requests Pending: "",RTCOUNT",RTCOUNT=0,FR=RTWND_","_RTDV D NOW^%DTC S TO=%_","_RTDV_"z",DIC="^RTV(190.1,",L=0,(BY,FLDS)="[RT PENDING REQUESTS]" K DTOUT D EN1^DIP
|
---|
| 27 | Q5 K RTDEV,DIS,RTPCE,RTCOUNT,DIOEND,RTWND,RTDV,FR,TO,BY,FLDS,DIC,X,X1,DHD,B,L Q
|
---|
| 28 | ;
|
---|
| 29 | CPND D W1 Q
|
---|
| 30 | PND S RTPCE=9
|
---|
| 31 | WINDOW ;calculates overdue,pending date window for each type of record
|
---|
| 32 | S:'$D(RTPCE) RTPCE=11 K RTWND S RTWND=9999999
|
---|
| 33 | F RTI=0:0 S RTI=$O(^DIC(195.2,"C",+RTAPL,RTI)) Q:'RTI I $D(^DIC(195.2,RTI,0)),$S(RTPCE'=9:1,1:$P(^(0),"^",14)="y") S X1=DT,X2=-$P(^(0),"^",RTPCE) S:'X2 X2=-1 D C^%DTC S RTWND(RTI)=X S:X<RTWND RTWND=X
|
---|
| 34 | D W2 Q
|
---|
| 35 | W1 ;positive window logic for checkin-pending
|
---|
| 36 | K RTWND S RTWND=99999999
|
---|
| 37 | N L0,L1 F RTI=0:0 S RTI=$O(^DIC(195.2,"C",+RTAPL,RTI)) Q:'RTI I $D(^DIC(195.2,RTI,0)),$P(^(0),U,14)="y" S L0=$P(^(0),U,9),L1=$S($D(^(1)):$P(^(1),U),1:""),X1=DT,X2=$S(L1]"":L1,L0:-L0,1:-1) I X2 S:L1]"" X2=X2-1 D W3
|
---|
| 38 | ;
|
---|
| 39 | W2 K RTPCE,RTI Q
|
---|
| 40 | W3 D C^%DTC S RTWND(RTI)=X S:X<RTWND RTWND=X Q
|
---|
| 41 | ;
|
---|
| 42 | 6 ;;Charged Records By Home Location
|
---|
| 43 | G 6^RTRPT3
|
---|
| 44 | ;
|
---|
| 45 | 7 ;;Inpatient Record List
|
---|
| 46 | S RTRD(1)="All^print record locations for all inpatients",RTRD(2)="Range^print record locations for a range of admission dates",RTRD(0)="S",RTRD("B")=2,RTRD("A")="'ALL' inpatients or 'Range' of admissions? " D SET^RTRD K RTRD S X=$E(X)
|
---|
| 47 | G Q7:X="^" I X="A" K DHD S BY="[RT ALL INPATIENTS]",(FR,TO)=",," G PRT
|
---|
| 48 | W ! K %DT S %DT="AETX",%DT("A")="Beginning Admission Date/Time: " D ^%DT G Q7:Y<0 S (%DT(0),RTBEG,FR)=Y_","
|
---|
| 49 | W ! S %DT="AETX",%DT("A")="Ending Admission Date/Time: " D ^%DT K %DT G Q7:Y<0 W ! S (RTEND,TO)=$S(Y[".":Y,1:Y_".99")_","
|
---|
| 50 | S Y=RTBEG D D^DIQ S DHD="Record Location Lists for In-patients Admitted from "_Y_" to ",Y=$P(RTEND,".") D D^DIQ S DHD=DHD_Y,BY="[RT WARD LIST]"
|
---|
| 51 | D ^RTRPT5 G Q7
|
---|
| 52 | PRT S DIC="^DPT(",FLDS="[RT WARD LIST]",FR=FR_$P($P(RTAPL,"^"),";",2),TO=TO_$P($P(RTAPL,"^"),";",2),L=0 K DTOUT D EN1^DIP
|
---|
| 53 | Q7 K %DT,FLDS,TO,FR,BY,DHD,L,RTBEG,RTEND
|
---|
| 54 | K X,X1 D CLOSE^RTUTL Q
|
---|
| 55 | ;
|
---|
| 56 | 8 ;;Request Response Statistics
|
---|
| 57 | G ^RTRPT4
|
---|
| 58 | ;
|
---|
| 59 | 9 ;;Loose Filing List
|
---|
| 60 | S DIC="^RT(",BY="[RT LOOSE FILING]",FLDS="[RT HOME LOCATION]",DHD="Loose Filing List [Sort: Terminal Digits] ["_$P($P(RTAPL,"^"),";",2)_"]",DIS(0)="I $D(^RT(D0,0)),$P(^(0),U,4)="_+RTAPL K DTOUT D EN1^DIP K BY,FLDS,TO,FR,DHD,X Q
|
---|
| 61 | ;
|
---|
| 62 | 10 ;;Retrieval Rate
|
---|
| 63 | G ^RTREP
|
---|