RTT3 ;MJK/TROY ISC;Record Transaction Selection Utility; ; 5/18/87 9:44 AM ;
;;v 2.0;Record Tracking;;10/22/91
;
SEL S DIC("S")="I $P(^(0),U,4)=+RTAPL,$S('$D(RTTY):1,$P(^RT(+Y,0),U,3)=+RTTY:1,1:0)",Y=$P(RTMV0,"^")
S:Y["CHECK-IN" DIC("S")=DIC("S")_",$D(^DIC(195.2,""AF"","_RTB_",+$P(^RT(+Y,0),U,3)))"
I $D(RTINACFL),'RTINACFL S DIC("S")=DIC("S")_",$S('$D(^(""I"")):0,'^(""I""):0,DT>^(""I""):1,1:0)"
I $D(RTINACFL),RTINACFL S DIC("S")=DIC("S")_",$S('$D(^(""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0)"
K RTESC,RTBCIFN,RTDEL R !!,"Select Record: ",X:DTIME D HELP:$E(X)="?" G SEL:'$D(X),SELQ:X=""!(X["^") S:$E(X)="-" (RTPROV,RTDEL)="",X=$E(X,2,99)
S RTSEL="SDO",DIC(0)="IEMQ" K RTY D RT^RTDPA
I $P(RTMV0,"^")'["RE-CHARGE",$D(RTY),RTC=1,$D(RTFR),$S('$D(RTBCIFN):1,1:RTBCIFN="n"),'$D(RTDEL) S RT=RTY(1) D BC^RTT4 G SEL:$D(RTESC)
I $D(RTY) D ASSCO^RTDPA3:'$D(RTDEL) F RTY=0:0 S RTY=$O(RTY(RTY)) Q:'RTY S RT=+RTY(RTY) D CHK:'$D(RTDEL) I $D(RT) S Y("M")=$P(RTMV0,"^",2),Y=RT_"^"_$S($D(RTPROV):RTPROV,1:"")_"^"_$S($D(RTBCIFN):RTBCIFN,1:"n") D ARRAY1^RTUTL1 K RTBCIFN
K Y,RTZ,RTY,RT G SEL
SELQ I X["^",RTN S Y=$P(RTMV0,"^",2) D ASK I $E(X)'="Y" S RTJST=1 G SELQ1
K RTN1 D QUE^RTT4:RTN>$P(RTSYS,"^",2) G SELQ1:'RTN!(RTN>$P(RTSYS,"^",2)) W !!,RTN," Selected record",$S(RTN>1:"s",1:"")," will now be ",$P(RTMV0,"^",2),"..."
K DIC S RTN1=RTN F RTN=0:0 S RTN=$O(^TMP($J,"RT","AR",RTN)) Q:'RTN S Y=^(RTN) D PARSE^RTT W "."
S RTN=RTN1
SELQ1 I $D(RTN1) W !?3,RTN1," ...record",$S(RTN1>1:"s have",1:" has")," been ",$S(RTN1>$P(RTSYS,"^",2):"QUEUED to be ",1:""),$P(RTMV0,"^",2) S Y=RTB D BOR^RTB W " to '",Y,"'."
K RTESC,RTBCIFN,RTPROVFL,RTPROV,DIC,RTN1,RTY,RTC,RTE,RT,RTDEL,RTSEL Q
;
HELP Q:'RTN S X="Y",RTLC=4,RTIOSL=$S('$D(IOSL):24,'IOSL:24,1:IOSL)
W !!,"Records selected to be ",$P(RTMV0,"^",2),":",!,"Record #",?10,"Name",?40,"Record Type",?65,"Vol",!,"--------",?10,"----",?40,"-----------",?65,"---"
F N=0:0 S N=$O(^TMP($J,"RT","AR",N)) Q:'N S Y=+^(N) D SHOW Q:X'="Y"
D DEL:X="Y",MORE^RTB2:X="Y"&(RTLC>1) S X=$S($E(X)="Y":"?",1:"") K:X'="?" X K RTLC,RTIOSL,N,RT,E,T,S,V,Y Q
SHOW G SHOWQ:'$D(^RT(Y,0)) W !?3,Y S X=^(0),T=$S($D(^DIC(195.2,+$P(X,"^",3),0)):$P(^(0),"^"),1:"UNKNOWN"),V=+$P(X,"^",7),E=$P(X,"^"),S="",Y=E D NAME^RTB I $P(E,";",2)="DPT(",$D(^DPT(+E,0)) S S=$E($P(^(0),"^",9),6,10)
W ?10,$E(Y,1,20),?31,S,?40,$E(T,1,20),?65,V S RTLC=RTLC+1
SHOWQ S X="Y" Q:RTLC'>RTIOSL D MORE^RTB2 S RTLC=1,X=$E(X) Q
;
CHK S RTZ("RT")=RT D CHKIN^RTT4:$P(RTMV0,"^")["CHECK-IN",MISS1^RTQ1
I '$D(RT),$S('$D(^DIC(195.2,+$P(^RT(RTZ("RT"),0),"^",3),0)):1,1:$P(^(0),"^",7)'="a"),'$D(^XUSEC($S($P(RTAPL,"^",8)]"":$P(RTAPL,"^",8),1:"RTZ XXX"),DUZ)) S RT=RTZ("RT") K RTZ D BULL^RTT2 K RT Q
I '$D(RT) S RT=RTZ("RT"),RTZ1="RTB^RTMV^RTMV0" D SAVE^RTUTL1,FND^RTT2,RESTORE^RTUTL1 K:$S('$D(^RTV(195.9,+$P(^RT(RT,"CL"),"^",5),0)):0,$P(^(0),"^")="2;DIC(195.4,":1,1:0) RT Q
G PND:'$D(^RT(RT,"CL")),PND:$P(^("CL"),"^",5)'=RTB S Y=$S($D(^DIC(195.3,+$P(^("CL"),"^",8),0)):$P(^(0),"^"),1:"") G PND:Y["FOUND RECORD"!(Y["INITIAL") S Y=$P(RTMV0,"^")
I Y'["RE-ACTIVATE" D DEMOS^RTUTL1 W !,*7,RTD("N"),"'s ",RTD("T"),"is already charged to " K RTD S Y=+RTB D BOR^RTB W Y,"." D PND K RT Q
PND S Y=$P(RTMV0,"^") Q:Y'["CHARGE-OUT"&(Y'["CHECK-IN") S RTSAVE="" D PND^RTT2 K RTSAVE Q
;
ASK S RTRD(1)="Yes^"_Y_" records",RTRD(2)="No^abort all processing",RTRD("B")=2,RTRD("A")="Do you still wish to '"_Y_"' selected records? ",RTRD(0)="S" D SET^RTRD K RTRD Q
;
DEL W !!?3,"Also, you can delete a selected record by entering a",!?3,"'minus' sign(-) before the record number (eg. Select Record: -342)." Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTT3 3618 printed Apr 09, 2024@21:36:08 Page 2
RTT3 ;MJK/TROY ISC;Record Transaction Selection Utility; ; 5/18/87 9:44 AM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
+2 ;
SEL SET DIC("S")="I $P(^(0),U,4)=+RTAPL,$S('$D(RTTY):1,$P(^RT(+Y,0),U,3)=+RTTY:1,1:0)"
SET Y=$PIECE(RTMV0,"^")
+1 if Y["CHECK-IN"
SET DIC("S")=DIC("S")_",$D(^DIC(195.2,""AF"","_RTB_",+$P(^RT(+Y,0),U,3)))"
+2 IF $DATA(RTINACFL)
IF 'RTINACFL
SET DIC("S")=DIC("S")_",$S('$D(^(""I"")):0,'^(""I""):0,DT>^(""I""):1,1:0)"
+3 IF $DATA(RTINACFL)
IF RTINACFL
SET DIC("S")=DIC("S")_",$S('$D(^(""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0)"
+4 KILL RTESC,RTBCIFN,RTDEL
READ !!,"Select Record: ",X:DTIME
if $EXTRACT(X)="?"
DO HELP
if '$DATA(X)
GOTO SEL
if X=""!(X["^")
GOTO SELQ
if $EXTRACT(X)="-"
SET (RTPROV,RTDEL)=""
SET X=$EXTRACT(X,2,99)
+5 SET RTSEL="SDO"
SET DIC(0)="IEMQ"
KILL RTY
DO RT^RTDPA
+6 IF $PIECE(RTMV0,"^")'["RE-CHARGE"
IF $DATA(RTY)
IF RTC=1
IF $DATA(RTFR)
IF $SELECT('$DATA(RTBCIFN):1,1:RTBCIFN="n")
IF '$DATA(RTDEL)
SET RT=RTY(1)
DO BC^RTT4
if $DATA(RTESC)
GOTO SEL
+7 IF $DATA(RTY)
if '$DATA(RTDEL)
DO ASSCO^RTDPA3
FOR RTY=0:0
SET RTY=$ORDER(RTY(RTY))
if 'RTY
QUIT
SET RT=+RTY(RTY)
if '$DATA(RTDEL)
DO CHK
IF $DATA(RT)
SET Y("M")=$PIECE(RTMV0,"^",2)
SET Y=RT_"^"_$SELECT($DATA(RTPROV):RTPROV,1:"")_"^"_$SELECT($DATA(RTBCIFN):RTBCIFN,1:"n")
DO ARRAY1^RTUTL1
KILL RTBCIFN
+8 KILL Y,RTZ,RTY,RT
GOTO SEL
SELQ IF X["^"
IF RTN
SET Y=$PIECE(RTMV0,"^",2)
DO ASK
IF $EXTRACT(X)'="Y"
SET RTJST=1
GOTO SELQ1
+1 KILL RTN1
if RTN>$PIECE(RTSYS,"^",2)
DO QUE^RTT4
if 'RTN!(RTN>$PIECE(RTSYS,"^",2))
GOTO SELQ1
WRITE !!,RTN," Selected record",$SELECT(RTN>1:"s",1:"")," will now be ",$PIECE(RTMV0,"^",2),"..."
+2 KILL DIC
SET RTN1=RTN
FOR RTN=0:0
SET RTN=$ORDER(^TMP($JOB,"RT","AR",RTN))
if 'RTN
QUIT
SET Y=^(RTN)
DO PARSE^RTT
WRITE "."
+3 SET RTN=RTN1
SELQ1 IF $DATA(RTN1)
WRITE !?3,RTN1," ...record",$SELECT(RTN1>1:"s have",1:" has")," been ",$SELECT(RTN1>$PIECE(RTSYS,"^",2):"QUEUED to be ",1:""),$PIECE(RTMV0,"^",2)
SET Y=RTB
DO BOR^RTB
WRITE " to '",Y,"'."
+1 KILL RTESC,RTBCIFN,RTPROVFL,RTPROV,DIC,RTN1,RTY,RTC,RTE,RT,RTDEL,RTSEL
QUIT
+2 ;
HELP if 'RTN
QUIT
SET X="Y"
SET RTLC=4
SET RTIOSL=$SELECT('$DATA(IOSL):24,'IOSL:24,1:IOSL)
+1 WRITE !!,"Records selected to be ",$PIECE(RTMV0,"^",2),":",!,"Record #",?10,"Name",?40,"Record Type",?65,"Vol",!,"--------",?10,"----",?40,"-----------",?65,"---"
+2 FOR N=0:0
SET N=$ORDER(^TMP($JOB,"RT","AR",N))
if 'N
QUIT
SET Y=+^(N)
DO SHOW
if X'="Y"
QUIT
+3 if X="Y"
DO DEL
if X="Y"&(RTLC>1)
DO MORE^RTB2
SET X=$SELECT($EXTRACT(X)="Y":"?",1:"")
if X'="?"
KILL X
KILL RTLC,RTIOSL,N,RT,E,T,S,V,Y
QUIT
SHOW if '$DATA(^RT(Y,0))
GOTO SHOWQ
WRITE !?3,Y
SET X=^(0)
SET T=$SELECT($DATA(^DIC(195.2,+$PIECE(X,"^",3),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
SET V=+$PIECE(X,"^",7)
SET E=$PIECE(X,"^")
SET S=""
SET Y=E
DO NAME^RTB
IF $PIECE(E,";",2)="DPT("
IF $DATA(^DPT(+E,0))
SET S=$EXTRACT($PIECE(^(0),"^",9),6,10)
+1 WRITE ?10,$EXTRACT(Y,1,20),?31,S,?40,$EXTRACT(T,1,20),?65,V
SET RTLC=RTLC+1
SHOWQ SET X="Y"
if RTLC'>RTIOSL
QUIT
DO MORE^RTB2
SET RTLC=1
SET X=$EXTRACT(X)
QUIT
+1 ;
CHK SET RTZ("RT")=RT
if $PIECE(RTMV0,"^")["CHECK-IN"
DO CHKIN^RTT4
DO MISS1^RTQ1
+1 IF '$DATA(RT)
IF $SELECT('$DATA(^DIC(195.2,+$PIECE(^RT(RTZ("RT"),0),"^",3),0)):1,1:$PIECE(^(0),"^",7)'="a")
IF '$DATA(^XUSEC($SELECT($PIECE(RTAPL,"^",8)]"":$PIECE(RTAPL,"^",8),1:"RTZ XXX"),DUZ))
SET RT=RTZ("RT")
KILL RTZ
DO BULL^RTT2
KILL RT
QUIT
+2 IF '$DATA(RT)
SET RT=RTZ("RT")
SET RTZ1="RTB^RTMV^RTMV0"
DO SAVE^RTUTL1
DO FND^RTT2
DO RESTORE^RTUTL1
if $SELECT('$DATA(^RTV(195.9,+$PIECE(^RT(RT,"CL"),"^",5),0))
KILL RT
QUIT
+3 if '$DATA(^RT(RT,"CL"))
GOTO PND
if $PIECE(^("CL"),"^",5)'=RTB
GOTO PND
SET Y=$SELECT($DATA(^DIC(195.3,+$PIECE(^("CL"),"^",8),0)):$PIECE(^(0),"^"),1:"")
if Y["FOUND RECORD"!(Y["INITIAL")
GOTO PND
SET Y=$PIECE(RTMV0,"^")
+4 IF Y'["RE-ACTIVATE"
DO DEMOS^RTUTL1
WRITE !,*7,RTD("N"),"'s ",RTD("T"),"is already charged to "
KILL RTD
SET Y=+RTB
DO BOR^RTB
WRITE Y,"."
DO PND
KILL RT
QUIT
PND SET Y=$PIECE(RTMV0,"^")
if Y'["CHARGE-OUT"&(Y'["CHECK-IN")
QUIT
SET RTSAVE=""
DO PND^RTT2
KILL RTSAVE
QUIT
+1 ;
ASK SET RTRD(1)="Yes^"_Y_" records"
SET RTRD(2)="No^abort all processing"
SET RTRD("B")=2
SET RTRD("A")="Do you still wish to '"_Y_"' selected records? "
SET RTRD(0)="S"
DO SET^RTRD
KILL RTRD
QUIT
+1 ;
DEL WRITE !!?3,"Also, you can delete a selected record by entering a",!?3,"'minus' sign(-) before the record number (eg. Select Record: -342)."
QUIT
+1 ;
