- 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 Feb 19, 2025@00:01:26 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