- 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 Jan 18, 2025@03:35:12 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 ;