RTNQ21 ;TROY ISC/MJK-Record Inquiry Routine ; 5/4/87 10:00 AM ; 1/30/03 8:36am
;;2.0;Record Tracking;**32,33,36**;10/22/91
S RTFL="RTQ",RTUTL=0,RTPCE=9 D WINDOW^RTRPT K RTPCE,S,D,^TMP($J,"RTNQ"),RTL
W:$E(IOST,1,2)="C-" !!?3,"...will now compile record request data"
F RT=0:0 S RT=$O(RT(RT)) Q:'RT S RT0=RT(RT) F RTDT=0:0 S RTDT=$O(^RTV(190.1,"AC",RT,RTDT)) Q:'RTDT F RTQ=0:0 S RTQ=$O(^RTV(190.1,"AC",RT,RTDT,RTQ)) Q:'RTQ D RTQ
I '$D(^TMP($J,"RTNQ")) W !!,"No requests on file.",$S($E(IOST,1,2)="C-":" Press RETURN to continue.",1:"") R:$E(IOST,1,2)="C-" X:DTIME G Q
K S,RTDT F S=0:0 S S=$O(RTL(S)) Q:'S D @($S(($Y+8)>IOSL:"HD",'$D(RTDT):"HD1",1:"HD2")) G Q:RTESC="^" F RTDT=0:0 S RTDT=$O(RTL(S,RTDT)) Q:'RTDT F I=0:0 S I=$O(RTL(S,RTDT,I)) Q:'I D WRITE G Q:RTESC="^"
;
Q G Q^RTNQ2
;
HD D HD^RTNQ2 Q:RTESC="^"
HD1 W !?25,"**** RECORD REQUEST PROFILE ****",!,"Type",?6,"Requestor",?27,"Date Needed",?46,"Phone#",?55,"Requesting User",?72,"Req#",!,"----",?6,"---------",?27,"-----------",?46,"------",?55,"---------------",?72,"----"
HD2 W !,"[",$S(S=1:"Pending",S=2:"Filled",1:"Cancelled or Never Filled"),"]"
I $D(S),$D(RTDT),RTDT W " ...continued"
Q
;
RTQ Q:'$D(^RTV(190.1,RTQ,0)) S Y=^(0),T=+$P(RT0,"^",3),V=+$P(RT0,"^",7)
S U1="" I $D(^VA(200,+$P(Y,"^",3),0)) S U1=$P(^(0),"^")
S S=$P(Y,"^",6),S=$S(S="x":3,S="c":2,'$D(RTWND(T)):1,RTWND(T)'>$P(Y,"^",4):1,1:3)
S D=$P(Y,"^",4),N=D_".00000",N=$TR($$FMTE^XLFDT($E(N,1,12),"5F")," /","0-")
S (B,B("P"))="" I $D(^RTV(195.9,+$P(Y,"^",5),0)) S Y=^(0),B("P")=$P(Y,"^",8),Y=$P(Y,"^") D NAME^RTB S B=Y
S (B1,B1("P"))="" I $D(^RTV(195.9,+$P(^RTV(190.1,RTQ,0),"^",14),0)) S Y=^(0),B1("P")=$S($P(Y,"^",8)'="":"("_$P(Y,"^",8)_")",1:""),Y=$P(Y,"^") D NAME^RTB S B1=$S(Y'="":"("_Y_")",1:"")
S RTUTL=RTUTL+1 F I=1:1 I '$D(RTL(S,D,I)) S RTL(S,D,I)=RTUTL,^TMP($J,"RTNQ",RTUTL)=T_"^"_V_"^"_B_"^"_N_"^"_B("P")_"^"_U1_"^"_RTQ_"^"_B1_"^"_B1("P") Q
K D,T,V,U1,B,B1,N,I,S,V Q
;
WRITE D HD:($Y+6)>IOSL Q:RTESC="^" S Y=^TMP($J,"RTNQ",RTL(S,RTDT,I))
W !,$P(RTO(+Y),"^",3),+$P(Y,"^",2),?6,$E($P(Y,"^",3),1,20),?27,$P(Y,"^",4),?46,$P(Y,"^",5),?55,$E($P(Y,"^",6),1,15),?72,+$P(Y,"^",7) I $P(Y,"^",8)'="" W !?6,$P(Y,"^",8),?46,$P(Y,"^",9)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTNQ21 2223 printed Dec 13, 2024@02:34:06 Page 2
RTNQ21 ;TROY ISC/MJK-Record Inquiry Routine ; 5/4/87 10:00 AM ; 1/30/03 8:36am
+1 ;;2.0;Record Tracking;**32,33,36**;10/22/91
+2 SET RTFL="RTQ"
SET RTUTL=0
SET RTPCE=9
DO WINDOW^RTRPT
KILL RTPCE,S,D,^TMP($JOB,"RTNQ"),RTL
+3 if $EXTRACT(IOST,1,2)="C-"
WRITE !!?3,"...will now compile record request data"
+4 FOR RT=0:0
SET RT=$ORDER(RT(RT))
if 'RT
QUIT
SET RT0=RT(RT)
FOR RTDT=0:0
SET RTDT=$ORDER(^RTV(190.1,"AC",RT,RTDT))
if 'RTDT
QUIT
FOR RTQ=0:0
SET RTQ=$ORDER(^RTV(190.1,"AC",RT,RTDT,RTQ))
if 'RTQ
QUIT
DO RTQ
+5 IF '$DATA(^TMP($JOB,"RTNQ"))
WRITE !!,"No requests on file.",$SELECT($EXTRACT(IOST,1,2)="C-":" Press RETURN to continue.",1:"")
if $EXTRACT(IOST,1,2)="C-"
READ X:DTIME
GOTO Q
+6 KILL S,RTDT
FOR S=0:0
SET S=$ORDER(RTL(S))
if 'S
QUIT
DO @($SELECT(($Y+8)>IOSL:"HD",'$DATA(RTDT):"HD1",1:"HD2"))
if RTESC="^"
GOTO Q
FOR RTDT=0:0
SET RTDT=$ORDER(RTL(S,RTDT))
if 'RTDT
QUIT
FOR I=0:0
SET I=$ORDER(RTL(S,RTDT,I))
if 'I
QUIT
DO WRITE
if RTESC="^"
GOTO Q
+7 ;
Q GOTO Q^RTNQ2
+1 ;
HD DO HD^RTNQ2
if RTESC="^"
QUIT
HD1 WRITE !?25,"**** RECORD REQUEST PROFILE ****",!,"Type",?6,"Requestor",?27,"Date Needed",?46,"Phone#",?55,"Requesting User",?72,"Req#",!,"----",?6,"---------",?27,"-----------",?46,"------",?55,"---------------",?72,"----"
HD2 WRITE !,"[",$SELECT(S=1:"Pending",S=2:"Filled",1:"Cancelled or Never Filled"),"]"
+1 IF $DATA(S)
IF $DATA(RTDT)
IF RTDT
WRITE " ...continued"
+2 QUIT
+3 ;
RTQ if '$DATA(^RTV(190.1,RTQ,0))
QUIT
SET Y=^(0)
SET T=+$PIECE(RT0,"^",3)
SET V=+$PIECE(RT0,"^",7)
+1 SET U1=""
IF $DATA(^VA(200,+$PIECE(Y,"^",3),0))
SET U1=$PIECE(^(0),"^")
+2 SET S=$PIECE(Y,"^",6)
SET S=$SELECT(S="x":3,S="c":2,'$DATA(RTWND(T)):1,RTWND(T)'>$PIECE(Y,"^",4):1,1:3)
+3 SET D=$PIECE(Y,"^",4)
SET N=D_".00000"
SET N=$TRANSLATE($$FMTE^XLFDT($EXTRACT(N,1,12),"5F")," /","0-")
+4 SET (B,B("P"))=""
IF $DATA(^RTV(195.9,+$PIECE(Y,"^",5),0))
SET Y=^(0)
SET B("P")=$PIECE(Y,"^",8)
SET Y=$PIECE(Y,"^")
DO NAME^RTB
SET B=Y
+5 SET (B1,B1("P"))=""
IF $DATA(^RTV(195.9,+$PIECE(^RTV(190.1,RTQ,0),"^",14),0))
SET Y=^(0)
SET B1("P")=$SELECT($PIECE(Y,"^",8)'="":"("_$PIECE(Y,"^",8)_")",1:"")
SET Y=$PIECE(Y,"^")
DO NAME^RTB
SET B1=$SELECT(Y'="":"("_Y_")",1:"")
+6 SET RTUTL=RTUTL+1
FOR I=1:1
IF '$DATA(RTL(S,D,I))
SET RTL(S,D,I)=RTUTL
SET ^TMP($JOB,"RTNQ",RTUTL)=T_"^"_V_"^"_B_"^"_N_"^"_B("P")_"^"_U1_"^"_RTQ_"^"_B1_"^"_B1("P")
QUIT
+7 KILL D,T,V,U1,B,B1,N,I,S,V
QUIT
+8 ;
WRITE if ($Y+6)>IOSL
DO HD
if RTESC="^"
QUIT
SET Y=^TMP($JOB,"RTNQ",RTL(S,RTDT,I))
+1 WRITE !,$PIECE(RTO(+Y),"^",3),+$PIECE(Y,"^",2),?6,$EXTRACT($PIECE(Y,"^",3),1,20),?27,$PIECE(Y,"^",4),?46,$PIECE(Y,"^",5),?55,$EXTRACT($PIECE(Y,"^",6),1,15),?72,+$PIECE(Y,"^",7)
IF $PIECE(Y,"^",8)'=""
WRITE !?6,$PIECE(Y,"^",8),?46,$PIECE(Y,"^",9)
+2 QUIT
+3 ;
