RTT1 ;MJK/TROY ISC;Record Transaction Option; ; 5/7/87 12:02 PM ;
;;v 2.0;Record Tracking;;10/22/91
2 ;;New Volume Creation
S RTA=+RTAPL D ASK^RTB K RTA G Q2:$D(RTESC),2:Y<0 S RTE=X D NEW G 2
NEW D SET1 I '$D(RTS) S Y=RTE D NAME^RTB W !!?3,*7,"...currently no volume #1 for ",Y,"." 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 volume",RTRD(2)="No^do not create new volume",RTRD(0)="S",RTRD("B")=2,RTRD("A")="Do you want to create "_$P(X,"^",3)_" VOL # "_RTVOL_"? " D SET^RTRD K RTRD S X=$E(X) G SETQ:X'="Y"
S RTSHOW="" D SET^RTDPA1 K RTSHOW
D ^RTT12
SETQ K RTESC,RTC,T,V,RTPAR,RTVOL,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 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
;
Q2 K DIE,RTE,RTESC,DR,DIC,DA Q
;
7 ;;Flag Record as Missing
I $S($P(RTAPL,"^",8)']"":1,'$D(^XUSEC($P(RTAPL,"^",8),DUZ)):1,1:0) W !!?3,*7,"...you are not authorized to use this option" Q
I '$D(RTDIV) D DIV1^RTPSET I '$D(RTDIV) D MES^RTP4 Q
K RTB,RT,RTESC S DIC("A")="Select Missing Record: ",DIC(0)="IAEMLZQ",RTSEL="" D ^RTDPA K DIC,RTSEL G Q7:'$D(RT)
I $D(^RTV(190.2,"AM","s",RT)) S I=+$O(^(RT,0)) D APP G 7
I $D(^RTV(190.2,"AM","m",RT)) W !!,"This record is already flagged as missing." D FND^RTT2 S X="FOUND RECORD" D TYPE^RTT G 7:'$D(RTMV) D:'$D(^RTV(190.2,"AM","m",RT)) PND K RTMV,RTMV0 G 7
S RTRD(1)="Yes^flag record as missing",RTRD(2)="No^do not flag record as being missing",RTRD(0)="S",RTRD("B")=2
S RTRD("A")="Are you sure you want to flag this record as missing? " D SET^RTRD K RTRD G 7:$E(X)'="Y"
D NOW^%DTC S RTNOW=%,I=$P(^RTV(190.2,0),"^",3)
LOCK S I=I+1 S:$L(I)=4 I=10000 L +^RTV(190.2,I):1 I '$T!$D(^RTV(190.2,I)) L -^RTV(190.2,I) G LOCK
S ^RTV(190.2,I,0)=RT,^RTV(190.2,"B",RT,I)="",^(0)=$P(^RTV(190.2,0),"^",1,2)_"^"_I_"^"_($P(^(0),"^",4)+1),^DISV($S($D(DUZ)'[0:DUZ,1:0),"^RTV(190.2,")=I L -^RTV(190.2,I)
D MISS G 7
;
MISS S X="MISSING RECORD" D TYPE^RTT I '$D(RTMV) W !!,*7,"ERROR -- record has not been flagged as missing" Q
S RTB=+$O(^RTV(195.9,"B","2;DIC(195.4,",0)),DA=I,DIE="^RTV(190.2,",DR="[RT MISSING]" D ^DIE K RTNOW,DQ,DE D CHG^RTT Q:$D(Y)
S XMB="RT MISSING RECORD",RT0=^RT(RT,0),Y=$P(RT0,"^") D NAME^RTB S XMB(1)=Y,XMB(2)=$S($D(^DIC(195.2,+$P(RT0,"^",3),0)):$P(^(0),"^"),1:"UNKNOWN"),XMB(3)=+$P(RT0,"^",7),XMB(4)=$P($P(RTAPL,"^"),";",2)
S XMB(5)=$S($P(RT0,";",2)["DPT(":"Social Securtiy : "_$S($D(^DPT(+RT0,0)):$P(^(0),"^",9),1:""),1:" ") K RT0
D SEND^RTT2 K XMB,M,I W !?3,"...record has been flagged as missing" Q
;
Q7 K RTBCIFN,RTMIS,RTMV,RTMV0,RT,RTB,RTESC,T,Y
K %H,%X,%Y,%YV,D0,DA,DGO,DI,DIC1,DIE,DIYS,DK,DL,DR,DWLW,I1,N,POP,RTC,RTY,X1 Q
APP Q:'$D(^RTV(190.2,I,0)) S RTMIS=I
S RTRD(1)="Approve^approve the finding of the record",RTRD(2)="Disapprove^disapprove the finding of the record by the user",RTRD(3)="No Action^take no action at this time",RTRD("B")=3,RTRD(0)="S"
S RTRD("A")="Do you want to approve/disapprove the finding of the record? " D SET^RTRD K RTRD S X=$E(X) G APPQ:X="N"!(X="^")
I X="A" S X="FOUND RECORD" D TYPE^RTT,FND1^RTT2:$D(RTMV) G APPQ
D NOW^%DTC S RTNOW=%,I=RTMIS D MISS
APPQ K RTMV,RTMV0,RTMIS Q
;
PND D PND^RTRPT S RTWND=2860101 F T=0:0 S T=$O(RTWND(T)) Q:'T S RTWND(T)=2860101
D PND^RTT2 K RTWND Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTT1 3954 printed Apr 09, 2024@21:37:17 Page 2
RTT1 ;MJK/TROY ISC;Record Transaction Option; ; 5/7/87 12:02 PM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
2 ;;New Volume Creation
+1 SET RTA=+RTAPL
DO ASK^RTB
KILL RTA
if $DATA(RTESC)
GOTO Q2
if Y<0
GOTO 2
SET RTE=X
DO NEW
GOTO 2
NEW DO SET1
IF '$DATA(RTS)
SET Y=RTE
DO NAME^RTB
WRITE !!?3,*7,"...currently no volume #1 for ",Y,"."
QUIT
+1 WRITE !!?5,"Record Type",?30,"Highest Volume Number",!?5,"------------",?30,"---------------------"
+2 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
+3 if $DATA(RTTY)
SET RTTYX=RTTY
IF RTC=1
SET Y=+$ORDER(RTS(0))
DO TYPE1^RTUTL
+4 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)
+5 SET X=RTS(+RTTY)
SET RTVOL=X+1
SET RTPAR=+$PIECE(X,"^",2)
+6 SET RTRD(1)="Yes^create new volume"
SET RTRD(2)="No^do not create new volume"
SET RTRD(0)="S"
SET RTRD("B")=2
SET RTRD("A")="Do you want to create "_$PIECE(X,"^",3)_" VOL # "_RTVOL_"? "
DO SET^RTRD
KILL RTRD
SET X=$EXTRACT(X)
if X'="Y"
GOTO SETQ
+7 SET RTSHOW=""
DO SET^RTDPA1
KILL RTSHOW
+8 DO ^RTT12
SETQ KILL RTESC,RTC,T,V,RTPAR,RTVOL,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 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
+1 ;
Q2 KILL DIE,RTE,RTESC,DR,DIC,DA
QUIT
+1 ;
7 ;;Flag Record as Missing
+1 IF $SELECT($PIECE(RTAPL,"^",8)']"":1,'$DATA(^XUSEC($PIECE(RTAPL,"^",8),DUZ)):1,1:0)
WRITE !!?3,*7,"...you are not authorized to use this option"
QUIT
+2 IF '$DATA(RTDIV)
DO DIV1^RTPSET
IF '$DATA(RTDIV)
DO MES^RTP4
QUIT
+3 KILL RTB,RT,RTESC
SET DIC("A")="Select Missing Record: "
SET DIC(0)="IAEMLZQ"
SET RTSEL=""
DO ^RTDPA
KILL DIC,RTSEL
if '$DATA(RT)
GOTO Q7
+4 IF $DATA(^RTV(190.2,"AM","s",RT))
SET I=+$ORDER(^(RT,0))
DO APP
GOTO 7
+5 IF $DATA(^RTV(190.2,"AM","m",RT))
WRITE !!,"This record is already flagged as missing."
DO FND^RTT2
SET X="FOUND RECORD"
DO TYPE^RTT
if '$DATA(RTMV)
GOTO 7
if '$DATA(^RTV(190.2,"AM","m",RT))
DO PND
KILL RTMV,RTMV0
GOTO 7
+6 SET RTRD(1)="Yes^flag record as missing"
SET RTRD(2)="No^do not flag record as being missing"
SET RTRD(0)="S"
SET RTRD("B")=2
+7 SET RTRD("A")="Are you sure you want to flag this record as missing? "
DO SET^RTRD
KILL RTRD
if $EXTRACT(X)'="Y"
GOTO 7
+8 DO NOW^%DTC
SET RTNOW=%
SET I=$PIECE(^RTV(190.2,0),"^",3)
LOCK SET I=I+1
if $LENGTH(I)=4
SET I=10000
LOCK +^RTV(190.2,I):1
IF '$TEST!$DATA(^RTV(190.2,I))
LOCK -^RTV(190.2,I)
GOTO LOCK
+1 SET ^RTV(190.2,I,0)=RT
SET ^RTV(190.2,"B",RT,I)=""
SET ^(0)=$PIECE(^RTV(190.2,0),"^",1,2)_"^"_I_"^"_($PIECE(^(0),"^",4)+1)
SET ^DISV($SELECT($DATA(DUZ)'[0:DUZ,1:0),"^RTV(190.2,")=I
LOCK -^RTV(190.2,I)
+2 DO MISS
GOTO 7
+3 ;
MISS SET X="MISSING RECORD"
DO TYPE^RTT
IF '$DATA(RTMV)
WRITE !!,*7,"ERROR -- record has not been flagged as missing"
QUIT
+1 SET RTB=+$ORDER(^RTV(195.9,"B","2;DIC(195.4,",0))
SET DA=I
SET DIE="^RTV(190.2,"
SET DR="[RT MISSING]"
DO ^DIE
KILL RTNOW,DQ,DE
DO CHG^RTT
if $DATA(Y)
QUIT
+2 SET XMB="RT MISSING RECORD"
SET RT0=^RT(RT,0)
SET Y=$PIECE(RT0,"^")
DO NAME^RTB
SET XMB(1)=Y
SET XMB(2)=$SELECT($DATA(^DIC(195.2,+$PIECE(RT0,"^",3),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
SET XMB(3)=+$PIECE(RT0,"^",7)
SET XMB(4)=$PIECE($PIECE(RTAPL,"^"),";",2)
+3 SET XMB(5)=$SELECT($PIECE(RT0,";",2)["DPT(":"Social Securtiy : "_$SELECT($DATA(^DPT(+RT0,0)):$PIECE(^(0),"^",9),1:""),1:" ")
KILL RT0
+4 DO SEND^RTT2
KILL XMB,M,I
WRITE !?3,"...record has been flagged as missing"
QUIT
+5 ;
Q7 KILL RTBCIFN,RTMIS,RTMV,RTMV0,RT,RTB,RTESC,T,Y
+1 KILL %H,%X,%Y,%YV,D0,DA,DGO,DI,DIC1,DIE,DIYS,DK,DL,DR,DWLW,I1,N,POP,RTC,RTY,X1
QUIT
APP if '$DATA(^RTV(190.2,I,0))
QUIT
SET RTMIS=I
+1 SET RTRD(1)="Approve^approve the finding of the record"
SET RTRD(2)="Disapprove^disapprove the finding of the record by the user"
SET RTRD(3)="No Action^take no action at this time"
SET RTRD("B")=3
SET RTRD(0)="S"
+2 SET RTRD("A")="Do you want to approve/disapprove the finding of the record? "
DO SET^RTRD
KILL RTRD
SET X=$EXTRACT(X)
if X="N"!(X="^")
GOTO APPQ
+3 IF X="A"
SET X="FOUND RECORD"
DO TYPE^RTT
if $DATA(RTMV)
DO FND1^RTT2
GOTO APPQ
+4 DO NOW^%DTC
SET RTNOW=%
SET I=RTMIS
DO MISS
APPQ KILL RTMV,RTMV0,RTMIS
QUIT
+1 ;
PND DO PND^RTRPT
SET RTWND=2860101
FOR T=0:0
SET T=$ORDER(RTWND(T))
if 'T
QUIT
SET RTWND(T)=2860101
+1 DO PND^RTT2
KILL RTWND
QUIT
