source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTQ.m@ 1604

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

initial load of WorldVistAEHR

File size: 3.9 KB
RevLine 
[613]1RTQ ;MJK/TROY ISC;Record Request Option; ; 5/5/87 8:41 AM ;
2 ;;v 2.0;Record Tracking;**8,23,26**;10/22/91
3 D DT^DICRW S X=$T(+1),DIK="^DOPT("""_$P(X," ;",1)_""","
4 G:$D(^DOPT($P(X," ;"),5)) A S ^DOPT($P(X," ;"),0)=$P(X,";",3)_"^1N^" F I=1:1 S Y=$T(@I) Q:Y="" S ^DOPT($P(X," ;"),I,0)=$P(Y,";",3,99)
5 D IXALL^DIK
6A D OVERALL^RTPSET Q:$D(XQUIT)
7 W !! S DIC="^DOPT("""_$P($T(+1)," ;")_""",",DIC(0)="IQEAM" D ^DIC Q:Y<0 D @+Y G A
8 ;
91 ;;Request a Record
10 I '$D(RTAPL) D APL2^RTPSET D NEXT1:$D(RTAPL) K RTAPL,RTSYS Q
11NEXT1 D PND^RTRPT I '$D(RTDIV) D DIV1^RTPSET I '$D(RTDIV) D MES^RTP4 G Q1
12L1 K RTY S RTSEL="DSO",DIC(0)="IAEMQ",DIC("S")="I $P(^(0),U,4)=+RTAPL,$S('$D(RTTY):1,$P(^RT(+Y,0),U,3)=+RTTY:1,1:0),$D(^DIC(195.2,+$P(^RT(+Y,0),U,3),0)),$P(^(0),U,14)'=""n"""
13 D RT^RTDPA K RTBCIFN,RTC,RTSEL,DIC G Q1:'$D(RTY)
14 S RTQDC("S")="S Z=^(0) I $P(Z,U,6)=""r""!($P(Z,U,6)=""n"") D SCRN1^RTQ" S RTSHOW=""
15 F RTY=0:0 S RTY=$O(RTY(RTY)) Q:'RTY S RT=+RTY(RTY) I $D(^RT(RT,0)) S RTE=$P(^(0),"^") D RT^RTUTL4 K RTS,RTC D MISS^RTQ1 I $D(RT) D SET Q:'$D(RTQ) K RTQ W !?3,"...request filed"
16 K RTIX,RTQDT,RTINST,RTB,RTSEL,RTQDC,RTY,RT,RTSHOW,RTE G L1
17Q1 K RTWND,RTESC,J,I,RTDUZ,Y
18 K DA,D0,DIE,DR,A,N,P,RTX,X1,X,Y Q
192 ;;Edit Request
20 G 2^RTQ4
21 ;
223 ;;Cancel a Request
23 G 3^RTQ41
24 ;
254 ;;Fill a Request
26 G 4^RTQ4
27 ;
285 ;;Re-Print a Request Notice
29 G 5^RTQ41
30 ;
316 ;;Display a Request
32 W ! S DIC="^RTV(190.1,",DIC(0)="AEMQ",DIC("A")="Select Request: "
33 D ^DIC I Y'<0 S DA=+Y D EN^DIQ G 6
34 K DIC,X,Y,DA Q
35SET ;Entry pt with RT defined/optionally RTB,RTPUL,RTPAR,RTSHOW and RTQDT defined
36 D NOW^%DTC S RTNOW=%,I=$P(^RTV(190.1,0),"^",3)
37LOCK S I=I+1 S:$L(I)=4 I=10000 L +^RTV(190.1,I):1 I '$T!$D(^RTV(190.1,I)) L -^RTV(190.1,I) G LOCK
38 S ^RTV(190.1,I,0)=RT,^RTV(190.1,"B",RT,I)="",^(0)=$P(^RTV(190.1,0),"^",1,2)_"^"_I_"^"_($P(^(0),"^",4)+1),^DISV($S($D(DUZ)'[0:DUZ,1:0),"^RTV(190.1,")=I L -^RTV(190.1,I)
39 ;S RTQ=I,W="REQ"_RTQ D CHAR^RTDPA S ^RTV(190.1,"BAR",W_C,RTQ)="" K W,C L
40 S (DA,RTQ)=I,DR="[RT REQUEST]",DIE="^RTV(190.1," D ^DIE K DQ,DE,RTNOW
41 I $D(Y),$D(^RTV(190.1,DA,0)) W:$D(RTSHOW) !?3,"...request not completed therefore it must be deleted" S DIK="^RTV(190.1," D ^DIK W:$D(RTSHOW) !?6,"...deletion complete." K DIK,DA,RTQ,RTFL Q
42 ;
43 ;R=requestor institution
44 ;C=current location institution
45 ;RTC1=current location
46 ;RTC2=central file room(both for R and C)
47 Q:'$D(^DIC(195.4,1,0)) Q:$P(^(0),"^",4)="e" S X=^RTV(190.1,RTQ,0) Q:$P($P(X,"^",4),".")'=DT S R=+$P(X,"^",12),C=0,A=+$P(^RT(+X,0),"^",4)
48 ;naked reference to records ^RT(n,"CL") node
49 I $D(^("CL")) S X=^("CL") S C=$S('$D(^RTV(190.1,+X,0)):0,'$D(^DIC(4,+$P(^(0),"^",12),0)):0,1:+$P(^RTV(190.1,+X,0),"^",12)) I 'C S X=$P(X,"^",5) D INST1^RTUTL I $D(RTINST) S C=RTINST K RTINST
50 K RTQL S RTC1=$S('$D(^RT(+^RTV(190.1,RTQ,0),"CL")):0,1:+$P(^("CL"),"^",5))
51 ;
52 I C,R=C G LOCKQ:'$D(^DIC(195.1,+RTAPL,"INST",C,0)) I $P(^(0),"^",4)="n",$D(^RTV(195.9,RTC1,0)),$P(^(0),"^",13)="F",$P(^(0),"^",5)]"" S Y=RTC1 D RTL1 G LOCKQ
53 F I=R,C I $D(^DIC(195.1,+RTAPL,"INST",I,0)) S RTC2=+$P(^(0),"^",2) S:RTC1=RTC2 RTC1=0 S Y=RTC2 D RTL1 Q:R=C
54 S Y=RTC1 D RTL1
55LOCKQ K RTQL,C,RTC1,RTC2,R Q
56 ;
57RTL1 Q:'$D(^RTV(195.9,Y,0)) S RTION=$P(^(0),"^",5) D RTQ^RTL1:$S(RTION']"":0,1:'$D(RTQL(RTION))) S:RTION]"" RTQL(RTION)="" K RTION Q
58 ;
59D W !!,"Request No. ",DA,":",! K I S $P(I,"-",(14+$L(DA)))="" W I K I Q
60 ;
61SCRN ;naked ref to the zero node of the request file entry ^rtv(190.1,,0)=z
62 I $S(DUZ=$P(^(0),U,3):1,$P(RTAPL,U,8)']"":0,1:$D(^XUSEC($P(RTAPL,U,8),DUZ))),$D(^RT(+Z,0)),$P(^(0),U,4)=+RTAPL,$D(RTWND(+$P(^(0),U,3))),RTWND(+$P(^(0),U,3))'>$P(Z,U,4) Q
63 I $S(DUZ=$P(Z,U,3):1,$P(RTAPL,U,7)']"":1,1:$D(^XUSEC($P(RTAPL,U,7),DUZ))),$D(^RT(+Z,0)),$P(^(0),U,4)=+RTAPL,$D(RTWND(+$P(^(0),U,3))),RTWND(+$P(^(0),U,3))'>$P(Z,U,4) Q
64 Q
65SCRN1 ;
66 I $D(^RT(+Z,0)),$P(^(0),U,4)=+RTAPL,$D(RTWND(+$P(^(0),U,3))),RTWND(+$P(^(0),U,3))'>$P(Z,U,4) Q
67 Q
68SCRN2 I $S(DUZ=$P(^(0),U,3):1,$P(RTAPL,U,7,8)=U:1,1:$D(^XUSEC($S($P(RTAPL,U,7)]"":$P(RTAPL,U,7),1:$P(RTAPL,U,8)),DUZ))),$D(^RT(+Z,0)),$P(^(0),U,4)=+RTAPL Q
69 Q
Note: See TracBrowser for help on using the repository browser.