118 lines
3.8 KiB
Mathematica
118 lines
3.8 KiB
Mathematica
|
BPSJINI1 ;BHAM ISC/LJF - HL7 Application Registration ;21-NOV-2003
|
||
|
|
;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004
|
||
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
||
|
|
;
|
||
|
|
Q ; No direct entry allowed
|
||
|
|
;
|
||
|
|
; Operating Hours
|
||
|
|
;
|
||
|
|
EN(PHRMIX) ;
|
||
|
|
N HOURS,HROPEN,HRCLOSE,TAB,BPSJWAIT,BPSJANS,BPSJOH,DTOUT
|
||
|
|
;
|
||
|
|
S HROPEN=$G(^BPS(9002313.56,PHRMIX,"TOPEN"))
|
||
|
|
S HRCLOSE=$G(^BPS(9002313.56,PHRMIX,"TCLOSE"))
|
||
|
|
; initialize to standard hours or ensure hours are valid
|
||
|
|
I HROPEN="" D
|
||
|
|
. S HROPEN="^0800^0800^0800^0800^0800^0800"
|
||
|
|
. S HRCLOSE="^1600^1600^1600^1600^1600^1600"
|
||
|
|
E F BPSJOH=1:1:7 D
|
||
|
|
. I $P(HROPEN,U,BPSJOH)="" S $P(HRCLOSE,U,BPSJOH)="" Q
|
||
|
|
. I $P(HROPEN,U,BPSJOH)<$P(HRCLOSE,U,BPSJOH) Q
|
||
|
|
. S $P(HROPEN,U,BPSJOH)="",$P(HRCLOSE,U,BPSJOH)=""
|
||
|
|
;
|
||
|
|
S BPSJWAIT=300 ; time out for questions
|
||
|
|
;
|
||
|
|
F D Q:BPSJANS=""
|
||
|
|
. W !!,"DAILY HOURS OF OPERATION",!
|
||
|
|
. W "DAY",?16,"1-SUN",?24,"2-MON",?32,"3-TUE",?40,"4-WED",?48,"5-THU",?56,"6-FRI",?64,"7-SAT",!
|
||
|
|
. S BPSJANS=0
|
||
|
|
. W !,"OPEN TIME" F BPSJOH=1:1:7 S TAB="?"_(BPSJOH*8+8) W @TAB,$P(HROPEN,U,BPSJOH)
|
||
|
|
. W !,"CLOSE TIME" F BPSJOH=1:1:7 S TAB="?"_(BPSJOH*8+8) W @TAB,$P(HRCLOSE,U,BPSJOH)
|
||
|
|
. S BPSJANS=$$EDITDAY(.HROPEN,.HRCLOSE) I BPSJANS="^" S BPSJANS=""
|
||
|
|
;
|
||
|
|
S ^BPS(9002313.56,PHRMIX,"TOPEN")=HROPEN
|
||
|
|
S ^BPS(9002313.56,PHRMIX,"TCLOSE")=HRCLOSE
|
||
|
|
W !
|
||
|
|
;
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
EDITDAY(HROPEN,HRCLOSE) ;
|
||
|
|
;
|
||
|
|
N BPSJDAY,BPSJT,BPSJO,BPSJC,DIR,X
|
||
|
|
;
|
||
|
|
W !
|
||
|
|
S DIR("A")="Enter Day to Edit"
|
||
|
|
S DIR("?")="^D DOC^BPSJINI1(0)"
|
||
|
|
S DIR(0)="NO^1:7"
|
||
|
|
D ^DIR S BPSJDAY=X ; ^,1-7,null
|
||
|
|
I '$G(DTOUT),BPSJDAY
|
||
|
|
E Q BPSJDAY ; Non-Numeric or Zero or Timed out
|
||
|
|
;
|
||
|
|
;OPEN TIME
|
||
|
|
F S BPSJO=$$OPENTIME Q:BPSJO=0
|
||
|
|
;
|
||
|
|
Q 0
|
||
|
|
;
|
||
|
|
OPENTIME() ;
|
||
|
|
N HH,MM,OPEN,DIR,X
|
||
|
|
;
|
||
|
|
S DIR("?")="^D DOC^BPSJINI1(1)"
|
||
|
|
S DIR("A")="Enter Open Time (4 digit military time, C=Closed,24 for open 24 hours)"
|
||
|
|
S DIR(0)="FOU^0:4"
|
||
|
|
D ^DIR S OPEN=X
|
||
|
|
I '$G(DTOUT),$L(OPEN),$E(OPEN)'="^"
|
||
|
|
E Q 0
|
||
|
|
;
|
||
|
|
I $TR($E(OPEN),"c","C")="C" S $P(HROPEN,U,BPSJDAY)="",$P(HRCLOSE,U,BPSJDAY)="" Q 0
|
||
|
|
I OPEN=24 S $P(HROPEN,U,BPSJDAY)="0000",$P(HRCLOSE,U,BPSJDAY)="2359" Q 0
|
||
|
|
I OPEN?4N
|
||
|
|
E W !!,"INVALID TIME ENTERED" D DOC(1) Q 1
|
||
|
|
S HH=$E(OPEN,1,2),MM=$E(OPEN,3,4)
|
||
|
|
I OPEN>-1,OPEN<2359
|
||
|
|
E W !!,"INVALID TIME: OPEN TIME MUST BE FROM 0000 TO 2358." Q 1
|
||
|
|
I MM>59 W !!,"INVALID TIME: MINUTES MUST FROM 00 TO 59." Q 1
|
||
|
|
I HH>23 W !!,"INVALID TIME: HOURS MUST BE FROM 00 AND 23." Q 1
|
||
|
|
;
|
||
|
|
;Close Time
|
||
|
|
F S BPSJC=$$ENDTIME Q:$L(BPSJC)
|
||
|
|
I BPSJC S $P(HROPEN,U,BPSJDAY)=OPEN,$P(HRCLOSE,U,BPSJDAY)=BPSJC
|
||
|
|
Q 0
|
||
|
|
;
|
||
|
|
ENDTIME() ;
|
||
|
|
N CLOSE,DIR,X
|
||
|
|
S DIR("?")="^D DOC^BPSJINI1(2)"
|
||
|
|
S DIR("A")="Enter Close Time (4 digit military time)"
|
||
|
|
S DIR(0)="FOU^4:4"
|
||
|
|
D ^DIR S CLOSE=X
|
||
|
|
I '$G(DTOUT),$L(CLOSE),$E(CLOSE)'="^"
|
||
|
|
E Q 0
|
||
|
|
S HH=$E(CLOSE,1,2),MM=$E(CLOSE,3,4)
|
||
|
|
I MM>59 W !!,"INVALID TIME: MINUTES MUST FROM 00 TO 59." Q ""
|
||
|
|
I HH>23 W !!,"INVALID TIME: HOURS MUST BE FROM 00 AND 23." Q ""
|
||
|
|
I CLOSE>0,CLOSE<2400
|
||
|
|
E W !!,"INVALID TIME: CLOSE TIME MUST BE FROM 0001 TO 2359." Q ""
|
||
|
|
I CLOSE<(OPEN+1) W !!,"INVALID TIME: CLOSE TIME MUST BE LATER THAN OPEN TIME." Q ""
|
||
|
|
Q CLOSE
|
||
|
|
;
|
||
|
|
DOC(DOCIX) ;
|
||
|
|
I $G(DOCIX)="" Q
|
||
|
|
I DOCIX=0 D Q
|
||
|
|
.W !,"ENTER 1 TO INDICATE SUNDAY, 2 FOR MONDAY ... 7 FOR SATURDAY",!
|
||
|
|
.W !,"ENTER <CR> OR '^' TO EXIT."
|
||
|
|
;
|
||
|
|
I DOCIX=1 D Q
|
||
|
|
.W !,"ENTER C TO INDICATE THE PHARMACY IS CLOSED ON THIS DAY."
|
||
|
|
.W !," (NO CLOSING TIME WILL BE REQUESTED)",!
|
||
|
|
.W !,"ENTER 24 TO INDIACTE THE PHARMACY IS OPEN FOR THE ENTIRE 24 HOURS OF THIS DAY."
|
||
|
|
.W !," (NO CLOSING TIME WILL BE REQUESTED)",!
|
||
|
|
.W !,"ENTER A MILITARY TIME FROM 0000 TO 2358."
|
||
|
|
.W !," (THIS WILL ALLOW THE PHARMACY TO BE OPEN FOR AT LEAST 1 MINUTE IF DESIRED)"
|
||
|
|
.W !," A CLOSING TIME WILL BE REQUESTED AND THE ALLOWED TIME WILL BE FROM 1 MINUTE"
|
||
|
|
.W !," AFTER OPENING TIME TO 2359.",!!!
|
||
|
|
;
|
||
|
|
I DOCIX=2 D Q
|
||
|
|
.W !,"ENTER A MILITARY TIME FROM 0001 TO 2359."
|
||
|
|
.W !," THE CLOSING TIME MUST BE AT LEAST 1 MINUTE AFTER THE OPENING TIME, UP TO 2359.",!!!
|
||
|
|
;
|
||
|
|
Q
|