RMPREOU ;HINES/HNC -Suspense Processing Utility ;2-2-2000
;;3.0;PROSTHETICS;**45,55,59,135,83**;Feb 09, 1996;Build 20
; Add new function for working days M-F.
;
;HNC - #83, add free text ordering provider to tag WHO 3/11/05
;
Q
;
ITEM(DA,RL) ;psas hcpcs space item name
;parm 1=ien 660
;parm 2=string length
N DIC,DIQ,DR,ITEM
S DIC=660,DIQ="RE",DR="4:4.5",DIQ(0)="EN" D EN^DIQ1
S ITEM=$G(RE(660,DA,4.5,"E"))_" "_$G(RE(660,DA,4,"E"))
I $G(RL) S ITEM=$E(ITEM,0,RL)
K RE Q ITEM
;
Q
PWRKDAY(DA) ;working days between init action and current dateM-F.
;holidays are counted as working days
;parm 1=ien 668, DA
;
N RMTO,RB,RE
S RB=$P($G(^RMPR(668,DA,0)),U,9)
Q:RB="" 0
S RE=DT
Q:RE="" 0
D WDAY
Q RMTO
Q
;
TYPE(DA,RL) ;type of consult, suspense
;parm 1=ien 668
;parm 2=string length optional
N DIC,DIQ,DR,TYPE
S DIC=668,DIQ="RE",DR=9,DIQ(0)="EN" D EN^DIQ1
S TYPE=$G(RE(668,DA,9,"E"))
I $G(RL) S TYPE=$E(TYPE,0,RL)
K RE Q TYPE
;
;
Q
PDAY(DA) ;days between create and init action
;parm 1=ien 668
N PDAY,X1,X2
S PDAY=""
S X2=$P($G(^RMPR(668,DA,0)),U,1)
Q:X2="" PDAY
S X1=$P($G(^RMPR(668,DA,0)),U,9)
I X1="" S:$D(RMPRCD) X1=RMPRCD
;Q:X1="" PDAY
D ^%DTC
Q X
;
Q
DES(DA,RL) ;description for manual
;parm 1=ien 668
;parm 2=string length optional
N DES
S DES=$G(^RMPR(668,DA,2,1,0))
I DES="" Q DES
I $G(RL) S DES=$E(DES,0,RL)
Q DES
;
STATUS(DA,RL) ;status of suspense, open, pending, closed
N DIC,DIQ,DR,STATUS
S DIC=668,DIQ="RE",DR=14,DIQ(0)="EN" D EN^DIQ1
S STATUS=$G(RE(668,DA,14,"E"))
I STATUS="" S STATUS="UNKNOWN"
I $G(RL) S STATUS=$E(STATUS,0,RL)
K RE Q STATUS
;
WHO(DA,RL,RMPRA) ;requestor or provider
;DA ien to file 200
;RL length of return string
;RMPRA ien to file 668
N DIC,DIQ,DR,WHO
S WHO=""
I DA="" S WHO=$P($G(^RMPR(668,RMPRA,"IFC1")),U,3)
I (WHO'="")&($G(RL)'="") S WHO=$E(WHO,0,RL)
I WHO'="" Q WHO
S DIC=200,DIQ="RE",DR=.01,DIQ(0)="EN" D EN^DIQ1
S WHO=$G(RE(200,DA,.01,"E"))
I $G(RL) S WHO=$E(WHO,0,RL)
K RE Q WHO
;
Q
NUM ;pick number from list
K DIR S DIR(0)="LO^"_VALMBG_":"_VALMLST D ^DIR
Q
;
NUM2 ;pick a single number from a list
K DIR S DIR(0)="N^"_VALMBG_":"_VALMLST D ^DIR
Q
;
WRKDAY(DA) ;working days between create and init action M-F.
;holidays are counted as working days
;parm 1=ien 668, DA
;
N RMTO,RB,RE
S RB=$P($G(^RMPR(668,DA,0)),U,1)
Q:RB="" 0
S RE=$P($G(^RMPR(668,DA,0)),U,9)
Q:RE="" 0
D WDAY
Q RMTO
CWRKDAY(DA) ;working days based on today for open records.
;holidays are counted as working days
;parm 1=ien 668, DA
N RMTO,RB,RE
S RB=$P($G(^RMPR(668,DA,0)),U,1)
Q:RB="" 0
S RE=DT
D WDAY
Q RMTO
CANWKDY(DA) ;*135 working days between create and cancel date for cancel w/o initial action records.
;holidays are counted as working days
;parm 1=ien 668, DA
N RMTO,RB,RE
S RB=$P($G(^RMPR(668,DA,0)),U)
Q:RB="" 0
S RE=$P(^RMPR(668,DA,5),U)
Q:RE="" 0
D WDAY
Q RMTO
WDAY ; RB - begining date
; RE - ending date
;Return variable:
; RMTO - working days
;Changed 03/26/03 to make a call to XUWORKDY to not count Holidays
;In order to not couont Holidays the site must keep the Holiday file
;current.
S RMTO=$$EN^XUWORKDY(RB,RE)
Q
;Set days as Monday the FIRST day and so on:
; Monday = 1
; Sunday = 7
;If invalid dates, return ZERO.
N X,Y,RMB,RME,RMTOT,RDSDAY,RDEDAY,RBCA,RNOB,RMNOD,RECA,RNO
1 S X1=RE,X2=RB D ^%DTC S RMNOD=X
S (RMTO,RMTOT,RECA)=0
S X=RB D DW^%DTC S RMB=X
S X=RE D DW^%DTC S RME=X
I (RB=RE)!(RB>RE)!(RMNOD'>0) Q
;Get the FIRST set of Monday to Sunday days.
S RDSDAY=$S(RMB["MON":1,RMB["TUE":2,RMB["WED":3,RMB["THU":4,RMB["FRI":5,RMB["SAT":6,RMB["SUN":7,1:0)
S RNOB=$S(RDSDAY=1:4,RDSDAY=2:3,RDSDAY=3:2,RDSDAY=4:1,1:0)
I RNOB=4,RMNOD<7 S RNOB=$S(RMNOD=1:1,RMNOD=2:2,RMNOD=3:3,1:4)
I RNOB=3,RMNOD<6 S RNOB=$S(RMNOD=1:1,RMNOD=2:2,1:3)
I RNOB=2,RMNOD<5 S RNOB=$S(RMNOD=1:1,1:2)
S RBCA=7-RDSDAY
S RMNOD=RMNOD-RBCA
;Get the SECOND set of Monday to Sunday days.
S RDEDAY=$S(RME["MON":1,RME["TUE":2,RME["WED":3,RME["THU":4,RME["FRI":5,RME["SAT":6,RME["SUN":7,1:0)
I RMNOD>0 D
.S RECA=$S(RDEDAY=7:5,RDEDAY=6:5,1:RDEDAY)
.S RMNOD=RMNOD-RDEDAY
;
;calculate totals
S RMTOT=RMTOT+RNOB+RECA
I RMNOD>0,RMNOD<6 S RMTOT=RMTOT+RMNOD
I RMNOD=6 S RMTOT=RMTOT+RMNOD-1
I RMNOD=7 S RMTOT=RMTOT+RMNOD-2
;if the FIRST and SECOND set of Monday to Sunday total is
;still greater than 7 days, exclude Saturday and Sunday - don't count.
I RMNOD>7 S RMTOT=RMTOT+(RMNOD-((RMNOD/7)*2))
S RMTO=$J(RMTOT,0,0)
END ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPREOU 4678 printed Oct 16, 2024@18:35:09 Page 2
RMPREOU ;HINES/HNC -Suspense Processing Utility ;2-2-2000
+1 ;;3.0;PROSTHETICS;**45,55,59,135,83**;Feb 09, 1996;Build 20
+2 ; Add new function for working days M-F.
+3 ;
+4 ;HNC - #83, add free text ordering provider to tag WHO 3/11/05
+5 ;
+6 QUIT
+7 ;
ITEM(DA,RL) ;psas hcpcs space item name
+1 ;parm 1=ien 660
+2 ;parm 2=string length
+3 NEW DIC,DIQ,DR,ITEM
+4 SET DIC=660
SET DIQ="RE"
SET DR="4:4.5"
SET DIQ(0)="EN"
DO EN^DIQ1
+5 SET ITEM=$GET(RE(660,DA,4.5,"E"))_" "_$GET(RE(660,DA,4,"E"))
+6 IF $GET(RL)
SET ITEM=$EXTRACT(ITEM,0,RL)
+7 KILL RE
QUIT ITEM
+8 ;
+9 QUIT
PWRKDAY(DA) ;working days between init action and current dateM-F.
+1 ;holidays are counted as working days
+2 ;parm 1=ien 668, DA
+3 ;
+4 NEW RMTO,RB,RE
+5 SET RB=$PIECE($GET(^RMPR(668,DA,0)),U,9)
+6 if RB=""
QUIT 0
+7 SET RE=DT
+8 if RE=""
QUIT 0
+9 DO WDAY
+10 QUIT RMTO
+11 QUIT
+12 ;
TYPE(DA,RL) ;type of consult, suspense
+1 ;parm 1=ien 668
+2 ;parm 2=string length optional
+3 NEW DIC,DIQ,DR,TYPE
+4 SET DIC=668
SET DIQ="RE"
SET DR=9
SET DIQ(0)="EN"
DO EN^DIQ1
+5 SET TYPE=$GET(RE(668,DA,9,"E"))
+6 IF $GET(RL)
SET TYPE=$EXTRACT(TYPE,0,RL)
+7 KILL RE
QUIT TYPE
+8 ;
+9 ;
+10 QUIT
PDAY(DA) ;days between create and init action
+1 ;parm 1=ien 668
+2 NEW PDAY,X1,X2
+3 SET PDAY=""
+4 SET X2=$PIECE($GET(^RMPR(668,DA,0)),U,1)
+5 if X2=""
QUIT PDAY
+6 SET X1=$PIECE($GET(^RMPR(668,DA,0)),U,9)
+7 IF X1=""
if $DATA(RMPRCD)
SET X1=RMPRCD
+8 ;Q:X1="" PDAY
+9 DO ^%DTC
+10 QUIT X
+11 ;
+12 QUIT
DES(DA,RL) ;description for manual
+1 ;parm 1=ien 668
+2 ;parm 2=string length optional
+3 NEW DES
+4 SET DES=$GET(^RMPR(668,DA,2,1,0))
+5 IF DES=""
QUIT DES
+6 IF $GET(RL)
SET DES=$EXTRACT(DES,0,RL)
+7 QUIT DES
+8 ;
STATUS(DA,RL) ;status of suspense, open, pending, closed
+1 NEW DIC,DIQ,DR,STATUS
+2 SET DIC=668
SET DIQ="RE"
SET DR=14
SET DIQ(0)="EN"
DO EN^DIQ1
+3 SET STATUS=$GET(RE(668,DA,14,"E"))
+4 IF STATUS=""
SET STATUS="UNKNOWN"
+5 IF $GET(RL)
SET STATUS=$EXTRACT(STATUS,0,RL)
+6 KILL RE
QUIT STATUS
+7 ;
WHO(DA,RL,RMPRA) ;requestor or provider
+1 ;DA ien to file 200
+2 ;RL length of return string
+3 ;RMPRA ien to file 668
+4 NEW DIC,DIQ,DR,WHO
+5 SET WHO=""
+6 IF DA=""
SET WHO=$PIECE($GET(^RMPR(668,RMPRA,"IFC1")),U,3)
+7 IF (WHO'="")&($GET(RL)'="")
SET WHO=$EXTRACT(WHO,0,RL)
+8 IF WHO'=""
QUIT WHO
+9 SET DIC=200
SET DIQ="RE"
SET DR=.01
SET DIQ(0)="EN"
DO EN^DIQ1
+10 SET WHO=$GET(RE(200,DA,.01,"E"))
+11 IF $GET(RL)
SET WHO=$EXTRACT(WHO,0,RL)
+12 KILL RE
QUIT WHO
+13 ;
+14 QUIT
NUM ;pick number from list
+1 KILL DIR
SET DIR(0)="LO^"_VALMBG_":"_VALMLST
DO ^DIR
+2 QUIT
+3 ;
NUM2 ;pick a single number from a list
+1 KILL DIR
SET DIR(0)="N^"_VALMBG_":"_VALMLST
DO ^DIR
+2 QUIT
+3 ;
WRKDAY(DA) ;working days between create and init action M-F.
+1 ;holidays are counted as working days
+2 ;parm 1=ien 668, DA
+3 ;
+4 NEW RMTO,RB,RE
+5 SET RB=$PIECE($GET(^RMPR(668,DA,0)),U,1)
+6 if RB=""
QUIT 0
+7 SET RE=$PIECE($GET(^RMPR(668,DA,0)),U,9)
+8 if RE=""
QUIT 0
+9 DO WDAY
+10 QUIT RMTO
CWRKDAY(DA) ;working days based on today for open records.
+1 ;holidays are counted as working days
+2 ;parm 1=ien 668, DA
+3 NEW RMTO,RB,RE
+4 SET RB=$PIECE($GET(^RMPR(668,DA,0)),U,1)
+5 if RB=""
QUIT 0
+6 SET RE=DT
+7 DO WDAY
+8 QUIT RMTO
CANWKDY(DA) ;*135 working days between create and cancel date for cancel w/o initial action records.
+1 ;holidays are counted as working days
+2 ;parm 1=ien 668, DA
+3 NEW RMTO,RB,RE
+4 SET RB=$PIECE($GET(^RMPR(668,DA,0)),U)
+5 if RB=""
QUIT 0
+6 SET RE=$PIECE(^RMPR(668,DA,5),U)
+7 if RE=""
QUIT 0
+8 DO WDAY
+9 QUIT RMTO
WDAY ; RB - begining date
+1 ; RE - ending date
+2 ;Return variable:
+3 ; RMTO - working days
+4 ;Changed 03/26/03 to make a call to XUWORKDY to not count Holidays
+5 ;In order to not couont Holidays the site must keep the Holiday file
+6 ;current.
+7 SET RMTO=$$EN^XUWORKDY(RB,RE)
+8 QUIT
+9 ;Set days as Monday the FIRST day and so on:
+10 ; Monday = 1
+11 ; Sunday = 7
+12 ;If invalid dates, return ZERO.
+13 NEW X,Y,RMB,RME,RMTOT,RDSDAY,RDEDAY,RBCA,RNOB,RMNOD,RECA,RNO
1 SET X1=RE
SET X2=RB
DO ^%DTC
SET RMNOD=X
+1 SET (RMTO,RMTOT,RECA)=0
+2 SET X=RB
DO DW^%DTC
SET RMB=X
+3 SET X=RE
DO DW^%DTC
SET RME=X
+4 IF (RB=RE)!(RB>RE)!(RMNOD'>0)
QUIT
+5 ;Get the FIRST set of Monday to Sunday days.
+6 SET RDSDAY=$SELECT(RMB["MON":1,RMB["TUE":2,RMB["WED":3,RMB["THU":4,RMB["FRI":5,RMB["SAT":6,RMB["SUN":7,1:0)
+7 SET RNOB=$SELECT(RDSDAY=1:4,RDSDAY=2:3,RDSDAY=3:2,RDSDAY=4:1,1:0)
+8 IF RNOB=4
IF RMNOD<7
SET RNOB=$SELECT(RMNOD=1:1,RMNOD=2:2,RMNOD=3:3,1:4)
+9 IF RNOB=3
IF RMNOD<6
SET RNOB=$SELECT(RMNOD=1:1,RMNOD=2:2,1:3)
+10 IF RNOB=2
IF RMNOD<5
SET RNOB=$SELECT(RMNOD=1:1,1:2)
+11 SET RBCA=7-RDSDAY
+12 SET RMNOD=RMNOD-RBCA
+13 ;Get the SECOND set of Monday to Sunday days.
+14 SET RDEDAY=$SELECT(RME["MON":1,RME["TUE":2,RME["WED":3,RME["THU":4,RME["FRI":5,RME["SAT":6,RME["SUN":7,1:0)
+15 IF RMNOD>0
Begin DoDot:1
+16 SET RECA=$SELECT(RDEDAY=7:5,RDEDAY=6:5,1:RDEDAY)
+17 SET RMNOD=RMNOD-RDEDAY
End DoDot:1
+18 ;
+19 ;calculate totals
+20 SET RMTOT=RMTOT+RNOB+RECA
+21 IF RMNOD>0
IF RMNOD<6
SET RMTOT=RMTOT+RMNOD
+22 IF RMNOD=6
SET RMTOT=RMTOT+RMNOD-1
+23 IF RMNOD=7
SET RMTOT=RMTOT+RMNOD-2
+24 ;if the FIRST and SECOND set of Monday to Sunday total is
+25 ;still greater than 7 days, exclude Saturday and Sunday - don't count.
+26 IF RMNOD>7
SET RMTOT=RMTOT+(RMNOD-((RMNOD/7)*2))
+27 SET RMTO=$JUSTIFY(RMTOT,0,0)
END ;
