- 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 Mar 13, 2025@21:39:12 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 ;
