- 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 Mar 13, 2025@21:40:02 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
