RTQ4 ;MJK/TROY ISC;Record Request Option; ; 5/14/87 1:24 PM ;
;;v 2.0;Record Tracking;;10/22/91
2 ;Edit Request
I '$D(RTAPL) D APL2^RTPSET D NEXT2:$D(RTAPL) K RTAPL,RTSYS Q
NEXT2 D PND^RTRPT
L2 S RTSEL="S",DIC(0)="IAEMQ",DIC("S")="S Z=^(0) I $P(Z,U,6)=""r""!($P(Z,U,6)=""n""),'$P(Z,U,10),'$P(Z,U,13) D SCRN^RTQ"
D ^RTDPA2 K RT,RTE,RTQ G Q2:"^"[X,L2:'$D(RTY)
F RTY=0:0 S RTY=$O(RTY(RTY)) Q:'RTY S DA=+RTY(RTY),DIE="^RTV(190.1,",DR="[RT EDIT REQUEST]" D NOW^%DTC S RTNOW=% K RTFL1 D ^DIE K DE,DQ,RTNOW
K RTY G L2
Q2 K RTWND,RTSEL,RTESC,RTFL1,RTFL,X
K I,N,POP,RTC,RTX,X,Y,X1,Y1,DR,DIE,DA,RTDUZ,RT0,J,P Q
4 ;Fill a Request
K ^TMP($J,"RT") S RTN=0,RTPCE=9 D WINDOW^RTRPT K RTPCE
SEL K RTDEL R !!,"Fill Which Request: ",X:DTIME D HELP:$E(X)="?" G SEL:'$D(X),SELQ:X=""!(X["^") S:$E(X)="-" RTDEL="",X=$E(X,2,99)
S RTSEL="S",DIC(0)="IEMQ",DIC("S")="S Z=^(0) I $P(Z,U,6)=""r""!($P(Z,U,6)=""n"") D SCRN1^RTQ"
K RTY D ^RTDPA2 K RTE,RTC G SEL:'$D(RTY)
F RTY=0:0 S RTY=$O(RTY(RTY)) Q:'RTY S RT=+^RTV(190.1,+RTY(RTY),0) D MISS1^RTQ1 I $D(RT) S RTQ=+RTY(RTY) D CANCEL^RTQ1:$P(^RTV(190.1,RTQ,0),"^",6)="x" I $D(RTQ) S Y=RTQ D ARRAY1^RTUTL1 K RT,RTQ
K RTY G SEL
SELQ I X["^",RTN S RTRD(1)="Yes^fill record requests",RTRD(2)="No^not fill record requests",RTRD("B")=2,RTRD("A")="Do you still wish to 'fill' selected record requests? ",RTRD(0)="S" D SET^RTRD K RTRD G SELQ1:$E(X)'="Y"
D QUE:RTN>$P(RTSYS,"^",2) G SELQ1:'RTN!(RTN>$P(RTSYS,"^",2)) W !!,"Will now fill requests selected..."
F RTN=0:0 S RTN=$O(^TMP($J,"RT","AR",RTN)) Q:'RTN S RTQ=^(RTN) D RTQ K RTQ
SELQ1 K RTSEL,RTWND,RTSTAT,RTN,RTESC
K I,RT,%DT,DA,D0,DIE,DR,N,I1 Q
RTQ D FILL S RT=+^RTV(190.1,RTQ,0) D DEMOS^RTUTL1 W !?3,"...request for ",RTD("N"),"'s ",RTD("T"),"filled" K RTD Q
;
FILL ;Entry pt with RTQ defined
S X="CHARGE-OUT" D TYPE^RTT Q:'$D(RTMV)!('$D(^RTV(190.1,RTQ,0))) S Y=^(0),RTSTAT="c",RTB=+$P(Y,"^",5),RT=+Y,RTPROV=+$P(Y,"^",14)
I $S('$D(^RT(RT,"CL")):1,'$D(^RTV(195.9,+$P(^("CL"),"^",5),0)):1,$P(^(0),"^")="2;DIC(195.4,":0,1:1) D CHG^RTT I '$D(Y) S DIE="^RTV(190.1,",DR="[RT CHANGE REQUEST STATUS]",DA=RTQ D ^DIE
K DE,DQ,RTSTAT,RTMV,RTMV0,RTB,RT,RTPROV Q
;
HELP Q:'RTN S X="Y",RTLC=1,RTIOSL=$S('$D(IOSL):24,'IOSL:24,1:IOSL)
W !!,"Requests already selected to be filled during this session:" D LINE^RTUTL3
F N=0:0 S N=$O(^TMP($J,"RT","AR",N)) Q:'N S RTQ=+^(N) D HELP1 Q:X'="Y"
W:X="Y" !!?3,"Also, you can delete a selected request by entering a",!?3,"'minus' sign(-) before the request number (eg. Select Request: -342)."
D MORE^RTB2:X="Y"&(RTLC>1) S X=$S($E(X)="Y":"?",1:"") K:X'="?" X K RTLC,RTIOSL,N Q
;
HELP1 S Y=$S($D(^RT(+^RTV(190.1,RTQ,0),0)):$P(^(0),"^"),1:"UNKNOWN") D NAME^RTB W !?3,Y," " S Y=RTQ K RTQ D DISP1^RTUTL1:$D(^RTV(190.1,Y,0)) S Y=+^RTV(190.1,Y,0) D DISP^RTUTL1:$D(^RT(Y,0)),LINE^RTUTL3
S X="Y",RTLC=RTLC+5 I (RTLC+5)>RTIOSL D MORE^RTB2 S RTLC=1,X=$E(X)
Q
;
QUE X ^%ZOSF("UCI") S ZTRTN="DQ^RTQ4",ZTUCI=Y,ZTDTH=$H
S:$D(DUZ(0)) ZTSAVE("DUZ(0)")="" D NOW^%DTC S ZTSAVE("RTQUEDT")=%,ZTSAVE("RTAPL")="",ZTDESC="Filling Record Requests"
F I=0:0 S I=$O(^TMP($J,"RT","AR",I)) Q:'I S RTAR(I)=^(I)
S ZTSAVE("RTAR(")="",ZTIO=""
W !!?3,"...requests have been QUEUED to be filled.",! D ^%ZTLOAD K RTAR Q
;
DQ S RTBKGRD=""
F RTN=0:0 S RTN=$O(RTAR(RTN)) Q:'RTN S RTQ=+RTAR(RTN),X=$S('$D(^RTV(190.1,RTQ,0)):0,'$D(^RT(+^(0),"CL")):0,1:+$P(^("CL"),"^",6)) I X'>RTQUEDT D FILL K RTQ
K RTAR,RTQUEDT,RTN,RTBKGRD,RTAPL Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTQ4 3473 printed Dec 13, 2024@02:34:30 Page 2
RTQ4 ;MJK/TROY ISC;Record Request Option; ; 5/14/87 1:24 PM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
2 ;Edit Request
+1 IF '$DATA(RTAPL)
DO APL2^RTPSET
if $DATA(RTAPL)
DO NEXT2
KILL RTAPL,RTSYS
QUIT
NEXT2 DO PND^RTRPT
L2 SET RTSEL="S"
SET DIC(0)="IAEMQ"
SET DIC("S")="S Z=^(0) I $P(Z,U,6)=""r""!($P(Z,U,6)=""n""),'$P(Z,U,10),'$P(Z,U,13) D SCRN^RTQ"
+1 DO ^RTDPA2
KILL RT,RTE,RTQ
if "^"[X
GOTO Q2
if '$DATA(RTY)
GOTO L2
+2 FOR RTY=0:0
SET RTY=$ORDER(RTY(RTY))
if 'RTY
QUIT
SET DA=+RTY(RTY)
SET DIE="^RTV(190.1,"
SET DR="[RT EDIT REQUEST]"
DO NOW^%DTC
SET RTNOW=%
KILL RTFL1
DO ^DIE
KILL DE,DQ,RTNOW
+3 KILL RTY
GOTO L2
Q2 KILL RTWND,RTSEL,RTESC,RTFL1,RTFL,X
+1 KILL I,N,POP,RTC,RTX,X,Y,X1,Y1,DR,DIE,DA,RTDUZ,RT0,J,P
QUIT
4 ;Fill a Request
+1 KILL ^TMP($JOB,"RT")
SET RTN=0
SET RTPCE=9
DO WINDOW^RTRPT
KILL RTPCE
SEL KILL RTDEL
READ !!,"Fill Which Request: ",X:DTIME
if $EXTRACT(X)="?"
DO HELP
if '$DATA(X)
GOTO SEL
if X=""!(X["^")
GOTO SELQ
if $EXTRACT(X)="-"
SET RTDEL=""
SET X=$EXTRACT(X,2,99)
+1 SET RTSEL="S"
SET DIC(0)="IEMQ"
SET DIC("S")="S Z=^(0) I $P(Z,U,6)=""r""!($P(Z,U,6)=""n"") D SCRN1^RTQ"
+2 KILL RTY
DO ^RTDPA2
KILL RTE,RTC
if '$DATA(RTY)
GOTO SEL
+3 FOR RTY=0:0
SET RTY=$ORDER(RTY(RTY))
if 'RTY
QUIT
SET RT=+^RTV(190.1,+RTY(RTY),0)
DO MISS1^RTQ1
IF $DATA(RT)
SET RTQ=+RTY(RTY)
if $PIECE(^RTV(190.1,RTQ,0),"^",6)="x"
DO CANCEL^RTQ1
IF $DATA(RTQ)
SET Y=RTQ
DO ARRAY1^RTUTL1
KILL RT,RTQ
+4 KILL RTY
GOTO SEL
SELQ IF X["^"
IF RTN
SET RTRD(1)="Yes^fill record requests"
SET RTRD(2)="No^not fill record requests"
SET RTRD("B")=2
SET RTRD("A")="Do you still wish to 'fill' selected record requests? "
SET RTRD(0)="S"
DO SET^RTRD
KILL RTRD
if $EXTRACT(X)'="Y"
GOTO SELQ1
+1 if RTN>$PIECE(RTSYS,"^",2)
DO QUE
if 'RTN!(RTN>$PIECE(RTSYS,"^",2))
GOTO SELQ1
WRITE !!,"Will now fill requests selected..."
+2 FOR RTN=0:0
SET RTN=$ORDER(^TMP($JOB,"RT","AR",RTN))
if 'RTN
QUIT
SET RTQ=^(RTN)
DO RTQ
KILL RTQ
SELQ1 KILL RTSEL,RTWND,RTSTAT,RTN,RTESC
+1 KILL I,RT,%DT,DA,D0,DIE,DR,N,I1
QUIT
RTQ DO FILL
SET RT=+^RTV(190.1,RTQ,0)
DO DEMOS^RTUTL1
WRITE !?3,"...request for ",RTD("N"),"'s ",RTD("T"),"filled"
KILL RTD
QUIT
+1 ;
FILL ;Entry pt with RTQ defined
+1 SET X="CHARGE-OUT"
DO TYPE^RTT
if '$DATA(RTMV)!('$DATA(^RTV(190.1,RTQ,0)))
QUIT
SET Y=^(0)
SET RTSTAT="c"
SET RTB=+$PIECE(Y,"^",5)
SET RT=+Y
SET RTPROV=+$PIECE(Y,"^",14)
+2 IF $SELECT('$DATA(^RT(RT,"CL")):1,'$DATA(^RTV(195.9,+$PIECE(^("CL"),"^",5),0)):1,$PIECE(^(0),"^")="2;DIC(195.4,":0,1:1)
DO CHG^RTT
IF '$DATA(Y)
SET DIE="^RTV(190.1,"
SET DR="[RT CHANGE REQUEST STATUS]"
SET DA=RTQ
DO ^DIE
+3 KILL DE,DQ,RTSTAT,RTMV,RTMV0,RTB,RT,RTPROV
QUIT
+4 ;
HELP if 'RTN
QUIT
SET X="Y"
SET RTLC=1
SET RTIOSL=$SELECT('$DATA(IOSL):24,'IOSL:24,1:IOSL)
+1 WRITE !!,"Requests already selected to be filled during this session:"
DO LINE^RTUTL3
+2 FOR N=0:0
SET N=$ORDER(^TMP($JOB,"RT","AR",N))
if 'N
QUIT
SET RTQ=+^(N)
DO HELP1
if X'="Y"
QUIT
+3 if X="Y"
WRITE !!?3,"Also, you can delete a selected request by entering a",!?3,"'minus' sign(-) before the request number (eg. Select Request: -342)."
+4 if X="Y"&(RTLC>1)
DO MORE^RTB2
SET X=$SELECT($EXTRACT(X)="Y":"?",1:"")
if X'="?"
KILL X
KILL RTLC,RTIOSL,N
QUIT
+5 ;
HELP1 SET Y=$SELECT($DATA(^RT(+^RTV(190.1,RTQ,0),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
DO NAME^RTB
WRITE !?3,Y," "
SET Y=RTQ
KILL RTQ
if $DATA(^RTV(190.1,Y,0))
DO DISP1^RTUTL1
SET Y=+^RTV(190.1,Y,0)
if $DATA(^RT(Y,0))
DO DISP^RTUTL1
DO LINE^RTUTL3
+1 SET X="Y"
SET RTLC=RTLC+5
IF (RTLC+5)>RTIOSL
DO MORE^RTB2
SET RTLC=1
SET X=$EXTRACT(X)
+2 QUIT
+3 ;
QUE XECUTE ^%ZOSF("UCI")
SET ZTRTN="DQ^RTQ4"
SET ZTUCI=Y
SET ZTDTH=$HOROLOG
+1 if $DATA(DUZ(0))
SET ZTSAVE("DUZ(0)")=""
DO NOW^%DTC
SET ZTSAVE("RTQUEDT")=%
SET ZTSAVE("RTAPL")=""
SET ZTDESC="Filling Record Requests"
+2 FOR I=0:0
SET I=$ORDER(^TMP($JOB,"RT","AR",I))
if 'I
QUIT
SET RTAR(I)=^(I)
+3 SET ZTSAVE("RTAR(")=""
SET ZTIO=""
+4 WRITE !!?3,"...requests have been QUEUED to be filled.",!
DO ^%ZTLOAD
KILL RTAR
QUIT
+5 ;
DQ SET RTBKGRD=""
+1 FOR RTN=0:0
SET RTN=$ORDER(RTAR(RTN))
if 'RTN
QUIT
SET RTQ=+RTAR(RTN)
SET X=$SELECT('$DATA(^RTV(190.1,RTQ,0)):0,'$DATA(^RT(+^(0),"CL")):0,1:+$PIECE(^("CL"),"^",6))
IF X'>RTQUEDT
DO FILL
KILL RTQ
+2 KILL RTAR,RTQUEDT,RTN,RTBKGRD,RTAPL
QUIT
