RTMAS ;MJK/TROY ISC;MAS Specific Setup Menu; ; 5/26/87 3:04 PM ;
;;v 2.0;Record Tracking;;10/22/91
D DT^DICRW S X=$T(+1),DIK="^DOPT("""_$P(X," ;",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)
D IXALL^DIK
A S X="MAS" D ^RTPSET Q:$D(XQUIT)
W !! S DIC="^DOPT("""_$P($T(+1)," ;")_""",",DIC(0)="IQEAM" D ^DIC Q:Y<0 D @+Y G A
;
1 ;;Admitting Area Set-up
L1 D AA^RTSM I Y>0 D BOR^RTSYS G L1
G Q2
;
2 ;;Fill Next Clinic Request
S RTPGM="PT^RTMAS" D MAS^RTPSET1 Q
;
3 ;;Admitting Area Chart Request
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
;
PT D PT^RTUTL3 G Q2:Y<0
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)
;;;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)
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)
W !!,"Will now fill request"_$S(RTC>1:"s",1:"")_" selected..."
F RTN=0:0 S RTN=$O(RTY(RTN)) Q:'RTN S RTQ=+RTY(RTN) D RTQ^RTQ4 K RTY
G PT
Q2 K RTY,RTC,RTJR,V,RTSEL,RTS,RTE,DFN,RTQDC,RTN,RTQ,RTJFL
K POP,X1,A,N,Y,%,%H,%I,DIE,DA,D0,DR
K RT,DUOUT Q
CHK I $D(RTJR(V)) W !!?3,*7,"You are only allowed to fill one request per volume.",! H 2 S RTJFL="" Q
S RTJR(V)="" Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTMAS 1583 printed Dec 13, 2024@02:34:02 Page 2
RTMAS ;MJK/TROY ISC;MAS Specific Setup Menu; ; 5/26/87 3:04 PM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
+2 DO DT^DICRW
SET X=$TEXT(+1)
SET DIK="^DOPT("""_$PIECE(X," ;",1)_""","
+3 if $DATA(^DOPT($PIECE(X," ;"),3))
GOTO A
SET ^DOPT($PIECE(X," ;"),0)=$PIECE(X,";",3)_"^1N^"
FOR I=1:1
SET Y=$TEXT(@I)
if Y=""
QUIT
SET ^DOPT($PIECE(X," ;"),I,0)=$PIECE(Y,";",3,99)
+4 DO IXALL^DIK
A SET X="MAS"
DO ^RTPSET
if $DATA(XQUIT)
QUIT
+1 WRITE !!
SET DIC="^DOPT("""_$PIECE($TEXT(+1)," ;")_""","
SET DIC(0)="IQEAM"
DO ^DIC
if Y<0
QUIT
DO @+Y
GOTO A
+2 ;
1 ;;Admitting Area Set-up
L1 DO AA^RTSM
IF Y>0
DO BOR^RTSYS
GOTO L1
+1 GOTO Q2
+2 ;
2 ;;Fill Next Clinic Request
+1 SET RTPGM="PT^RTMAS"
DO MAS^RTPSET1
QUIT
+2 ;
3 ;;Admitting Area Chart Request
+1 WRITE !
SET DIC="^DPT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
if Y<0
GOTO Q2
SET DFN=+Y
SET DGFC="^"
DO ADM^RTQ3
KILL DFN,DGFC
GOTO 3
+2 ;
PT DO PT^RTUTL3
if Y<0
GOTO Q2
21 SET RTSEL="S"
SET 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"""
DO ^RTUTL4
if '$DATA(RTY)
GOTO PT
+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)
+2 FOR I=0:0
SET I=$ORDER(RTY(I))
if 'I
QUIT
IF $DATA(^RTV(190.1,+RTY(I),0))
IF $DATA(^RT(+^(0),0))
SET V=+^RTV(190.1,+RTY(I),0)
KILL RTJFL
DO CHK
if $DATA(RTJFL)
GOTO 21
+3 WRITE !!,"Will now fill request"_$SELECT(RTC>1:"s",1:"")_" selected..."
+4 FOR RTN=0:0
SET RTN=$ORDER(RTY(RTN))
if 'RTN
QUIT
SET RTQ=+RTY(RTN)
DO RTQ^RTQ4
KILL RTY
+5 GOTO PT
Q2 KILL RTY,RTC,RTJR,V,RTSEL,RTS,RTE,DFN,RTQDC,RTN,RTQ,RTJFL
+1 KILL POP,X1,A,N,Y,%,%H,%I,DIE,DA,D0,DR
+2 KILL RT,DUOUT
QUIT
CHK IF $DATA(RTJR(V))
WRITE !!?3,*7,"You are only allowed to fill one request per volume.",!
HANG 2
SET RTJFL=""
QUIT
+1 SET RTJR(V)=""
QUIT
+2 ;
