source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTT1.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1RTT1 ;MJK/TROY ISC;Record Transaction Option; ; 5/7/87 12:02 PM ;
2 ;;v 2.0;Record Tracking;;10/22/91
32 ;;New Volume Creation
4 S RTA=+RTAPL D ASK^RTB K RTA G Q2:$D(RTESC),2:Y<0 S RTE=X D NEW G 2
5NEW D SET1 I '$D(RTS) S Y=RTE D NAME^RTB W !!?3,*7,"...currently no volume #1 for ",Y,"." Q
6 W !!?5,"Record Type",?30,"Highest Volume Number",!?5,"------------",?30,"---------------------"
7 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
8 S:$D(RTTY) RTTYX=RTTY I RTC=1 S Y=+$O(RTS(0)) D TYPE1^RTUTL
9 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)
10 S X=RTS(+RTTY),RTVOL=X+1,RTPAR=+$P(X,"^",2)
11 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"
12 S RTSHOW="" D SET^RTDPA1 K RTSHOW
13 D ^RTT12
14SETQ K RTESC,RTC,T,V,RTPAR,RTVOL,RT,RTTY,RTS S:$D(RTTYX) RTTY=RTTYX K RTTYX Q
15 ;
16SET1 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
17 Q
18SET2 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
19 ;
20Q2 K DIE,RTE,RTESC,DR,DIC,DA Q
21 ;
227 ;;Flag Record as Missing
23 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
24 I '$D(RTDIV) D DIV1^RTPSET I '$D(RTDIV) D MES^RTP4 Q
25 K RTB,RT,RTESC S DIC("A")="Select Missing Record: ",DIC(0)="IAEMLZQ",RTSEL="" D ^RTDPA K DIC,RTSEL G Q7:'$D(RT)
26 I $D(^RTV(190.2,"AM","s",RT)) S I=+$O(^(RT,0)) D APP G 7
27 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
28 S RTRD(1)="Yes^flag record as missing",RTRD(2)="No^do not flag record as being missing",RTRD(0)="S",RTRD("B")=2
29 S RTRD("A")="Are you sure you want to flag this record as missing? " D SET^RTRD K RTRD G 7:$E(X)'="Y"
30 D NOW^%DTC S RTNOW=%,I=$P(^RTV(190.2,0),"^",3)
31LOCK 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
32 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)
33 D MISS G 7
34 ;
35MISS S X="MISSING RECORD" D TYPE^RTT I '$D(RTMV) W !!,*7,"ERROR -- record has not been flagged as missing" Q
36 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)
37 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)
38 S XMB(5)=$S($P(RT0,";",2)["DPT(":"Social Securtiy : "_$S($D(^DPT(+RT0,0)):$P(^(0),"^",9),1:""),1:" ") K RT0
39 D SEND^RTT2 K XMB,M,I W !?3,"...record has been flagged as missing" Q
40 ;
41Q7 K RTBCIFN,RTMIS,RTMV,RTMV0,RT,RTB,RTESC,T,Y
42 K %H,%X,%Y,%YV,D0,DA,DGO,DI,DIC1,DIE,DIYS,DK,DL,DR,DWLW,I1,N,POP,RTC,RTY,X1 Q
43APP Q:'$D(^RTV(190.2,I,0)) S RTMIS=I
44 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"
45 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="^")
46 I X="A" S X="FOUND RECORD" D TYPE^RTT,FND1^RTT2:$D(RTMV) G APPQ
47 D NOW^%DTC S RTNOW=%,I=RTMIS D MISS
48APPQ K RTMV,RTMV0,RTMIS Q
49 ;
50PND D PND^RTRPT S RTWND=2860101 F T=0:0 S T=$O(RTWND(T)) Q:'T S RTWND(T)=2860101
51 D PND^RTT2 K RTWND Q
Note: See TracBrowser for help on using the repository browser.