source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPREOU.m@ 1311

Last change on this file since 1311 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1RMPREOU ;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 ;
6ITEM(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
16PWRKDAY(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 ;
29TYPE(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
40PDAY(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
53DES(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 ;
62STATUS(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 ;
70WHO(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
78NUM ;pick number from list
79 K DIR S DIR(0)="LO^"_VALMBG_":"_VALMLST D ^DIR
80 Q
81 ;
82NUM2 ;pick a single number from a list
83 K DIR S DIR(0)="N^"_VALMBG_":"_VALMLST D ^DIR
84 Q
85 ;
86WRKDAY(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
97CWRKDAY(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
106CANWKDY(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
116WDAY ; 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
1301 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)
158END ;
Note: See TracBrowser for help on using the repository browser.