- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPREOU.m
r613 r623 1 RMPREOU ;HINES/HNC -Suspense Processing Utility ;2-2-2000 2 ;;3.0;PROSTHETICS;**45,55,59,135**;Feb 09, 1996;Build 12 3 ; Add new function for working days M-F. 4 Q 5 ; 6 ITEM(DA,RL) ;psas hcpcs space item name 7 ;parm 1=ien 660 8 ;parm 2=string length 9 N DIC,DIQ,DR,ITEM 10 S DIC=660,DIQ="RE",DR="4:4.5",DIQ(0)="EN" D EN^DIQ1 11 S ITEM=$G(RE(660,DA,4.5,"E"))_" "_$G(RE(660,DA,4,"E")) 12 I $G(RL) S ITEM=$E(ITEM,0,RL) 13 K RE Q ITEM 14 ; 15 Q 16 PWRKDAY(DA) ;working days between init action and current dateM-F. 17 ;holidays are counted as working days 18 ;parm 1=ien 668, DA 19 ; 20 N RMTO,RB,RE 21 S RB=$P($G(^RMPR(668,DA,0)),U,9) 22 Q:RB="" 0 23 S RE=DT 24 Q:RE="" 0 25 D WDAY 26 Q RMTO 27 Q 28 ; 29 TYPE(DA,RL) ;type of consult, suspense 30 ;parm 1=ien 668 31 ;parm 2=string length optional 32 N DIC,DIQ,DR,TYPE 33 S DIC=668,DIQ="RE",DR=9,DIQ(0)="EN" D EN^DIQ1 34 S TYPE=$G(RE(668,DA,9,"E")) 35 I $G(RL) S TYPE=$E(TYPE,0,RL) 36 K RE Q TYPE 37 ; 38 ; 39 Q 40 PDAY(DA) ;days between create and init action 41 ;parm 1=ien 668 42 N PDAY,X1,X2 43 S PDAY="" 44 S X2=$P($G(^RMPR(668,DA,0)),U,1) 45 Q:X2="" PDAY 46 S X1=$P($G(^RMPR(668,DA,0)),U,9) 47 I X1="" S:$D(RMPRCD) X1=RMPRCD 48 ;Q:X1="" PDAY 49 D ^%DTC 50 Q X 51 ; 52 Q 53 DES(DA,RL) ;description for manual 54 ;parm 1=ien 668 55 ;parm 2=string length optional 56 N DES 57 S DES=$G(^RMPR(668,DA,2,1,0)) 58 I DES="" Q DES 59 I $G(RL) S DES=$E(DES,0,RL) 60 Q DES 61 ; 62 STATUS(DA,RL) ;status of suspense, open, pending, closed 63 N DIC,DIQ,DR,STATUS 64 S DIC=668,DIQ="RE",DR=14,DIQ(0)="EN" D EN^DIQ1 65 S STATUS=$G(RE(668,DA,14,"E")) 66 I STATUS="" S STATUS="UNKNOWN" 67 I $G(RL) S STATUS=$E(STATUS,0,RL) 68 K RE Q STATUS 69 ; 70 WHO(DA,RL) ;requestor or provider 71 N DIC,DIQ,DR,WHO 72 S DIC=200,DIQ="RE",DR=.01,DIQ(0)="EN" D EN^DIQ1 73 S WHO=$G(RE(200,DA,.01,"E")) 74 I $G(RL) S WHO=$E(WHO,0,RL) 75 K RE Q WHO 76 ; 77 Q 78 NUM ;pick number from list 79 K DIR S DIR(0)="LO^"_VALMBG_":"_VALMLST D ^DIR 80 Q 81 ; 82 NUM2 ;pick a single number from a list 83 K DIR S DIR(0)="N^"_VALMBG_":"_VALMLST D ^DIR 84 Q 85 ; 86 WRKDAY(DA) ;working days between create and init action M-F. 87 ;holidays are counted as working days 88 ;parm 1=ien 668, DA 89 ; 90 N RMTO,RB,RE 91 S RB=$P($G(^RMPR(668,DA,0)),U,1) 92 Q:RB="" 0 93 S RE=$P($G(^RMPR(668,DA,0)),U,9) 94 Q:RE="" 0 95 D WDAY 96 Q RMTO 97 CWRKDAY(DA) ;working days based on today for open records. 98 ;holidays are counted as working days 99 ;parm 1=ien 668, DA 100 N RMTO,RB,RE 101 S RB=$P($G(^RMPR(668,DA,0)),U,1) 102 Q:RB="" 0 103 S RE=DT 104 D WDAY 105 Q RMTO 106 CANWKDY(DA) ;*135 working days between create and cancel date for cancel w/o initial action records. 107 ;holidays are counted as working days 108 ;parm 1=ien 668, DA 109 N RMTO,RB,RE 110 S RB=$P($G(^RMPR(668,DA,0)),U) 111 Q:RB="" 0 112 S RE=$P(^RMPR(668,DA,5),U) 113 Q:RE="" 0 114 D WDAY 115 Q RMTO 116 WDAY ; RB - begining date 117 ; RE - ending date 118 ;Return variable: 119 ; RMTO - working days 120 ;Changed 03/26/03 to make a call to XUWORKDY to not count Holidays 121 ;In order to not couont Holidays the site must keep the Holiday file 122 ;current. 123 S RMTO=$$EN^XUWORKDY(RB,RE) 124 Q 125 ;Set days as Monday the FIRST day and so on: 126 ; Monday = 1 127 ; Sunday = 7 128 ;If invalid dates, return ZERO. 129 N X,Y,RMB,RME,RMTOT,RDSDAY,RDEDAY,RBCA,RNOB,RMNOD,RECA,RNO 130 1 S X1=RE,X2=RB D ^%DTC S RMNOD=X 131 S (RMTO,RMTOT,RECA)=0 132 S X=RB D DW^%DTC S RMB=X 133 S X=RE D DW^%DTC S RME=X 134 I (RB=RE)!(RB>RE)!(RMNOD'>0) Q 135 ;Get the FIRST set of Monday to Sunday days. 136 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) 137 S RNOB=$S(RDSDAY=1:4,RDSDAY=2:3,RDSDAY=3:2,RDSDAY=4:1,1:0) 138 I RNOB=4,RMNOD<7 S RNOB=$S(RMNOD=1:1,RMNOD=2:2,RMNOD=3:3,1:4) 139 I RNOB=3,RMNOD<6 S RNOB=$S(RMNOD=1:1,RMNOD=2:2,1:3) 140 I RNOB=2,RMNOD<5 S RNOB=$S(RMNOD=1:1,1:2) 141 S RBCA=7-RDSDAY 142 S RMNOD=RMNOD-RBCA 143 ;Get the SECOND set of Monday to Sunday days. 144 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) 145 I RMNOD>0 D 146 .S RECA=$S(RDEDAY=7:5,RDEDAY=6:5,1:RDEDAY) 147 .S RMNOD=RMNOD-RDEDAY 148 ; 149 ;calculate totals 150 S RMTOT=RMTOT+RNOB+RECA 151 I RMNOD>0,RMNOD<6 S RMTOT=RMTOT+RMNOD 152 I RMNOD=6 S RMTOT=RMTOT+RMNOD-1 153 I RMNOD=7 S RMTOT=RMTOT+RMNOD-2 154 ;if the FIRST and SECOND set of Monday to Sunday total is 155 ;still greater than 7 days, exclude Saturday and Sunday - don't count. 156 I RMNOD>7 S RMTOT=RMTOT+(RMNOD-((RMNOD/7)*2)) 157 S RMTO=$J(RMTOT,0,0) 158 END ; 1 RMPREOU ;HINES/HNC -Suspense Processing Utility ;2-2-2000 2 ;;3.0;PROSTHETICS;**45,55,59**;Feb 09, 1996 3 ; Add new function for working days M-F. 4 Q 5 ; 6 ITEM(DA,RL) ;psas hcpcs space item name 7 ;parm 1=ien 660 8 ;parm 2=string length 9 N DIC,DIQ,DR,ITEM 10 S DIC=660,DIQ="RE",DR="4:4.5",DIQ(0)="EN" D EN^DIQ1 11 S ITEM=$G(RE(660,DA,4.5,"E"))_" "_$G(RE(660,DA,4,"E")) 12 I $G(RL) S ITEM=$E(ITEM,0,RL) 13 K RE Q ITEM 14 ; 15 Q 16 PWRKDAY(DA) ;working days between init action and current dateM-F. 17 ;holidays are counted as working days 18 ;parm 1=ien 668, DA 19 ; 20 N RMTO,RB,RE 21 S RB=$P($G(^RMPR(668,DA,0)),U,9) 22 Q:RB="" 0 23 S RE=DT 24 Q:RE="" 0 25 D WDAY 26 Q RMTO 27 Q 28 ; 29 TYPE(DA,RL) ;type of consult, suspense 30 ;parm 1=ien 668 31 ;parm 2=string length optional 32 N DIC,DIQ,DR,TYPE 33 S DIC=668,DIQ="RE",DR=9,DIQ(0)="EN" D EN^DIQ1 34 S TYPE=$G(RE(668,DA,9,"E")) 35 I $G(RL) S TYPE=$E(TYPE,0,RL) 36 K RE Q TYPE 37 ; 38 ; 39 Q 40 PDAY(DA) ;days between create and init action 41 ;parm 1=ien 668 42 N PDAY,X1,X2 43 S PDAY="" 44 S X2=$P($G(^RMPR(668,DA,0)),U,1) 45 Q:X2="" PDAY 46 S X1=$P($G(^RMPR(668,DA,0)),U,9) 47 I X1="" S:$D(RMPRCD) X1=RMPRCD 48 ;Q:X1="" PDAY 49 D ^%DTC 50 Q X 51 ; 52 Q 53 DES(DA,RL) ;description for manual 54 ;parm 1=ien 668 55 ;parm 2=string length optional 56 N DES 57 S DES=$G(^RMPR(668,DA,2,1,0)) 58 I DES="" Q DES 59 I $G(RL) S DES=$E(DES,0,RL) 60 Q DES 61 ; 62 STATUS(DA,RL) ;status of suspense, open, pending, closed 63 N DIC,DIQ,DR,STATUS 64 S DIC=668,DIQ="RE",DR=14,DIQ(0)="EN" D EN^DIQ1 65 S STATUS=$G(RE(668,DA,14,"E")) 66 I STATUS="" S STATUS="UNKNOWN" 67 I $G(RL) S STATUS=$E(STATUS,0,RL) 68 K RE Q STATUS 69 ; 70 WHO(DA,RL) ;requestor or provider 71 N DIC,DIQ,DR,WHO 72 S DIC=200,DIQ="RE",DR=.01,DIQ(0)="EN" D EN^DIQ1 73 S WHO=$G(RE(200,DA,.01,"E")) 74 I $G(RL) S WHO=$E(WHO,0,RL) 75 K RE Q WHO 76 ; 77 Q 78 NUM ;pick number from list 79 K DIR S DIR(0)="LO^"_VALMBG_":"_VALMLST D ^DIR 80 Q 81 ; 82 NUM2 ;pick a single number from a list 83 K DIR S DIR(0)="N^"_VALMBG_":"_VALMLST D ^DIR 84 Q 85 ; 86 WRKDAY(DA) ;working days between create and init action M-F. 87 ;holidays are counted as working days 88 ;parm 1=ien 668, DA 89 ; 90 N RMTO,RB,RE 91 S RB=$P($G(^RMPR(668,DA,0)),U,1) 92 Q:RB="" 0 93 S RE=$P($G(^RMPR(668,DA,0)),U,9) 94 Q:RE="" 0 95 D WDAY 96 Q RMTO 97 CWRKDAY(DA) ;working days based on today for open records. 98 ;holidays are counted as working days 99 ;parm 1=ien 668, DA 100 N RMTO,RB,RE 101 S RB=$P($G(^RMPR(668,DA,0)),U,1) 102 Q:RB="" 0 103 S RE=DT 104 D WDAY 105 Q RMTO 106 WDAY ; RB - begining date 107 ; RE - ending date 108 ;Return variable: 109 ; RMTO - working days 110 ;Changed 03/26/03 to make a call to XUWORKDY to not count Holidays 111 ;In order to not couont Holidays the site must keep the Holiday file 112 ;current. 113 S RMTO=$$EN^XUWORKDY(RB,RE) 114 Q 115 ;Set days as Monday the FIRST day and so on: 116 ; Monday = 1 117 ; Sunday = 7 118 ;If invalid dates, return ZERO. 119 N X,Y,RMB,RME,RMTOT,RDSDAY,RDEDAY,RBCA,RNOB,RMNOD,RECA,RNO 120 1 S X1=RE,X2=RB D ^%DTC S RMNOD=X 121 S (RMTO,RMTOT,RECA)=0 122 S X=RB D DW^%DTC S RMB=X 123 S X=RE D DW^%DTC S RME=X 124 I (RB=RE)!(RB>RE)!(RMNOD'>0) Q 125 ;Get the FIRST set of Monday to Sunday days. 126 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) 127 S RNOB=$S(RDSDAY=1:4,RDSDAY=2:3,RDSDAY=3:2,RDSDAY=4:1,1:0) 128 I RNOB=4,RMNOD<7 S RNOB=$S(RMNOD=1:1,RMNOD=2:2,RMNOD=3:3,1:4) 129 I RNOB=3,RMNOD<6 S RNOB=$S(RMNOD=1:1,RMNOD=2:2,1:3) 130 I RNOB=2,RMNOD<5 S RNOB=$S(RMNOD=1:1,1:2) 131 S RBCA=7-RDSDAY 132 S RMNOD=RMNOD-RBCA 133 ;Get the SECOND set of Monday to Sunday days. 134 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) 135 I RMNOD>0 D 136 .S RECA=$S(RDEDAY=7:5,RDEDAY=6:5,1:RDEDAY) 137 .S RMNOD=RMNOD-RDEDAY 138 ; 139 ;calculate totals 140 S RMTOT=RMTOT+RNOB+RECA 141 I RMNOD>0,RMNOD<6 S RMTOT=RMTOT+RMNOD 142 I RMNOD=6 S RMTOT=RMTOT+RMNOD-1 143 I RMNOD=7 S RMTOT=RMTOT+RMNOD-2 144 ;if the FIRST and SECOND set of Monday to Sunday total is 145 ;still greater than 7 days, exclude Saturday and Sunday - don't count. 146 I RMNOD>7 S RMTOT=RMTOT+(RMNOD-((RMNOD/7)*2)) 147 S RMTO=$J(RMTOT,0,0) 148 END ;
Note:
See TracChangeset
for help on using the changeset viewer.
