- DVBAB5 ;ALB/KLB - CAPRI PENDING REQUESTS CONT ;08/01/00
- ;;2.7;AMIE;**35,185,193**;Apr 10, 1995;Build 84
- ;
- SORT ; AJF;Request Status Conversion
- N ROUT
- S STAT=$P(^DVB(396.3,REQDA,0),U,18)
- Q:STAT=""
- S STAT=$$RSTAT^DVBCUTL8(STAT)
- Q:"^R^X^RX^C^CT^RR^RA^"[(U_STAT_U) I DVBCSORT="S" Q:STAT'=RSTAT&(RSTAT'="A")
- S RONUM=$P(^DVB(396.3,REQDA,0),U,3),RONAME=$S(RONUM]"":$P(^DIC(4,+RONUM,0),U,1),1:"")
- S ROFILTER=$S($D(ROFILTER)'=0:ROFILTER,1:0)
- I (ROFILTER'[RONAME)&(ROFILTER'=0) Q
- 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
- ;
- ELAPSED K EDAYS,X1,X2,X S X1=DT,(X2,X)=RDATE D:ELTYP="C" ^%DTC D:ELTYP="W" ^XUWORKDY S EDAYS=X
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAB5 1000 printed Feb 18, 2025@23:06:48 Page 2
- DVBAB5 ;ALB/KLB - CAPRI PENDING REQUESTS CONT ;08/01/00
- +1 ;;2.7;AMIE;**35,185,193**;Apr 10, 1995;Build 84
- +2 ;
- SORT ; AJF;Request Status Conversion
- +1 NEW ROUT
- +2 SET STAT=$PIECE(^DVB(396.3,REQDA,0),U,18)
- +3 if STAT=""
- QUIT
- +4 SET STAT=$$RSTAT^DVBCUTL8(STAT)
- +5 if "^R^X^RX^C^CT^RR^RA^"[(U_STAT_U)
- QUIT
- IF DVBCSORT="S"
- if STAT'=RSTAT&(RSTAT'="A")
- QUIT
- +6 SET RONUM=$PIECE(^DVB(396.3,REQDA,0),U,3)
- SET RONAME=$SELECT(RONUM]"":$PIECE(^DIC(4,+RONUM,0),U,1),1:"")
- +7 SET ROFILTER=$SELECT($DATA(ROFILTER)'=0:ROFILTER,1:0)
- +8 IF (ROFILTER'[RONAME)&(ROFILTER'=0)
- QUIT
- +9 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)
- +10 IF DVBCSORT="V"
- SET ^TMP($JOB,PNAM,DFN,REQDA)=""
- QUIT
- +11 IF DVBCSORT="S"
- SET ^TMP($JOB,STAT,PNAM,DFN,REQDA)=""
- QUIT
- +12 IF DVBCSORT="R"
- IF $DATA(ADIVNUM)
- IF ROUT=ADIVNUM
- SET ^TMP($JOB,ROUT,PNAM,DFN,REQDA)=""
- QUIT
- +13 IF DVBCSORT="A"
- DO ELAPSED
- IF EDAYS'<ERDAYS
- IF EDAYS'>OLDAYS
- SET ^TMP($JOB,EDAYS,PNAM,DFN,REQDA)=""
- +14 QUIT
- +15 ;
- 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
- +1 QUIT
- +2 ;