RTRPT ;MJK/TROY ISC;Management Reports Option; ; 5/20/87 4:33 PM ;
;;v 2.0;Record Tracking;**1**;10/22/91
D DT^DICRW S X=$T(+1),DIK="^DOPT("""_$P(X," ;",1)_""","
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)
D IXALL^DIK
A D OVERALL^RTPSET Q:$D(XQUIT)
W !! S DIC="^DOPT("""_$P($T(+1)," ;")_""",",DIC(0)="IQEAM" D ^DIC Q:Y<0 D @+Y G A
;
;
1 ;;Missing Records Report
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
;
2 ;;Records Charged to a Borrower
G ^RTRPT2
;
3 ;;Overdue Records List
G 3^RTRPT3
;
4 ;;Pending Requests for a Borrower
G PEND^RTRPT1
;
5 ;;Pending Requests List
D DIV^RTP4 G Q5:'$D(RTDV) S RTDV=$P($P(^DIC(4,+RTDV,0),"^"),","),RTPCE=9 D WINDOW G Q5:RTWND=9999999
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="^"
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)"
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
Q5 K RTDEV,DIS,RTPCE,RTCOUNT,DIOEND,RTWND,RTDV,FR,TO,BY,FLDS,DIC,X,X1,DHD,B,L Q
;
CPND D W1 Q
PND S RTPCE=9
WINDOW ;calculates overdue,pending date window for each type of record
S:'$D(RTPCE) RTPCE=11 K RTWND S RTWND=9999999
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
D W2 Q
W1 ;positive window logic for checkin-pending
K RTWND S RTWND=99999999
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
;
W2 K RTPCE,RTI Q
W3 D C^%DTC S RTWND(RTI)=X S:X<RTWND RTWND=X Q
;
6 ;;Charged Records By Home Location
G 6^RTRPT3
;
7 ;;Inpatient Record List
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)
G Q7:X="^" I X="A" K DHD S BY="[RT ALL INPATIENTS]",(FR,TO)=",," G PRT
W ! K %DT S %DT="AETX",%DT("A")="Beginning Admission Date/Time: " D ^%DT G Q7:Y<0 S (%DT(0),RTBEG,FR)=Y_","
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")_","
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]"
D ^RTRPT5 G Q7
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
Q7 K %DT,FLDS,TO,FR,BY,DHD,L,RTBEG,RTEND
K X,X1 D CLOSE^RTUTL Q
;
8 ;;Request Response Statistics
G ^RTRPT4
;
9 ;;Loose Filing List
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
;
10 ;;Retrieval Rate
G ^RTREP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTRPT 3713 printed Dec 13, 2024@02:34:37 Page 2
RTRPT ;MJK/TROY ISC;Management Reports Option; ; 5/20/87 4:33 PM ;
+1 ;;v 2.0;Record Tracking;**1**;10/22/91
+2 DO DT^DICRW
SET X=$TEXT(+1)
SET DIK="^DOPT("""_$PIECE(X," ;",1)_""","
+3 if $DATA(^DOPT($PIECE(X," ;"),9))
GOTO A
SET ^DOPT($PIECE(X," ;"),0)=$PIECE(X,";",3)_"^1N^"
FOR I=1:1
SET Y=$TEXT(@I)
if Y=""
QUIT
SET ^DOPT($PIECE(X," ;"),I,0)=$PIECE(Y,";",3,99)
+4 DO IXALL^DIK
A DO OVERALL^RTPSET
if $DATA(XQUIT)
QUIT
+1 WRITE !!
SET DIC="^DOPT("""_$PIECE($TEXT(+1)," ;")_""","
SET DIC(0)="IQEAM"
DO ^DIC
if Y<0
QUIT
DO @+Y
GOTO A
+2 ;
+3 ;
1 ;;Missing Records Report
+1 SET L=0
SET DIC="^RTV(190.2,"
SET FLDS="[RT MISSING]"
SET BY="[RT MISSING]"
SET FR=""
SET TO=""
SET DIS(0)="I $D(^RT(+^RTV(190.2,D0,0),0)),$P(^(0),U,4)=+RTAPL"
KILL DTOUT
DO EN1^DIP
KILL FLDS,BY,FR,TO,DIS(0),L,X,DHD
QUIT
+2 ;
2 ;;Records Charged to a Borrower
+1 GOTO ^RTRPT2
+2 ;
3 ;;Overdue Records List
+1 GOTO 3^RTRPT3
+2 ;
4 ;;Pending Requests for a Borrower
+1 GOTO PEND^RTRPT1
+2 ;
5 ;;Pending Requests List
+1 DO DIV^RTP4
if '$DATA(RTDV)
GOTO Q5
SET RTDV=$PIECE($PIECE(^DIC(4,+RTDV,0),"^"),",")
SET RTPCE=9
DO WINDOW
if RTWND=9999999
GOTO Q5
+2 SET RTRD(1)="Yes^include clinic appointment requests"
SET RTRD(2)="No^not include clinic appointment requests"
SET RTRD(0)="S"
SET RTRD("B")=2
SET RTRD("A")="Do you want to include unfilled clinic requests? "
DO SET^RTRD
KILL RTRD
SET X=$EXTRACT(X)
if X="^"
GOTO Q5
+3 SET DIS(0)="I $D(^RTV(190.1,D0,0)) S Z=^(0) I $P(Z,U,6)=""r""!($P(Z,U,6)=""n"")"_$SELECT(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)"
+4 if RTDEV]""
SET %ZIS("B")=RTDEV
SET DIOEND="W !?5,""Total Requests Pending: "",RTCOUNT"
SET RTCOUNT=0
SET FR=RTWND_","_RTDV
DO NOW^%DTC
SET TO=%_","_RTDV_"z"
SET DIC="^RTV(190.1,"
SET L=0
SET (BY,FLDS)="[RT PENDING REQUESTS]"
KILL DTOUT
DO EN1^DIP
Q5 KILL RTDEV,DIS,RTPCE,RTCOUNT,DIOEND,RTWND,RTDV,FR,TO,BY,FLDS,DIC,X,X1,DHD,B,L
QUIT
+1 ;
CPND DO W1
QUIT
PND SET RTPCE=9
WINDOW ;calculates overdue,pending date window for each type of record
+1 if '$DATA(RTPCE)
SET RTPCE=11
KILL RTWND
SET RTWND=9999999
+2 FOR RTI=0:0
SET RTI=$ORDER(^DIC(195.2,"C",+RTAPL,RTI))
if 'RTI
QUIT
IF $DATA(^DIC(195.2,RTI,0))
IF $SELECT(RTPCE'=9:1,1:$PIECE(^(0),"^",14)="y")
SET X1=DT
SET X2=-$PIECE(^(0),"^",RTPCE)
if 'X2
SET X2=-1
DO C^%DTC
SET RTWND(RTI)=X
if X<RTWND
SET RTWND=X
+3 DO W2
QUIT
W1 ;positive window logic for checkin-pending
+1 KILL RTWND
SET RTWND=99999999
+2 NEW L0,L1
FOR RTI=0:0
SET RTI=$ORDER(^DIC(195.2,"C",+RTAPL,RTI))
if 'RTI
QUIT
IF $DATA(^DIC(195.2,RTI,0))
IF $PIECE(^(0),U,14)="y"
SET L0=$PIECE(^(0),U,9)
SET L1=$SELECT($DATA(^(1)):$PIECE(^(1),U),1:"")
SET X1=DT
SET X2=$SELECT(L1]"":L1,L0:-L0,1:-1)
IF X2
if L1]""
SET X2=X2-1
DO W3
+3 ;
W2 KILL RTPCE,RTI
QUIT
W3 DO C^%DTC
SET RTWND(RTI)=X
if X<RTWND
SET RTWND=X
QUIT
+1 ;
6 ;;Charged Records By Home Location
+1 GOTO 6^RTRPT3
+2 ;
7 ;;Inpatient Record List
+1 SET RTRD(1)="All^print record locations for all inpatients"
SET RTRD(2)="Range^print record locations for a range of admission dates"
SET RTRD(0)="S"
SET RTRD("B")=2
SET RTRD("A")="'ALL' inpatients or 'Range' of admissions? "
DO SET^RTRD
KILL RTRD
SET X=$EXTRACT(X)
+2 if X="^"
GOTO Q7
IF X="A"
KILL DHD
SET BY="[RT ALL INPATIENTS]"
SET (FR,TO)=",,"
GOTO PRT
+3 WRITE !
KILL %DT
SET %DT="AETX"
SET %DT("A")="Beginning Admission Date/Time: "
DO ^%DT
if Y<0
GOTO Q7
SET (%DT(0),RTBEG,FR)=Y_","
+4 WRITE !
SET %DT="AETX"
SET %DT("A")="Ending Admission Date/Time: "
DO ^%DT
KILL %DT
if Y<0
GOTO Q7
WRITE !
SET (RTEND,TO)=$SELECT(Y[".":Y,1:Y_".99")_","
+5 SET Y=RTBEG
DO D^DIQ
SET DHD="Record Location Lists for In-patients Admitted from "_Y_" to "
SET Y=$PIECE(RTEND,".")
DO D^DIQ
SET DHD=DHD_Y
SET BY="[RT WARD LIST]"
+6 DO ^RTRPT5
GOTO Q7
PRT SET DIC="^DPT("
SET FLDS="[RT WARD LIST]"
SET FR=FR_$PIECE($PIECE(RTAPL,"^"),";",2)
SET TO=TO_$PIECE($PIECE(RTAPL,"^"),";",2)
SET L=0
KILL DTOUT
DO EN1^DIP
Q7 KILL %DT,FLDS,TO,FR,BY,DHD,L,RTBEG,RTEND
+1 KILL X,X1
DO CLOSE^RTUTL
QUIT
+2 ;
8 ;;Request Response Statistics
+1 GOTO ^RTRPT4
+2 ;
9 ;;Loose Filing List
+1 SET DIC="^RT("
SET BY="[RT LOOSE FILING]"
SET FLDS="[RT HOME LOCATION]"
SET DHD="Loose Filing List [Sort: Terminal Digits] ["_$PIECE($PIECE(RTAPL,"^"),";",2)_"]"
SET DIS(0)="I $D(^RT(D0,0)),$P(^(0),U,4)="_+RTAPL
KILL DTOUT
DO EN1^DIP
KILL BY,FLDS,TO,FR,DHD,X
QUIT
+2 ;
10 ;;Retrieval Rate
+1 GOTO ^RTREP
