RTT11 ;ISC-ALBANY/MJK,PKE-Record Transaction Option; ; 5/7/87 12:02 PM ;
;;v 2.0;Record Tracking;;10/22/91
;;multiple new Volume Creation
11 S RTA=+RTAPL D ASK^RTB K RTA G Q2:$D(RTESC),11:Y<0 S RTE=X D NEW G 11
NEW D SET1 I '$D(RTS) S Y=RTE D NAME^RTB W !!?3,*7,"...currently no volume #1 for ",Y,".",!,?3,"...use Create volume option." Q
;
W !!?5,"Record Type",?30,"Highest Volume Number",!?5,"------------",?30,"---------------------"
S RTC=0 F T=0:0 S T=$O(RTS(T)) Q:'T S RTC=RTC+1,X=RTS(T) W !?5,$P(X,"^",3),?40,+X
S:$D(RTTY) RTTYX=RTTY I RTC=1 S Y=+$O(RTS(0)) D TYPE1^RTUTL
I RTC>1 W ! S DIC="^DIC(195.2,",DIC("S")="I $D(RTS(+Y)),$S('$D(^(""I"")):1,'^(""I""):1,1:DT'>^(""I""))",DIC("A")="Select Record Type: ",DIC(0)="IAEMQZ" D ^DIC K DIC G SETQ:Y<0 S RTTY=+Y_";"_Y(0)
S X=RTS(+RTTY),RTVOL=X+1,RTPAR=+$P(X,"^",2)
S RTRD(1)="Yes^create new volumes",RTRD(2)="No^do not create new volumes",RTRD(0)="S",RTRD("B")=2,RTRD("A")="Create "_$P(X,"^",3)_" Volumes starting with # "_RTVOL_"? " D SET^RTRD K RTRD S X=$E(X) G SETQ:X'="Y"
RD W !," Enter the Highest volume # to create, Volume # ",RTVOL,"?// " R X:DTIME I '$T!(X["^") G SETQ
I X["?"!($E(X_1)'?1N) W !!,?5,"Enter a number between '",RTVOL,"' and '",RTVOL+5,"'",! G RD
S:X="" X=RTVOL I X<RTVOL!(X>(RTVOL+5)) G RD
;
S RTVOLL=X W !," .." F RTVOL=RTVOL:1:RTVOLL S RTSHOW="" D SET^RTDPA1 K RTSHOW
D ^RTT12
SETQ K RTESC,RTSHOW,RTC,T,V,RTPAR,RTVOL,RTVOLL,RT,RTTY,RTS S:$D(RTTYX) RTTY=RTTYX K RTTYX Q
;
SET1 F I=0:0 S I=$O(^RT("AA",+RTAPL,RTE,I)) Q:'I I $D(^RT(I,0)) S X=^(0),T=+$P(X,"^",3),V=+$P(X,"^",7) I $D(^DIC(195.2,T,0)),$P(^(0),"^",17)="y",$P(X,"^",4)=+RTAPL,$S('$D(RTTY):1,T=+RTTY:1,1:0) D SET2
Q
SET2 ;naked ref to the current record type ^DIC(195.2,x,0)
S:'$D(RTS(T)) RTS(T)=V_"^^"_$P(^(0),"^") S:V=1 $P(RTS(T),"^",2)=I S:+RTS(T)'>V $P(RTS(T),"^")=V Q
Q
Q2 K RTE,RTESC
K %,%YV,D0,DGO,DI,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DIYS,DK,DL,DR,I1,POP Q
12 ;select last record/volume to update pointers
W ! S DIC(0)="AZEMQ",RTSEL="" D ^RTDPA K DIC,RTESC,RTY,RTC G Q12:Y<0 S RT=+Y,RT0=Y(0),V=+$P(RT0,"^",7),P=$S(V=1:RT,1:+$P(RT0,"^",5)),T=+$P(RT0,"^",3) G 12:'P
;
S V1=0,I=0 F J=1:1 S I=$O(^RT("P",P,I)) Q:'I I $D(^RT(I,0)),$P(^(0),"^",7)>V1 S V1=+$P(^(0),"^",7)
I J<2 W !!?5,"No multiple volumes selected" G 12
I V1>V W !!?5,*7,"This record is volume '",V,"' of a '",V1,"' record set.",!?5,"Requests may only be transferred to volume, 'V",V1,"'" G 12
S RTPAR=P,RTVOL=V,Y=T D TYPE1^RTUTL I '$D(RTTY) W !!?5,"Unknown Record type" G 12
S Y=$P(RT0,"^") D NAME^RTB W !!,"Record Chosen: ",Y,"'s ",$S($D(^DIC(195.2,+$P(RT0,"^",3),0)):$P(^(0),"^"),1:"UNKNOWN")," [Volume: ",+$P(RT0,"^",7),"]"
;
S RTRD("A")="Pending Requests will be transferred to last Record/Volume just selected. "_$C(13,10)_" Transfer Requests to volume '"_RTVOL_"' ? "
D ^RTT12
;
Q12 K RTTY,RTVOL,RTPAR,RTDIK,RTI,RT,P,T,J,I,V,V1
K RT0,RTBCIFN,RTSEL,X Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTT11 2952 printed Dec 13, 2024@02:34:56 Page 2
RTT11 ;ISC-ALBANY/MJK,PKE-Record Transaction Option; ; 5/7/87 12:02 PM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
+2 ;;multiple new Volume Creation
11 SET RTA=+RTAPL
DO ASK^RTB
KILL RTA
if $DATA(RTESC)
GOTO Q2
if Y<0
GOTO 11
SET RTE=X
DO NEW
GOTO 11
NEW DO SET1
IF '$DATA(RTS)
SET Y=RTE
DO NAME^RTB
WRITE !!?3,*7,"...currently no volume #1 for ",Y,".",!,?3,"...use Create volume option."
QUIT
+1 ;
+2 WRITE !!?5,"Record Type",?30,"Highest Volume Number",!?5,"------------",?30,"---------------------"
+3 SET RTC=0
FOR T=0:0
SET T=$ORDER(RTS(T))
if 'T
QUIT
SET RTC=RTC+1
SET X=RTS(T)
WRITE !?5,$PIECE(X,"^",3),?40,+X
+4 if $DATA(RTTY)
SET RTTYX=RTTY
IF RTC=1
SET Y=+$ORDER(RTS(0))
DO TYPE1^RTUTL
+5 IF RTC>1
WRITE !
SET DIC="^DIC(195.2,"
SET DIC("S")="I $D(RTS(+Y)),$S('$D(^(""I"")):1,'^(""I""):1,1:DT'>^(""I""))"
SET DIC("A")="Select Record Type: "
SET DIC(0)="IAEMQZ"
DO ^DIC
KILL DIC
if Y<0
GOTO SETQ
SET RTTY=+Y_";"_Y(0)
+6 SET X=RTS(+RTTY)
SET RTVOL=X+1
SET RTPAR=+$PIECE(X,"^",2)
+7 SET RTRD(1)="Yes^create new volumes"
SET RTRD(2)="No^do not create new volumes"
SET RTRD(0)="S"
SET RTRD("B")=2
SET RTRD("A")="Create "_$PIECE(X,"^",3)_" Volumes starting with # "_RTVOL_"? "
DO SET^RTRD
KILL RTRD
SET X=$EXTRACT(X)
if X'="Y"
GOTO SETQ
RD WRITE !," Enter the Highest volume # to create, Volume # ",RTVOL,"?// "
READ X:DTIME
IF '$TEST!(X["^")
GOTO SETQ
+1 IF X["?"!($EXTRACT(X_1)'?1N)
WRITE !!,?5,"Enter a number between '",RTVOL,"' and '",RTVOL+5,"'",!
GOTO RD
+2 if X=""
SET X=RTVOL
IF X<RTVOL!(X>(RTVOL+5))
GOTO RD
+3 ;
+4 SET RTVOLL=X
WRITE !," .."
FOR RTVOL=RTVOL:1:RTVOLL
SET RTSHOW=""
DO SET^RTDPA1
KILL RTSHOW
+5 DO ^RTT12
SETQ KILL RTESC,RTSHOW,RTC,T,V,RTPAR,RTVOL,RTVOLL,RT,RTTY,RTS
if $DATA(RTTYX)
SET RTTY=RTTYX
KILL RTTYX
QUIT
+1 ;
SET1 FOR I=0:0
SET I=$ORDER(^RT("AA",+RTAPL,RTE,I))
if 'I
QUIT
IF $DATA(^RT(I,0))
SET X=^(0)
SET T=+$PIECE(X,"^",3)
SET V=+$PIECE(X,"^",7)
IF $DATA(^DIC(195.2,T,0))
IF $PIECE(^(0),"^",17)="y"
IF $PIECE(X,"^",4)=+RTAPL
IF $SELECT('$DATA(RTTY):1,T=+RTTY:1,1:0)
DO SET2
+1 QUIT
SET2 ;naked ref to the current record type ^DIC(195.2,x,0)
+1 if '$DATA(RTS(T))
SET RTS(T)=V_"^^"_$PIECE(^(0),"^")
if V=1
SET $PIECE(RTS(T),"^",2)=I
if +RTS(T)'>V
SET $PIECE(RTS(T),"^")=V
QUIT
+2 QUIT
Q2 KILL RTE,RTESC
+1 KILL %,%YV,D0,DGO,DI,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DIYS,DK,DL,DR,I1,POP
QUIT
12 ;select last record/volume to update pointers
+1 WRITE !
SET DIC(0)="AZEMQ"
SET RTSEL=""
DO ^RTDPA
KILL DIC,RTESC,RTY,RTC
if Y<0
GOTO Q12
SET RT=+Y
SET RT0=Y(0)
SET V=+$PIECE(RT0,"^",7)
SET P=$SELECT(V=1:RT,1:+$PIECE(RT0,"^",5))
SET T=+$PIECE(RT0,"^",3)
if 'P
GOTO 12
+2 ;
+3 SET V1=0
SET I=0
FOR J=1:1
SET I=$ORDER(^RT("P",P,I))
if 'I
QUIT
IF $DATA(^RT(I,0))
IF $PIECE(^(0),"^",7)>V1
SET V1=+$PIECE(^(0),"^",7)
+4 IF J<2
WRITE !!?5,"No multiple volumes selected"
GOTO 12
+5 IF V1>V
WRITE !!?5,*7,"This record is volume '",V,"' of a '",V1,"' record set.",!?5,"Requests may only be transferred to volume, 'V",V1,"'"
GOTO 12
+6 SET RTPAR=P
SET RTVOL=V
SET Y=T
DO TYPE1^RTUTL
IF '$DATA(RTTY)
WRITE !!?5,"Unknown Record type"
GOTO 12
+7 SET Y=$PIECE(RT0,"^")
DO NAME^RTB
WRITE !!,"Record Chosen: ",Y,"'s ",$SELECT($DATA(^DIC(195.2,+$PIECE(RT0,"^",3),0)):$PIECE(^(0),"^"),1:"UNKNOWN")," [Volume: ",+$PIECE(RT0,"^",7),"]"
+8 ;
+9 SET RTRD("A")="Pending Requests will be transferred to last Record/Volume just selected. "_$CHAR(13,10)_" Transfer Requests to volume '"_RTVOL_"' ? "
+10 DO ^RTT12
+11 ;
Q12 KILL RTTY,RTVOL,RTPAR,RTDIK,RTI,RT,P,T,J,I,V,V1
+1 KILL RT0,RTBCIFN,RTSEL,X
QUIT
+2 QUIT
