- 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 Feb 19, 2025@00:01:01 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
