- 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 Apr 23, 2025@17:59:43 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
