source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTMAS.m@ 1078

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

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1RTMAS ;MJK/TROY ISC;MAS Specific Setup Menu; ; 5/26/87 3:04 PM ;
2 ;;v 2.0;Record Tracking;;10/22/91
3 D DT^DICRW S X=$T(+1),DIK="^DOPT("""_$P(X," ;",1)_""","
4 G:$D(^DOPT($P(X," ;"),3)) 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 S X="MAS" D ^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 ;;Admitting Area Set-up
10L1 D AA^RTSM I Y>0 D BOR^RTSYS G L1
11 G Q2
12 ;
132 ;;Fill Next Clinic Request
14 S RTPGM="PT^RTMAS" D MAS^RTPSET1 Q
15 ;
163 ;;Admitting Area Chart Request
17 W ! S DIC="^DPT(",DIC(0)="AEMQ" D ^DIC K DIC G Q2:Y<0 S DFN=+Y,DGFC="^" D ADM^RTQ3 K DFN,DGFC G 3
18 ;
19PT D PT^RTUTL3 G Q2:Y<0
2021 S RTSEL="S",RTQDC("S")="I $P($P(^(0),U,4),""."")=DT,$P(^(0),U,6)=""r""!($P(^(0),U,6)=""n""),$D(^RTV(195.9,+$P(^(0),U,5),0)),$P(^(0),U)[""SC("",$D(^SC(+^(0),0)),$P(^(0),U,3)=""C""" D ^RTUTL4 G PT:'$D(RTY)
21 ;;;F I=0:0 S I=$O(RTY(I)) Q:'I I $D(^RTV(190.1,+RTY(I),0)),$D(^RT(+^(0),0)) S V=+$P(^(0),"^",7) D CHK G 21:'$D(R)
22 F I=0:0 S I=$O(RTY(I)) Q:'I I $D(^RTV(190.1,+RTY(I),0)),$D(^RT(+^(0),0)) S V=+^RTV(190.1,+RTY(I),0) K RTJFL D CHK G 21:$D(RTJFL)
23 W !!,"Will now fill request"_$S(RTC>1:"s",1:"")_" selected..."
24 F RTN=0:0 S RTN=$O(RTY(RTN)) Q:'RTN S RTQ=+RTY(RTN) D RTQ^RTQ4 K RTY
25 G PT
26Q2 K RTY,RTC,RTJR,V,RTSEL,RTS,RTE,DFN,RTQDC,RTN,RTQ,RTJFL
27 K POP,X1,A,N,Y,%,%H,%I,DIE,DA,D0,DR
28 K RT,DUOUT Q
29CHK I $D(RTJR(V)) W !!?3,*7,"You are only allowed to fill one request per volume.",! H 2 S RTJFL="" Q
30 S RTJR(V)="" Q
31 ;
Note: See TracBrowser for help on using the repository browser.