RTNQ1.m

RTNQ1 ;TROY ISC/MJK-Record Trace Routine ; 5/8/87  8:43 AM ; 1/17/03 9:23am

 ;;2.0;Record Tracking;**31**;10/22/91 

 I '$D(RTAPL) D APL2^RTPSET D NEXT:$D(RTAPL) K RTAPL,RTSYS Q

NEXT S RTA=+RTAPL D ASK^RTB K RTA G Q:$D(RTESC),RTNQ1:Y<0 S RTE=X

 S RTRD(1)="Mixed^sort movements of all records together",RTRD(2)="Separate^sort each record type and volume separately",RTRD("B")=1,RTRD("A")="How do you want the '"_$P($P(RTAPL,"^"),";",2)_"' records sorted? ",RTRD(0)="S"

 D SET^RTRD K RTRD G Q:X="^" S RTSORT=$E(X)

 S RTVAR="RTSORT^RTAPL^RTE^DTIME",RTPGM="START^RTNQ1" D ZIS^RTUTL G Q:POP D START G NEXT

 ;

START U IO K RTESC,DFN,^TMP($J,"RTRACE")

 F RT=0:0 S RT=$O(^RT("AA",+RTAPL,RTE,RT)) Q:'RT  I $D(^RT(RT,0)) S Y=^(0) I $S('$D(RTTY):1,$P(Y,"^",3)=+RTTY:1,1:0) S O=+$P(^DIC(195.2,+$P(Y,"^",3),0),"^",4),V=999-$P(Y,"^",7) D HIS

 K RT,RT0,RTH,RTH0 S RTPAGE=0 D HD,PRT:$D(^TMP($J,"RTRACE"))

 W:'$D(^TMP($J,"RTRACE")) !!?3,"...No history online." ;D DPT:RTE["DPT("

Q K RTY,RTH0,RTPAGE,RTVAR,RTPGM,RTE,RTS1,RTS2,RTS3,RTSORT,RTO,RTDT,RTVOL,RTVL,RTESC,^TMP($J,"RTRACE") D CLOSE^RTUTL

 K DUOUT,X1,Y,Y2,RT,RTS4,%I,%Y,C,DIC,DIY,N,O,POP,V,X Q

PRT F RTS1=0:0 S RTS1=$O(^TMP($J,"RTRACE",RTS1)) Q:'RTS1  F RTS2=0:0 S RTS2=$O(^TMP($J,"RTRACE",RTS1,RTS2)) Q:'RTS2  D PRT1 G PRTQ:$D(RTESC)

PRTQ Q

 ;

PRT1 F RTS3=0:0 S RTS3=$O(^TMP($J,"RTRACE",RTS1,RTS2,RTS3)) Q:'RTS3  F RTS4=0:0 S RTS4=$O(^TMP($J,"RTRACE",RTS1,RTS2,RTS3,RTS4)) Q:'RTS4  S RTH0=^(RTS4) D PRT2 G PRT1Q:$D(RTESC)

PRT1Q Q

 ;

PRT2 S RT=+RTH0 Q:'RT  I '$D(RTVL(RT)) D DEMOS^RTUTL1 S RTVL(RT)=RTD("A")_RTD("V") I RTSORT="S" D HD:($Y+5)>IOSL Q:$D(RTESC)  D DEMOS^RTUTL1:'$D(RTD) W !!,"[ ",RTD("T"),"]"

 D HD:($Y+5)>IOSL Q:$D(RTESC)  S Y=RTH0 D DEMOS3^RTUTL1 S Y=$P(RTH0,"^",8),C=$P(^DD(190.3,8,0),"^",2) D Y^DIQ S M=Y,X1=+$P(RTH0,"^",9),X2=+$P(RTH0,"^",6) S:'X1 X1=DT D ^%DTC S D=$S(X'<0:X,1:"")

 W !,RTD("D"),?20,RTVL(RT),?25,RTD("B"),?50,$E(M,1,24),?75,D W:$D(RTD("PROV")) !?25,"(",RTD("PROV"),")"

 K RT,D,RTD,B,B1,M,D1 Q

 ;

HD I RTPAGE,IOST["C-" D ESC^RTRD Q:$D(RTESC)

 S RTPAGE=RTPAGE+1,X1="Movement History for the "_$S($D(^DIC(195.1,+RTAPL,"HD")):$P(^("HD"),"^"),1:$P($P(RTAPL,"^"),";",2)) D PTHD^RTUTL2,EQUALS^RTUTL3 K X1

 I $D(DFN) W !!,"[ Clinic History Profile ]",!?3,"Clinic",?30,"Appointment Date/Time",?55,"Status",!?3,"------",?30,"---------------------",?55,"------" Q

 W !,"[SORT: ",$S(RTSORT="M":"By date charged,record type display order and then volume",1:"By record type display order,volume and then date charged"),"]"

 W !!,"Date Charged",?20,"Vol",?25,"Borrower",?50,"Type of Movement",?70,"# of Days" D LINE^RTUTL3

 Q

 ;

HIS F RTH=0:0 S RTH=$O(^RTV(190.3,"B",RT,RTH)) Q:'RTH  I $D(^RTV(190.3,RTH,0)) S RTH0=^(0) D SET

 Q

 ;

SET S D=9999999.9999-$P(RTH0,"^",6)

 I RTSORT="S" F Y=999:-1 I '$D(^TMP($J,"RTRACE",O,V,D,Y)) S ^(Y)=RTH0 Q

 ; the next line accounts for more than one movement transaction having

 ; occurred within the same minute, while preserving the "reverse date"

 ; sort order

 ;

 I RTSORT'="S" F Y=999:-1 I '$D(^TMP($J,"RTRACE",D,O,V,Y)) S ^(Y)=RTH0 Q

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RTNQ1   3079     printed  Feb 19, 2025@00:00:35                                                                                                                                                                                                       Page 2

RTNQ1     ;TROY ISC/MJK-Record Trace Routine ; 5/8/87  8:43 AM ; 1/17/03 9:23am

 +1       ;;2.0;Record Tracking;**31**;10/22/91 

 +2        IF '$DATA(RTAPL)

               DO APL2^RTPSET

               if $DATA(RTAPL)

                   DO NEXT

               KILL RTAPL,RTSYS

               QUIT 

NEXT       SET RTA=+RTAPL

           DO ASK^RTB

           KILL RTA

           if $DATA(RTESC)

               GOTO Q

           if Y<0

               GOTO RTNQ1

           SET RTE=X

 +1        SET RTRD(1)="Mixed^sort movements of all records together"

           SET RTRD(2)="Separate^sort each record type and volume separately"

           SET RTRD("B")=1

           SET RTRD("A")="How do you want the '"_$PIECE($PIECE(RTAPL,"^"),";",2)_"' records sorted? "

           SET RTRD(0)="S"

 +2        DO SET^RTRD

           KILL RTRD

           if X="^"

               GOTO Q

           SET RTSORT=$EXTRACT(X)

 +3        SET RTVAR="RTSORT^RTAPL^RTE^DTIME"

           SET RTPGM="START^RTNQ1"

           DO ZIS^RTUTL

           if POP

               GOTO Q

           DO START

           GOTO NEXT

 +4       ;

START      USE IO

           KILL RTESC,DFN,^TMP($JOB,"RTRACE")

 +1        FOR RT=0:0

               SET RT=$ORDER(^RT("AA",+RTAPL,RTE,RT))

               if 'RT

                   QUIT 

               IF $DATA(^RT(RT,0))

                   SET Y=^(0)

                   IF $SELECT('$DATA(RTTY):1,$PIECE(Y,"^",3)=+RTTY:1,1:0)

                       SET O=+$PIECE(^DIC(195.2,+$PIECE(Y,"^",3),0),"^",4)

                       SET V=999-$PIECE(Y,"^",7)

                       DO HIS

 +2        KILL RT,RT0,RTH,RTH0

           SET RTPAGE=0

           DO HD

           if $DATA(^TMP($JOB,"RTRACE"))

               DO PRT

 +3       ;D DPT:RTE["DPT("

           if '$DATA(^TMP($JOB,"RTRACE"))

               WRITE !!?3,"...No history online."

Q          KILL RTY,RTH0,RTPAGE,RTVAR,RTPGM,RTE,RTS1,RTS2,RTS3,RTSORT,RTO,RTDT,RTVOL,RTVL,RTESC,^TMP($JOB,"RTRACE")

           DO CLOSE^RTUTL

 +1        KILL DUOUT,X1,Y,Y2,RT,RTS4,%I,%Y,C,DIC,DIY,N,O,POP,V,X

           QUIT 

PRT        FOR RTS1=0:0

               SET RTS1=$ORDER(^TMP($JOB,"RTRACE",RTS1))

               if 'RTS1

                   QUIT 

               FOR RTS2=0:0

                   SET RTS2=$ORDER(^TMP($JOB,"RTRACE",RTS1,RTS2))

                   if 'RTS2

                       QUIT 

                   DO PRT1

                   if $DATA(RTESC)

                       GOTO PRTQ

PRTQ       QUIT 

 +1       ;

PRT1       FOR RTS3=0:0

               SET RTS3=$ORDER(^TMP($JOB,"RTRACE",RTS1,RTS2,RTS3))

               if 'RTS3

                   QUIT 

               FOR RTS4=0:0

                   SET RTS4=$ORDER(^TMP($JOB,"RTRACE",RTS1,RTS2,RTS3,RTS4))

                   if 'RTS4

                       QUIT 

                   SET RTH0=^(RTS4)

                   DO PRT2

                   if $DATA(RTESC)

                       GOTO PRT1Q

PRT1Q      QUIT 

 +1       ;

PRT2       SET RT=+RTH0

           if 'RT

               QUIT 

           IF '$DATA(RTVL(RT))

               DO DEMOS^RTUTL1

               SET RTVL(RT)=RTD("A")_RTD("V")

               IF RTSORT="S"

                   if ($Y+5)>IOSL

                       DO HD

                   if $DATA(RTESC)

                       QUIT 

                   if '$DATA(RTD)

                       DO DEMOS^RTUTL1

                   WRITE !!,"[ ",RTD("T"),"]"

 +1        if ($Y+5)>IOSL

               DO HD

           if $DATA(RTESC)

               QUIT 

           SET Y=RTH0

           DO DEMOS3^RTUTL1

           SET Y=$PIECE(RTH0,"^",8)

           SET C=$PIECE(^DD(190.3,8,0),"^",2)

           DO Y^DIQ

           SET M=Y

           SET X1=+$PIECE(RTH0,"^",9)

           SET X2=+$PIECE(RTH0,"^",6)

           if 'X1

               SET X1=DT

           DO ^%DTC

           SET D=$SELECT(X'<0:X,1:"")

 +2        WRITE !,RTD("D"),?20,RTVL(RT),?25,RTD("B"),?50,$EXTRACT(M,1,24),?75,D

           if $DATA(RTD("PROV"))

               WRITE !?25,"(",RTD("PROV"),")"

 +3        KILL RT,D,RTD,B,B1,M,D1

           QUIT 

 +4       ;

HD         IF RTPAGE

               IF IOST["C-"

                   DO ESC^RTRD

                   if $DATA(RTESC)

                       QUIT 

 +1        SET RTPAGE=RTPAGE+1

           SET X1="Movement History for the "_$SELECT($DATA(^DIC(195.1,+RTAPL,"HD")):$PIECE(^("HD"),"^"),1:$PIECE($PIECE(RTAPL,"^"),";",2))

           DO PTHD^RTUTL2

           DO EQUALS^RTUTL3

           KILL X1

 +2        IF $DATA(DFN)

               WRITE !!,"[ Clinic History Profile ]",!?3,"Clinic",?30,"Appointment Date/Time",?55,"Status",!?3,"------",?30,"---------------------",?55,"------"

               QUIT 

 +3        WRITE !,"[SORT: ",$SELECT(RTSORT="M":"By date charged,record type display order and then volume",1:"By record type display order,volume and then date charged"),"]"

 +4        WRITE !!,"Date Charged",?20,"Vol",?25,"Borrower",?50,"Type of Movement",?70,"# of Days"

           DO LINE^RTUTL3

 +5        QUIT 

 +6       ;

HIS        FOR RTH=0:0

               SET RTH=$ORDER(^RTV(190.3,"B",RT,RTH))

               if 'RTH

                   QUIT 

               IF $DATA(^RTV(190.3,RTH,0))

                   SET RTH0=^(0)

                   DO SET

 +1        QUIT 

 +2       ;

SET        SET D=9999999.9999-$PIECE(RTH0,"^",6)

 +1        IF RTSORT="S"

               FOR Y=999:-1

                   IF '$DATA(^TMP($JOB,"RTRACE",O,V,D,Y))

                       SET ^(Y)=RTH0

                       QUIT 

 +2       ; the next line accounts for more than one movement transaction having

 +3       ; occurred within the same minute, while preserving the "reverse date"

 +4       ; sort order

 +5       ;

 +6        IF RTSORT'="S"

               FOR Y=999:-1

                   IF '$DATA(^TMP($JOB,"RTRACE",D,O,V,Y))

                       SET ^(Y)=RTH0

                       QUIT 

 +7        QUIT