Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RTMAS

RTMAS.m

Go to the documentation of this file.
  1. RTMAS ;MJK/TROY ISC;MAS Specific Setup Menu; ; 5/26/87 3:04 PM ;
  1. ;;v 2.0;Record Tracking;;10/22/91
  1. D DT^DICRW S X=$T(+1),DIK="^DOPT("""_$P(X," ;",1)_""","
  1. 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)
  1. D IXALL^DIK
  1. A S X="MAS" D ^RTPSET Q:$D(XQUIT)
  1. W !! S DIC="^DOPT("""_$P($T(+1)," ;")_""",",DIC(0)="IQEAM" D ^DIC Q:Y<0 D @+Y G A
  1. ;
  1. 1 ;;Admitting Area Set-up
  1. L1 D AA^RTSM I Y>0 D BOR^RTSYS G L1
  1. G Q2
  1. ;
  1. 2 ;;Fill Next Clinic Request
  1. S RTPGM="PT^RTMAS" D MAS^RTPSET1 Q
  1. ;
  1. 3 ;;Admitting Area Chart Request
  1. 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
  1. ;
  1. PT D PT^RTUTL3 G Q2:Y<0
  1. 21 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)
  1. ;;;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)
  1. 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)
  1. W !!,"Will now fill request"_$S(RTC>1:"s",1:"")_" selected..."
  1. F RTN=0:0 S RTN=$O(RTY(RTN)) Q:'RTN S RTQ=+RTY(RTN) D RTQ^RTQ4 K RTY
  1. G PT
  1. Q2 K RTY,RTC,RTJR,V,RTSEL,RTS,RTE,DFN,RTQDC,RTN,RTQ,RTJFL
  1. K POP,X1,A,N,Y,%,%H,%I,DIE,DA,D0,DR
  1. K RT,DUOUT Q
  1. CHK I $D(RTJR(V)) W !!?3,*7,"You are only allowed to fill one request per volume.",! H 2 S RTJFL="" Q
  1. S RTJR(V)="" Q
  1. ;