- 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 Feb 18, 2025@23:11:40 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