source: FOIAVistA/tag/r/RECORD_TRACKING-RT/RTNQ3.m@ 636

RTNQ3 ;MJK/TROY ISC;Combined Data Trace; ; 5/20/87  4:35 PM ;
 ;;v 2.0;Record Tracking;;10/22/91 
 I '$D(RTAPL) D APL2^RTPSET D NEXT:$D(RTAPL) K RTAPL,RTSYS Q
NEXT D PT^RTUTL3 G Q:Y<0
 S %DT="AEPX",%DT(0)="-NOW",%DT("B")="T-100",%DT("A")="Trace Cut-off Date: " D ^%DT K %DT G Q:Y<0 S RTDT=Y-.0001
 S RTPGM="START^RTNQ3",RTVAR="RTE^RTDT^DFN^RTAPL" D ZIS^RTUTL G Q:POP D START G NEXT
 ;
START U IO S RTESC="",RTPAGE=0 K R,^TMP($J,"RTCOMBO") S R="" I '$D(IOSL)!('$D(IOF)) S IOP="" D ^%ZIS K IOP
 S A=+RTAPL F RT=0:0 S RT=$O(^RT("AA",A,RTE,RT)) Q:'RT  I $D(^RT(RT,0)) S Y=^(0) D REC F RTH=0:0 S RTH=$O(^RTV(190.3,"B",RT,RTH)) Q:'RTH  I $D(^RTV(190.3,RTH,0)) S Y=^(0) D HIS:$P(Y,"^",6)'<RTDT
 F S=RTDT:0 S S=$O(^DPT(DFN,"S",S)) Q:'S  I $D(^(S,0)),$P(^(0),U,2)'["C" S D=9999999.9999-S,Y=$E($S($D(^SC(+^(0),0)):$P(^(0),"^"),1:"UNKNOWN"),1,19),P=2 D SET
 S RTDTI=9999999.9999-RTDT
 F A=0:0 S A=$O(^DGPM("APID",DFN,A)) Q:'A!(A>RTDTI)  S DGPMDA=+$O(^(A,0)) I $D(^DGPM(DGPMDA,0)) S Y=^(0),TT=$P(Y,"^",2) I TT,TT<4 D DIS:TT=3,MVT
 D HD I $D(R)<11,'$D(^TMP($J,"RTCOMBO")) W !!?5,"No activity for period." G Q
 K RTFL S RTFUT=1,RTG="S RTI=$O("_$S($D(R):"R(RTI)",1:"^TMP($J,""RTCOMBO"",RTI)")_")"
 S RTG1="S RTI1=$O("_$S($D(R):"R(RTI,RTI1)",1:"^TMP($J,""RTCOMBO"",RTI,RTI1)")_")"
 F RTI=0:0 X RTG Q:'RTI  F RTI1=0:0 X RTG1 Q:'RTI1  D LIST G Q:RTESC="^"
Q K RTFUT,RTPAGE,RTESC,RTE,RTFL,RTDTI,A1,A,S,RTVAR,RTPGM,RTDT,R,RT,M,P,DFN,RTG,RTH,RTI,T,V,^TMP($J,"RTCOMBO") D CLOSE^RTUTL
 K DUOUT,C,I,X,Y,RTG1,%,%H,%I,N,POP,RTI1,DGPMDA,TT Q
LIST ;
 D HD:($Y+5)>IOSL Q:RTESC="^"  S Y=$E(9999999.9999-RTI,1,12) D FUT:$P(Y,".")'>DT&(RTFUT),D^DIQ S D=Y,RTFL="",Y=$S($D(R):R(RTI,RTI1),1:^TMP($J,"RTCOMBO",RTI,RTI1)) W !,D,?20,$P(Y,"^"),?40,$P(Y,"^",2),?60,$P(Y,"^",3) Q
SET D DUMP:$S<2000 I $D(R) F I=1:1 S:'$D(R(D,I)) R(D,I)="" I $P(R(D,I),"^",P)="" S $P(R(D,I),"^",P)=Y Q
 Q:$D(R)  F I=1:1 S:'$D(^TMP($J,"RTCOMBO",D,I)) ^TMP($J,"RTCOMBO",D,I)="" I $P(^TMP($J,"RTCOMBO",D,I),"^",P)="" S $P(^TMP($J,"RTCOMBO",D,I),"^",P)=Y Q
 Q
 ;
REC S V=$S('$D(^DIC(195.2,+$P(Y,"^",3),0)):"UNKNOWN",1:$P(^(0),"^",2))_+$P(Y,"^",7) Q
 ;
HIS S D=9999999.9999-$P(Y,"^",6),Y=$P(Y,"^",5) D BOR^RTB S Y=Y_"             ",Y=$E(Y,1,14)_";"_V,P=1 D SET Q
 ;
MVT ; --  set up vars for mvt entry ; Y = 0th node of mvt
 I TT=2,$P(Y,"^",18)'=4 G MVTQ ; must be interward tfr
 S D=9999999.9999-Y
 S Y=$S($D(^DIC(42,+$P(Y,"^",6),0)):$P(^(0),"^"),1:"UNKNOWN")_"                "
 S Y=$E(Y,1,14)_";"_$P("adm^tfr^dis","^",TT),P=3 D SET
MVTQ K D Q
 ;
DIS ; -- find last ward before d/c ; Y = 0th node of mvt
 S CA=$P(Y,"^",14)
 F IDT=0:0 S IDT=$O(^DGPM("APMV",DFN,CA,IDT)) Q:'IDT  F MVT=0:0 S MVT=$O(^DGPM("APMV",DFN,CA,IDT,MVT)) Q:'MVT  I $D(^DGPM(MVT,0)),$P(^(0),"^",6) S $P(Y,"^",6)=$P(^(0),"^",6) G DISQ
DISQ K CA,MVT,IDT Q
 ;
HD S RTESC="" I RTPAGE,IOST["C-" R !!,"Press RETURN to continue or '^' to stop: ",RTESC:DTIME S:'$T RTESC="^" Q:RTESC["^"
 S RTPAGE=RTPAGE+1,X1="ADT,Scheduling and Tracking Data Trace Report ("_$P($P(RTAPL,"^"),";",2)_")" D PTHD^RTUTL2,EQUALS^RTUTL3
 S Y=RTDT+.0001 D D^DIQ W !,"[Report compiled with data on activities back to ",Y,"]"
 W !,"Date/Time",?20,"Record Location",?40,"Clinic Name",?60,"Ward;Action" D LINE^RTUTL3
 Q
 ;
DUMP F I=0:0 S I=$O(R(I)) Q:'I  F I1=0:0 S I1=$O(R(I,I1)) Q:'I1  S ^TMP($J,"RTCOMBO",I,I1)=R(I,I1)
 K R Q
 ;
FUT S RTFUT=0 Q:'$D(RTFL)  D EQUALS^RTUTL3 W !?20,"ABOVE THIS LINE ARE 'FUTURE' ACTIVITIES" D EQUALS^RTUTL3 Q