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

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