source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSJINI1.m@ 724

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1BPSJINI1 ;BHAM ISC/LJF - HL7 Application Registration ;21-NOV-2003
2 ;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q ; No direct entry allowed
6 ;
7 ; Operating Hours
8 ;
9EN(PHRMIX) ;
10 N HOURS,HROPEN,HRCLOSE,TAB,BPSJWAIT,BPSJANS,BPSJOH,DTOUT
11 ;
12 S HROPEN=$G(^BPS(9002313.56,PHRMIX,"TOPEN"))
13 S HRCLOSE=$G(^BPS(9002313.56,PHRMIX,"TCLOSE"))
14 ; initialize to standard hours or ensure hours are valid
15 I HROPEN="" D
16 . S HROPEN="^0800^0800^0800^0800^0800^0800"
17 . S HRCLOSE="^1600^1600^1600^1600^1600^1600"
18 E F BPSJOH=1:1:7 D
19 . I $P(HROPEN,U,BPSJOH)="" S $P(HRCLOSE,U,BPSJOH)="" Q
20 . I $P(HROPEN,U,BPSJOH)<$P(HRCLOSE,U,BPSJOH) Q
21 . S $P(HROPEN,U,BPSJOH)="",$P(HRCLOSE,U,BPSJOH)=""
22 ;
23 S BPSJWAIT=300 ; time out for questions
24 ;
25 F D Q:BPSJANS=""
26 . W !!,"DAILY HOURS OF OPERATION",!
27 . W "DAY",?16,"1-SUN",?24,"2-MON",?32,"3-TUE",?40,"4-WED",?48,"5-THU",?56,"6-FRI",?64,"7-SAT",!
28 . S BPSJANS=0
29 . W !,"OPEN TIME" F BPSJOH=1:1:7 S TAB="?"_(BPSJOH*8+8) W @TAB,$P(HROPEN,U,BPSJOH)
30 . W !,"CLOSE TIME" F BPSJOH=1:1:7 S TAB="?"_(BPSJOH*8+8) W @TAB,$P(HRCLOSE,U,BPSJOH)
31 . S BPSJANS=$$EDITDAY(.HROPEN,.HRCLOSE) I BPSJANS="^" S BPSJANS=""
32 ;
33 S ^BPS(9002313.56,PHRMIX,"TOPEN")=HROPEN
34 S ^BPS(9002313.56,PHRMIX,"TCLOSE")=HRCLOSE
35 W !
36 ;
37 Q
38 ;
39EDITDAY(HROPEN,HRCLOSE) ;
40 ;
41 N BPSJDAY,BPSJT,BPSJO,BPSJC,DIR,X
42 ;
43 W !
44 S DIR("A")="Enter Day to Edit"
45 S DIR("?")="^D DOC^BPSJINI1(0)"
46 S DIR(0)="NO^1:7"
47 D ^DIR S BPSJDAY=X ; ^,1-7,null
48 I '$G(DTOUT),BPSJDAY
49 E Q BPSJDAY ; Non-Numeric or Zero or Timed out
50 ;
51 ;OPEN TIME
52 F S BPSJO=$$OPENTIME Q:BPSJO=0
53 ;
54 Q 0
55 ;
56OPENTIME() ;
57 N HH,MM,OPEN,DIR,X
58 ;
59 S DIR("?")="^D DOC^BPSJINI1(1)"
60 S DIR("A")="Enter Open Time (4 digit military time, C=Closed,24 for open 24 hours)"
61 S DIR(0)="FOU^0:4"
62 D ^DIR S OPEN=X
63 I '$G(DTOUT),$L(OPEN),$E(OPEN)'="^"
64 E Q 0
65 ;
66 I $TR($E(OPEN),"c","C")="C" S $P(HROPEN,U,BPSJDAY)="",$P(HRCLOSE,U,BPSJDAY)="" Q 0
67 I OPEN=24 S $P(HROPEN,U,BPSJDAY)="0000",$P(HRCLOSE,U,BPSJDAY)="2359" Q 0
68 I OPEN?4N
69 E W !!,"INVALID TIME ENTERED" D DOC(1) Q 1
70 S HH=$E(OPEN,1,2),MM=$E(OPEN,3,4)
71 I OPEN>-1,OPEN<2359
72 E W !!,"INVALID TIME: OPEN TIME MUST BE FROM 0000 TO 2358." Q 1
73 I MM>59 W !!,"INVALID TIME: MINUTES MUST FROM 00 TO 59." Q 1
74 I HH>23 W !!,"INVALID TIME: HOURS MUST BE FROM 00 AND 23." Q 1
75 ;
76 ;Close Time
77 F S BPSJC=$$ENDTIME Q:$L(BPSJC)
78 I BPSJC S $P(HROPEN,U,BPSJDAY)=OPEN,$P(HRCLOSE,U,BPSJDAY)=BPSJC
79 Q 0
80 ;
81ENDTIME() ;
82 N CLOSE,DIR,X
83 S DIR("?")="^D DOC^BPSJINI1(2)"
84 S DIR("A")="Enter Close Time (4 digit military time)"
85 S DIR(0)="FOU^4:4"
86 D ^DIR S CLOSE=X
87 I '$G(DTOUT),$L(CLOSE),$E(CLOSE)'="^"
88 E Q 0
89 S HH=$E(CLOSE,1,2),MM=$E(CLOSE,3,4)
90 I MM>59 W !!,"INVALID TIME: MINUTES MUST FROM 00 TO 59." Q ""
91 I HH>23 W !!,"INVALID TIME: HOURS MUST BE FROM 00 AND 23." Q ""
92 I CLOSE>0,CLOSE<2400
93 E W !!,"INVALID TIME: CLOSE TIME MUST BE FROM 0001 TO 2359." Q ""
94 I CLOSE<(OPEN+1) W !!,"INVALID TIME: CLOSE TIME MUST BE LATER THAN OPEN TIME." Q ""
95 Q CLOSE
96 ;
97DOC(DOCIX) ;
98 I $G(DOCIX)="" Q
99 I DOCIX=0 D Q
100 .W !,"ENTER 1 TO INDICATE SUNDAY, 2 FOR MONDAY ... 7 FOR SATURDAY",!
101 .W !,"ENTER <CR> OR '^' TO EXIT."
102 ;
103 I DOCIX=1 D Q
104 .W !,"ENTER C TO INDICATE THE PHARMACY IS CLOSED ON THIS DAY."
105 .W !," (NO CLOSING TIME WILL BE REQUESTED)",!
106 .W !,"ENTER 24 TO INDIACTE THE PHARMACY IS OPEN FOR THE ENTIRE 24 HOURS OF THIS DAY."
107 .W !," (NO CLOSING TIME WILL BE REQUESTED)",!
108 .W !,"ENTER A MILITARY TIME FROM 0000 TO 2358."
109 .W !," (THIS WILL ALLOW THE PHARMACY TO BE OPEN FOR AT LEAST 1 MINUTE IF DESIRED)"
110 .W !," A CLOSING TIME WILL BE REQUESTED AND THE ALLOWED TIME WILL BE FROM 1 MINUTE"
111 .W !," AFTER OPENING TIME TO 2359.",!!!
112 ;
113 I DOCIX=2 D Q
114 .W !,"ENTER A MILITARY TIME FROM 0001 TO 2359."
115 .W !," THE CLOSING TIME MUST BE AT LEAST 1 MINUTE AFTER THE OPENING TIME, UP TO 2359.",!!!
116 ;
117 Q
Note: See TracBrowser for help on using the repository browser.