DVBCPND1 ;ALB/GTS-557/THM,SBW - 2507 PENDING REQUESTS, PART 2 ; MAY 03, 2011
;;2.7;AMIE;**17,168,193,241**;Apr 10, 1995;Build 4
;
NXT F DA(1)=0:0 S DA(1)=$O(^TMP($J,JX,PNAM,DFN,DA(1))) Q:DA(1)="" D PRINT I $D(OUT) S DA(1)="",PNAM="ZZZZ",JX=$S($A(JX)>57:PNAM,1:999999)
Q
;
SORT ; AJF;Request Status Conversion
S ST1=$P(^DVB(396.3,REQDA,0),U,18),STAT=$$RSTAT^DVBCUTL8(ST1)
Q:"^R^X^RX^C^CT^RR^RA^"[(U_STAT_U)
I DVBCSORT="S" Q:STAT'=RSTAT&(RSTAT'="A")
S PNAM=$S($D(^DPT(DFN,0)):$P(^(0),U,1),1:"Unknown"),ROUT=$S($D(^DVB(396.3,REQDA,1)):$P(^(1),U,4),1:0),RDATE=$P(^(0),U,5)
I DVBCSORT="V" S ^TMP($J,PNAM,DFN,REQDA)="" Q
I DVBCSORT="S" S ^TMP($J,STAT,PNAM,DFN,REQDA)="" Q
I DVBCSORT="R",$D(ADIVNUM),ROUT=ADIVNUM S ^TMP($J,ROUT,PNAM,DFN,REQDA)="" Q
I DVBCSORT="A" D ELAPSED I EDAYS'<ERDAYS,EDAYS'>OLDAYS S ^TMP($J,EDAYS,PNAM,DFN,REQDA)=""
Q
;
SETUP K ^TMP($J) S DVBCDT(0)=$$FMTE^XLFDT(DT,"5DZ"),PG=0
S HEAD="Pending 2507 Requests for "_$S($D(^DVB(396.1,1,0)):$P(^(0),U,1),1:"Unknown site"),HEAD2="",PROCDT="Processed on: "_DVBCDT(0),NODATA=0 U IO D HEADER
;
DATA S DFN="" F J=0:0 S DFN=$O(^DVB(396.3,"B",DFN)) Q:DFN="" F REQDA=0:0 S REQDA=$O(^DVB(396.3,"B",DFN,REQDA)) Q:REQDA="" D SORT^DVBAB5
;I DVBCSORT="V" S PNAM="" F I=0:0 S PNAM=$O(^TMP($J,PNAM)) Q:PNAM="" F DFN=0:0 S DFN=$O(^TMP($J,PNAM,DFN)) Q:DFN="" F DA(1)=0:0 S DA(1)=$O(^TMP($J,PNAM,DFN,DA(1))) Q:DA(1)="" D PRINT I $D(OUT) S DA(1)="",PNAM="ZZZ" Q
I DVBCSORT="V" S PNAM="" F I=0:0 S PNAM=$O(^TMP($J,PNAM)) Q:PNAM="" Q:$D(OUT) D ;*241
.F DFN=0:0 S DFN=$O(^TMP($J,PNAM,DFN)) Q:DFN="" Q:$D(OUT) D ;*241
..F DA(1)=0:0 S DA(1)=$O(^TMP($J,PNAM,DFN,DA(1))) Q:DA(1)="" D PRINT Q:$D(OUT) ;*241
I DVBCSORT="R"!(DVBCSORT="A") S PNAM="" F JX=-1:0 S JX=$O(^TMP($J,JX)) Q:JX="" F I=0:0 S PNAM=$O(^TMP($J,JX,PNAM)) Q:PNAM="" F DFN=0:0 S DFN=$O(^TMP($J,JX,PNAM,DFN)) Q:DFN="" D NXT
I DVBCSORT="S" S (PNAM,JX)="" F ZX=0:0 S JX=$O(^TMP($J,JX)) Q:JX="" F I=0:0 S PNAM=$O(^TMP($J,JX,PNAM)) Q:PNAM="" F DFN=0:0 S DFN=$O(^TMP($J,JX,PNAM,DFN)) Q:DFN="" D NXT
D:$Y>60 HEADER I DVBCCNT>0 W !!,"Total pending: ",DVBCCNT,!
I IOST?1"C-".E W !!,"Press RETURN " R ANS:DTIME
;
EXIT I NODATA=0 U IO W *7,!!!!!,"No pending requests found for selected parameters.",!! H 2
;
KILL D:$D(ZTQUEUED) KILL^%ZTLOAD K ANS,JX,DVBCHDR,^TMP($J),ZX,ADIV,ADIVNUM,CNUM,DA
K DFN,DVBCCNT,DVBCHDR,DVBCSORT,ELTYP,ERDAYS,HEAD
G KILL^DVBCUTIL
;
PRINT S ADIV=$S($D(^DVB(396.3,DA(1),1)):$P(^(1),U,4),1:"") Q:ADIV'=ADIVNUM&(DVBCSORT="R") I ADIV]"" S ADIV=$S($D(^DG(40.8,+ADIV,0)):$P(^(0),U,1),1:"Unknown Division")
S RDATE1=$P(^DVB(396.3,DA(1),0),U,2),RDATE=$P(^(0),U,5),SSN=$P(^DPT(DFN,0),U,9),CNUM=$S($D(^(.31)):$P(^(.31),U,3),1:"Unknown") D ELAPSED
;AJF;Conversion
W !?10,"Division: "_ADIV,!?12,"Status: " S XX=$P(^DVB(396.3,DA(1),0),U,18)
S STATUS=$$RTSTAT^DVBCUTL8(XX)
S XX=$$RSTAT^DVBCUTL8(XX)
W STATUS,!!,PNAM,?49,"SSN: ",SSN,!?44,"Claim no: ",CNUM,!?40,"Request date: ",$$FMTE^XLFDT(RDATE1,"5DZ"),!?40,"Elapsed days: ",EDAYS,!!
S X=$S($D(^DVB(396.3,DA(1),4)):^(4),1:"")
S OWNDOM=$P(^DVB(396.3,DA(1),0),U,22) I OWNDOM]"" W "Transferred in from ",$S($D(^DIC(4.2,+OWNDOM,0)):$P(^(0),U,1),1:"Unknown site"),!
W !?5,"Exams requested:",!!
;
ITEMS ;
N DVBPALL
S DVBPALL=1
D TST^DVBCUTL2 S NODATA=1,REQSTR=+$P(^DVB(396.3,DA(1),0),U,4)
W !!,"Requested by: ",$S($D(^VA(200,+REQSTR,0)):$P(^(0),U,1),1:" (Not specified) ")," at "
S RONAME=$P(^DVB(396.3,DA(1),0),U,3),RONAME=$S(RONAME]"":$P(^DIC(4,+RONAME,0),U,1),1:"") W $S(RONAME]"":RONAME,1:" (Not specified) "),! F L=1:1:79 W "-"
S DVBCCNT=DVBCCNT+1 I IOST?1"C-".E K OUT W !!!,"Press RETURN to continue or ""^"" exit " R ANS:DTIME S:'$T!(ANS=U) OUT=1 Q:$D(OUT) D HEADER Q
W ! I $Y>45 D HEADER
Q
;
W ?(80-$L(HEAD)\2),HEAD,?71,"Page: ",PG,!?(80-$L(DVBCHDR)\2),DVBCHDR,!! I HEAD2]"" W ?(80-$L(HEAD2)\2),HEAD2,!
W ?(80-$L(PROCDT)\2),PROCDT,!?(80-$L(HEAD3)\2),HEAD3,! F LN=1:1:80 W "="
W !!
Q
;
ELAPSED K EDAYS,X1,X2,X S X1=DT,(X2,X)=RDATE D:ELTYP="C" ^%DTC D:ELTYP="W" ^XUWORKDY S EDAYS=X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCPND1 4101 printed Sep 23, 2025@19:21:16 Page 2
DVBCPND1 ;ALB/GTS-557/THM,SBW - 2507 PENDING REQUESTS, PART 2 ; MAY 03, 2011
+1 ;;2.7;AMIE;**17,168,193,241**;Apr 10, 1995;Build 4
+2 ;
NXT FOR DA(1)=0:0
SET DA(1)=$ORDER(^TMP($JOB,JX,PNAM,DFN,DA(1)))
if DA(1)=""
QUIT
DO PRINT
IF $DATA(OUT)
SET DA(1)=""
SET PNAM="ZZZZ"
SET JX=$SELECT($ASCII(JX)>57:PNAM,1:999999)
+1 QUIT
+2 ;
SORT ; AJF;Request Status Conversion
+1 SET ST1=$PIECE(^DVB(396.3,REQDA,0),U,18)
SET STAT=$$RSTAT^DVBCUTL8(ST1)
+2 if "^R^X^RX^C^CT^RR^RA^"[(U_STAT_U)
QUIT
+3 IF DVBCSORT="S"
if STAT'=RSTAT&(RSTAT'="A")
QUIT
+4 SET PNAM=$SELECT($DATA(^DPT(DFN,0)):$PIECE(^(0),U,1),1:"Unknown")
SET ROUT=$SELECT($DATA(^DVB(396.3,REQDA,1)):$PIECE(^(1),U,4),1:0)
SET RDATE=$PIECE(^(0),U,5)
+5 IF DVBCSORT="V"
SET ^TMP($JOB,PNAM,DFN,REQDA)=""
QUIT
+6 IF DVBCSORT="S"
SET ^TMP($JOB,STAT,PNAM,DFN,REQDA)=""
QUIT
+7 IF DVBCSORT="R"
IF $DATA(ADIVNUM)
IF ROUT=ADIVNUM
SET ^TMP($JOB,ROUT,PNAM,DFN,REQDA)=""
QUIT
+8 IF DVBCSORT="A"
DO ELAPSED
IF EDAYS'<ERDAYS
IF EDAYS'>OLDAYS
SET ^TMP($JOB,EDAYS,PNAM,DFN,REQDA)=""
+9 QUIT
+10 ;
SETUP KILL ^TMP($JOB)
SET DVBCDT(0)=$$FMTE^XLFDT(DT,"5DZ")
SET PG=0
+1 SET HEAD="Pending 2507 Requests for "_$SELECT($DATA(^DVB(396.1,1,0)):$PIECE(^(0),U,1),1:"Unknown site")
SET HEAD2=""
SET PROCDT="Processed on: "_DVBCDT(0)
SET NODATA=0
USE IO
DO HEADER
+2 ;
DATA SET DFN=""
FOR J=0:0
SET DFN=$ORDER(^DVB(396.3,"B",DFN))
if DFN=""
QUIT
FOR REQDA=0:0
SET REQDA=$ORDER(^DVB(396.3,"B",DFN,REQDA))
if REQDA=""
QUIT
DO SORT^DVBAB5
+1 ;I DVBCSORT="V" S PNAM="" F I=0:0 S PNAM=$O(^TMP($J,PNAM)) Q:PNAM="" F DFN=0:0 S DFN=$O(^TMP($J,PNAM,DFN)) Q:DFN="" F DA(1)=0:0 S DA(1)=$O(^TMP($J,PNAM,DFN,DA(1))) Q:DA(1)="" D PRINT I $D(OUT) S DA(1)="",PNAM="ZZZ" Q
+2 ;*241
IF DVBCSORT="V"
SET PNAM=""
FOR I=0:0
SET PNAM=$ORDER(^TMP($JOB,PNAM))
if PNAM=""
QUIT
if $DATA(OUT)
QUIT
Begin DoDot:1
+3 ;*241
FOR DFN=0:0
SET DFN=$ORDER(^TMP($JOB,PNAM,DFN))
if DFN=""
QUIT
if $DATA(OUT)
QUIT
Begin DoDot:2
+4 ;*241
FOR DA(1)=0:0
SET DA(1)=$ORDER(^TMP($JOB,PNAM,DFN,DA(1)))
if DA(1)=""
QUIT
DO PRINT
if $DATA(OUT)
QUIT
End DoDot:2
End DoDot:1
+5 IF DVBCSORT="R"!(DVBCSORT="A")
SET PNAM=""
FOR JX=-1:0
SET JX=$ORDER(^TMP($JOB,JX))
if JX=""
QUIT
FOR I=0:0
SET PNAM=$ORDER(^TMP($JOB,JX,PNAM))
if PNAM=""
QUIT
FOR DFN=0:0
SET DFN=$ORDER(^TMP($JOB,JX,PNAM,DFN))
if DFN=""
QUIT
DO NXT
+6 IF DVBCSORT="S"
SET (PNAM,JX)=""
FOR ZX=0:0
SET JX=$ORDER(^TMP($JOB,JX))
if JX=""
QUIT
FOR I=0:0
SET PNAM=$ORDER(^TMP($JOB,JX,PNAM))
if PNAM=""
QUIT
FOR DFN=0:0
SET DFN=$ORDER(^TMP($JOB,JX,PNAM,DFN))
if DFN=""
QUIT
DO NXT
+7 if $Y>60
DO HEADER
IF DVBCCNT>0
WRITE !!,"Total pending: ",DVBCCNT,!
+8 IF IOST?1"C-".E
WRITE !!,"Press RETURN "
READ ANS:DTIME
+9 ;
EXIT IF NODATA=0
USE IO
WRITE *7,!!!!!,"No pending requests found for selected parameters.",!!
HANG 2
+1 ;
KILL if $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
KILL ANS,JX,DVBCHDR,^TMP($JOB),ZX,ADIV,ADIVNUM,CNUM,DA
+1 KILL DFN,DVBCCNT,DVBCHDR,DVBCSORT,ELTYP,ERDAYS,HEAD
+2 GOTO KILL^DVBCUTIL
+3 ;
PRINT SET ADIV=$SELECT($DATA(^DVB(396.3,DA(1),1)):$PIECE(^(1),U,4),1:"")
if ADIV'=ADIVNUM&(DVBCSORT="R")
QUIT
IF ADIV]""
SET ADIV=$SELECT($DATA(^DG(40.8,+ADIV,0)):$PIECE(^(0),U,1),1:"Unknown Division")
+1 SET RDATE1=$PIECE(^DVB(396.3,DA(1),0),U,2)
SET RDATE=$PIECE(^(0),U,5)
SET SSN=$PIECE(^DPT(DFN,0),U,9)
SET CNUM=$SELECT($DATA(^(.31)):$PIECE(^(.31),U,3),1:"Unknown")
DO ELAPSED
+2 ;AJF;Conversion
+3 WRITE !?10,"Division: "_ADIV,!?12,"Status: "
SET XX=$PIECE(^DVB(396.3,DA(1),0),U,18)
+4 SET STATUS=$$RTSTAT^DVBCUTL8(XX)
+5 SET XX=$$RSTAT^DVBCUTL8(XX)
+6 WRITE STATUS,!!,PNAM,?49,"SSN: ",SSN,!?44,"Claim no: ",CNUM,!?40,"Request date: ",$$FMTE^XLFDT(RDATE1,"5DZ"),!?40,"Elapsed days: ",EDAYS,!!
+7 SET X=$SELECT($DATA(^DVB(396.3,DA(1),4)):^(4),1:"")
+8 SET OWNDOM=$PIECE(^DVB(396.3,DA(1),0),U,22)
IF OWNDOM]""
WRITE "Transferred in from ",$SELECT($DATA(^DIC(4.2,+OWNDOM,0)):$PIECE(^(0),U,1),1:"Unknown site"),!
+9 WRITE !?5,"Exams requested:",!!
+10 ;
ITEMS ;
+1 NEW DVBPALL
+2 SET DVBPALL=1
+3 DO TST^DVBCUTL2
SET NODATA=1
SET REQSTR=+$PIECE(^DVB(396.3,DA(1),0),U,4)
+4 WRITE !!,"Requested by: ",$SELECT($DATA(^VA(200,+REQSTR,0)):$PIECE(^(0),U,1),1:" (Not specified) ")," at "
+5 SET RONAME=$PIECE(^DVB(396.3,DA(1),0),U,3)
SET RONAME=$SELECT(RONAME]"":$PIECE(^DIC(4,+RONAME,0),U,1),1:"")
WRITE $SELECT(RONAME]"":RONAME,1:" (Not specified) "),!
FOR L=1:1:79
WRITE "-"
+6 SET DVBCCNT=DVBCCNT+1
IF IOST?1"C-".E
KILL OUT
WRITE !!!,"Press RETURN to continue or ""^"" exit "
READ ANS:DTIME
if '$TEST!(ANS=U)
SET OUT=1
if $DATA(OUT)
QUIT
DO HEADER
QUIT
+7 WRITE !
IF $Y>45
DO HEADER
+8 QUIT
+9 ;
WRITE @IOF,!!
+1 WRITE ?(80-$LENGTH(HEAD)\2),HEAD,?71,"Page: ",PG,!?(80-$LENGTH(DVBCHDR)\2),DVBCHDR,!!
IF HEAD2]""
WRITE ?(80-$LENGTH(HEAD2)\2),HEAD2,!
+2 WRITE ?(80-$LENGTH(PROCDT)\2),PROCDT,!?(80-$LENGTH(HEAD3)\2),HEAD3,!
FOR LN=1:1:80
WRITE "="
+3 WRITE !!
+4 QUIT
+5 ;
ELAPSED KILL EDAYS,X1,X2,X
SET X1=DT
SET (X2,X)=RDATE
if ELTYP="C"
DO ^%DTC
if ELTYP="W"
DO ^XUWORKDY
SET EDAYS=X
