DVBCPNDR ;ALB/GTS-557/THM-2507 PENDING REQUESTS, PART 1 ; 9/29/21 2:31pm
;;2.7;AMIE;**51,193,227**;Apr 10, 1995;Build 21
;
S DVBCCNT=0 D HOME^%ZIS W @IOF,"Pending 2507 Request Report",!!! K NOASK S ADIVNUM="",ADIV="",FF=IOF
;
ASK W !!,"Do you want to sort by:",!!?5,"(A)ge of request",!?5,"(S)tatus",!?5,"(V)eteran name",!?5,"(R)outing location",!!?5,"Selection: V// " R DVBCSORT:DTIME G:'$T!(DVBCSORT=U) KILL^DVBCUTIL
S:DVBCSORT="r" DVBCSORT="R"
S:DVBCSORT="a" DVBCSORT="A"
S:DVBCSORT="s" DVBCSORT="S"
S:DVBCSORT="v" DVBCSORT="V"
I DVBCSORT'=""&("A^S^V^R"'[DVBCSORT) W !!,*7,"Answer must be A, S, V, or R.",!! H 3 W @IOF G ASK
W $S(DVBCSORT="V":"eteran name",DVBCSORT="":"Veteran name",DVBCSORT="A":"ge of request",DVBCSORT="S":"tatus",DVBCSORT="R":"outing location",1:"") I DVBCSORT="" S DVBCSORT="V"
S DVBCHDR=$S(DVBCSORT="V":"Veteran name",DVBCSORT="R":"Routing location",DVBCSORT="S":"Status",DVBCSORT="A":"Age of request",1:"Unknown"),DVBCHDR="Sorted by "_DVBCHDR
;
; Added Re-Routed Status ; patch 193
SSORT H 1 I DVBCSORT="S" W @IOF,"Status selection:",!!!!,"Select STATUS (enter A for all): P// " R RSTAT:DTIME G:'$T!(RSTAT=U) KILL^DVBCUTIL I RSTAT="" S RSTAT="P" W RSTAT
I DVBCSORT="S" S:RSTAT="n" RSTAT="N" S:RSTAT="t" RSTAT="T" S:RSTAT="p" RSTAT="P" S:RSTAT="a" RSTAT="A"
I DVBCSORT="S",RSTAT'?1"N",RSTAT'?1"RP",RSTAT'?1"NR",RSTAT'?1"P",RSTAT'?1"T",RSTAT'?1"A",RSTAT'?1"RS" W *7,!!,"Status must be N(New),P(Pending),NR(New,RR),RP(RR Pend Accept),RS(RR Pend at To Site),T(Transcribed) or A(ALL)" H 3 G SSORT
I DVBCSORT="S" W $S(RSTAT="P":"ending",RSTAT="NR":"New, Re-Routed",RSTAT="RP":"Re-routed, Pending Acceptance",RSTAT="RS":"Re-Routed, Pending at TO Site",RSTAT="T":"ranscribed",RSTAT="N":"ew",RSAT="A":"11",1:"")
;
ESORT I DVBCSORT="A" W @IOF,!,"Age selection:",!!!?5,"Enter EARLIEST age: " R ERDAYS:DTIME G:'$T!(ERDAYS=U) KILL^DVBCUTIL
I DVBCSORT="A",(ERDAYS<1) W *7,!!,"Enter the shortest time span (in days) which 2507 processing has elapsed.",!,"Cannot be less than one day !",!,"If you want NEW requests (zero days), sort by status.",!! D CONTMES^DVBCUTL4 G ESORT
;
OSORT I DVBCSORT="A" W !?8," and OLDEST age: " R OLDAYS:DTIME G:'$T!(OLDAYS=U) KILL^DVBCUTIL
I DVBCSORT="A",(OLDAYS<1) W *7,!!,"Enter the longest time span (in days) which 2507 processing has elapsed.",!,"Cannot be less than 1 day",!! H 4 G OSORT
I DVBCSORT="A",ERDAYS>OLDAYS W *7,!!,"Earliest age must be less than oldest age",!! H 2 G ESORT
G CALWRK:DVBCSORT'="R" H 1 W @IOF,!,"Routing Location Selection:",!!! S DIC="^DG(40.8,",DIC(0)="AEQM",DIC("A")="Enter MEDICAL CENTER DIVISION: " D ^DIC G:X=""!(X=U) KILL^DVBCUTIL S ADIVNUM=+Y I ADIVNUM<0 G KILL^DVBCUTIL
;
CALWRK W !!,"Do you want elapsed time reported",!," in (C)alender days or (W)ork days? C// " R ELTYP:DTIME I '$T!(ELTYP=U) G KILL^DVBCUTIL
S:ELTYP="c" ELTYP="C"
S:ELTYP="w" ELTYP="W"
I ELTYP'?1"W"&(ELTYP'?1"C")&(ELTYP'="") W !!,*7,"Must be C for Calendar, W for Workdays",!,"or simply press RETURN to accept the default.",!! H 2 G CALWRK
W $S(ELTYP="":"Calendar",ELTYP="C":"alendar",ELTYP="W":"ork",1:"Unknown")_" days" I ELTYP="" S ELTYP="C"
S HEAD3="(Elapsed time in "_$S(ELTYP="C":"Calendar",ELTYP="W":"Work",1:"Unknown")_" days)"
;
DEV W !! S %ZIS="AEQ",%ZIS("A")="Printing device: " D ^%ZIS K %ZIS G:POP KILL^DVBCUTIL
I $D(IO("Q")) S ZTRTN="SETUP^DVBCPND1",ZTIO=ION,ZTDESC="2507 PENDING REPORT",NOASK=1 F I="STAT","RSTAT","DVBC*","HEAD*","ELTYP","CMPDIV","ERDAYS","OLDAYS","ADIVNUM","ADIV","NOASK","DUZ" S ZTSAVE(I)=""
I D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",!! H 1 G KILL^DVBCUTIL
G SETUP^DVBCPND1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCPNDR 3637 printed Dec 13, 2024@01:45:16 Page 2
DVBCPNDR ;ALB/GTS-557/THM-2507 PENDING REQUESTS, PART 1 ; 9/29/21 2:31pm
+1 ;;2.7;AMIE;**51,193,227**;Apr 10, 1995;Build 21
+2 ;
+3 SET DVBCCNT=0
DO HOME^%ZIS
WRITE @IOF,"Pending 2507 Request Report",!!!
KILL NOASK
SET ADIVNUM=""
SET ADIV=""
SET FF=IOF
+4 ;
ASK WRITE !!,"Do you want to sort by:",!!?5,"(A)ge of request",!?5,"(S)tatus",!?5,"(V)eteran name",!?5,"(R)outing location",!!?5,"Selection: V// "
READ DVBCSORT:DTIME
if '$TEST!(DVBCSORT=U)
GOTO KILL^DVBCUTIL
+1 if DVBCSORT="r"
SET DVBCSORT="R"
+2 if DVBCSORT="a"
SET DVBCSORT="A"
+3 if DVBCSORT="s"
SET DVBCSORT="S"
+4 if DVBCSORT="v"
SET DVBCSORT="V"
+5 IF DVBCSORT'=""&("A^S^V^R"'[DVBCSORT)
WRITE !!,*7,"Answer must be A, S, V, or R.",!!
HANG 3
WRITE @IOF
GOTO ASK
+6 WRITE $SELECT(DVBCSORT="V":"eteran name",DVBCSORT="":"Veteran name",DVBCSORT="A":"ge of request",DVBCSORT="S":"tatus",DVBCSORT="R":"outing location",1:"")
IF DVBCSORT=""
SET DVBCSORT="V"
+7 SET DVBCHDR=$SELECT(DVBCSORT="V":"Veteran name",DVBCSORT="R":"Routing location",DVBCSORT="S":"Status",DVBCSORT="A":"Age of request",1:"Unknown")
SET DVBCHDR="Sorted by "_DVBCHDR
+8 ;
+9 ; Added Re-Routed Status ; patch 193
SSORT HANG 1
IF DVBCSORT="S"
WRITE @IOF,"Status selection:",!!!!,"Select STATUS (enter A for all): P// "
READ RSTAT:DTIME
if '$TEST!(RSTAT=U)
GOTO KILL^DVBCUTIL
IF RSTAT=""
SET RSTAT="P"
WRITE RSTAT
+1 IF DVBCSORT="S"
if RSTAT="n"
SET RSTAT="N"
if RSTAT="t"
SET RSTAT="T"
if RSTAT="p"
SET RSTAT="P"
if RSTAT="a"
SET RSTAT="A"
+2 IF DVBCSORT="S"
IF RSTAT'?1"N"
IF RSTAT'?1"RP"
IF RSTAT'?1"NR"
IF RSTAT'?1"P"
IF RSTAT'?1"T"
IF RSTAT'?1"A"
IF RSTAT'?1"RS"
WRITE *7,!!,"Status must be N(New),P(Pending),NR(New,RR),RP(RR Pend Accept),RS(RR Pend at To Site),T(Transcribed) or A(ALL)"
HANG 3
GOTO SSORT
+3 IF DVBCSORT="S"
WRITE $SELECT(RSTAT="P":"ending",RSTAT="NR":"New, Re-Routed",RSTAT="RP":"Re-routed, Pending Acceptance",RSTAT="RS":"Re-Routed, Pending at TO Site",RSTAT="T":"ranscribed",RSTAT="N":"ew",RSAT="A":"11",1:"")
+4 ;
ESORT IF DVBCSORT="A"
WRITE @IOF,!,"Age selection:",!!!?5,"Enter EARLIEST age: "
READ ERDAYS:DTIME
if '$TEST!(ERDAYS=U)
GOTO KILL^DVBCUTIL
+1 IF DVBCSORT="A"
IF (ERDAYS<1)
WRITE *7,!!,"Enter the shortest time span (in days) which 2507 processing has elapsed.",!,"Cannot be less than one day !",!,"If you want NEW requests (zero days), sort by status.",!!
DO CONTMES^DVBCUTL4
GOTO ESORT
+2 ;
OSORT IF DVBCSORT="A"
WRITE !?8," and OLDEST age: "
READ OLDAYS:DTIME
if '$TEST!(OLDAYS=U)
GOTO KILL^DVBCUTIL
+1 IF DVBCSORT="A"
IF (OLDAYS<1)
WRITE *7,!!,"Enter the longest time span (in days) which 2507 processing has elapsed.",!,"Cannot be less than 1 day",!!
HANG 4
GOTO OSORT
+2 IF DVBCSORT="A"
IF ERDAYS>OLDAYS
WRITE *7,!!,"Earliest age must be less than oldest age",!!
HANG 2
GOTO ESORT
+3 if DVBCSORT'="R"
GOTO CALWRK
HANG 1
WRITE @IOF,!,"Routing Location Selection:",!!!
SET DIC="^DG(40.8,"
SET DIC(0)="AEQM"
SET DIC("A")="Enter MEDICAL CENTER DIVISION: "
DO ^DIC
if X=""!(X=U)
GOTO KILL^DVBCUTIL
SET ADIVNUM=+Y
IF ADIVNUM<0
GOTO KILL^DVBCUTIL
+4 ;
CALWRK WRITE !!,"Do you want elapsed time reported",!," in (C)alender days or (W)ork days? C// "
READ ELTYP:DTIME
IF '$TEST!(ELTYP=U)
GOTO KILL^DVBCUTIL
+1 if ELTYP="c"
SET ELTYP="C"
+2 if ELTYP="w"
SET ELTYP="W"
+3 IF ELTYP'?1"W"&(ELTYP'?1"C")&(ELTYP'="")
WRITE !!,*7,"Must be C for Calendar, W for Workdays",!,"or simply press RETURN to accept the default.",!!
HANG 2
GOTO CALWRK
+4 WRITE $SELECT(ELTYP="":"Calendar",ELTYP="C":"alendar",ELTYP="W":"ork",1:"Unknown")_" days"
IF ELTYP=""
SET ELTYP="C"
+5 SET HEAD3="(Elapsed time in "_$SELECT(ELTYP="C":"Calendar",ELTYP="W":"Work",1:"Unknown")_" days)"
+6 ;
DEV WRITE !!
SET %ZIS="AEQ"
SET %ZIS("A")="Printing device: "
DO ^%ZIS
KILL %ZIS
if POP
GOTO KILL^DVBCUTIL
+1 IF $DATA(IO("Q"))
SET ZTRTN="SETUP^DVBCPND1"
SET ZTIO=ION
SET ZTDESC="2507 PENDING REPORT"
SET NOASK=1
FOR I="STAT","RSTAT","DVBC*","HEAD*","ELTYP","CMPDIV","ERDAYS","OLDAYS","ADIVNUM","ADIV","NOASK","DUZ"
SET ZTSAVE(I)=""
+2 IF $TEST
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !!,"Request queued.",!!
HANG 1
GOTO KILL^DVBCUTIL
+3 GOTO SETUP^DVBCPND1
