- BVPSD ; IHS/ITSC/LJF - DEMO/APPTS ACTION ;
- ;;1.0;VIEW PATIENT RECORD;;NOV 17, 2004
- ;
- I $L($T(^BSDAM)) D PIMS Q ;Scheduling v5.3
- I $$PKGCK^BVPU("ASDREG","SCHEDULING V5.0") D MENU Q ;Scheduling v5.0
- Q
- ;
- PIMS ; -- access to Scheduling v5.3
- D HDLKILL^SDAMEVT
- NEW SDY
- S SDY=DFN_";DPT("
- D EN1^SDAM,HDLKILL^SDAMEVT
- S DFN=BVPSAV D SETPT^BVPMAIN(DFN)
- Q
- ;
- NEW DIR,I,DIRUT,Y
- D ^XBCLS,FULL^VALM1
- D MSG^BVPU($$SP(10)_"SCHEDULING ACTIONS AVAILABLE",2,2,0)
- S DIR(0)="NO^1:5",DIR("A")="Select Action by number"
- F I=1:1:5 S DIR("A",I)=$P($T(CHOICE+I),";;",2)
- D ^DIR K DIR Q:$D(DIRUT) D @Y G MENU
- ;
- 1 ; -- make appt
- NEW SDPEP,SDMM,DIC
- D MSG^BVPU($$SP(10)_"Make Appointment for "_$$NAME,2,2,0)
- S SDPEP=1,SDMM=0 D EN1^SDM S DFN=BVPSAV D SETPT^BVPMAIN(DFN)
- Q
- ;
- 2 ; -- cancel appt
- NEW SDPEP,DA,NAME
- D MSG^BVPU($$SP(10)_"Cancel Appointment for "_$$NAME,2,2,0)
- S SDPEP=1,DA=DFN,NAME=$$NAME D EN^SDCNP
- S DFN=BVPSAV D SETPT^BVPMAIN(DFN)
- Q
- ;
- 3 ; -- check-in/walkin
- NEW SDPEP,DIV
- S SDPEP=1 D PAT2^ASDI,PAUSE^BVPU
- S DFN=BVPSAV D SETPT^BVPMAIN(DFN)
- Q
- ;
- 4 ; -- display appts
- NEW SDPEP,HDT,APL,SDRG,SDEDT,OTH,SDEND,DA,NAME
- S SDPEP=1,NAME=$$NAME,HDT=DT,(APL,SDEDT,OTH)="",(SDRG,SDEND)=0
- S DA=DFN D RD1^SDDPA,PAUSE^BVPU
- S DFN=BVPSAV D SETPT^BVPMAIN(DFN)
- Q
- ;
- 5 ; -- record no-show
- NEW SDPEP,DA,NAME
- D MSG^BVPU($$SP(10)_"Record No-Show for "_$$NAME,2,2,0)
- S SDPEP=1,DA=DFN,NAME=$$NAME D ^SDN
- S DFN=BVPSAV D SETPT^BVPMAIN(DFN)
- Q
- ;
- NAME() ; -- returns printable name
- Q $$GET1^DIQ(9000001,DFN,.01)
- ;
- PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
- Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
- ;
- SP(NUM) ; -- SUBRTN to pad spaces
- Q $$PAD(" ",NUM)
- ;
- CHOICE ;;
- ;; 1. MAKE APPOINTMENT
- ;; 2. CANCEL APPOINTMENT
- ;; 3. CHECK-IN/WALK-IN/CHART REQUEST
- ;; 4. DISPLAY APPOINTMENT
- ;; 5. RECORD NO-SHOW
- BVPSD ; IHS/ITSC/LJF - DEMO/APPTS ACTION ;
- +1 ;;1.0;VIEW PATIENT RECORD;;NOV 17, 2004
- +2 ;
- +3 ;Scheduling v5.3
- IF $LENGTH($TEXT(^BSDAM))
- DO PIMS
- QUIT
- +4 ;Scheduling v5.0
- IF $$PKGCK^BVPU("ASDREG","SCHEDULING V5.0")
- DO MENU
- QUIT
- +5 QUIT
- +6 ;
- PIMS ; -- access to Scheduling v5.3
- +1 DO HDLKILL^SDAMEVT
- +2 NEW SDY
- +3 SET SDY=DFN_";DPT("
- +4 DO EN1^SDAM
- DO HDLKILL^SDAMEVT
- +5 SET DFN=BVPSAV
- DO SETPT^BVPMAIN(DFN)
- +6 QUIT
- +7 ;
- +1 NEW DIR,I,DIRUT,Y
- +2 DO ^XBCLS
- DO FULL^VALM1
- +3 DO MSG^BVPU($$SP(10)_"SCHEDULING ACTIONS AVAILABLE",2,2,0)
- +4 SET DIR(0)="NO^1:5"
- SET DIR("A")="Select Action by number"
- +5 FOR I=1:1:5
- SET DIR("A",I)=$PIECE($TEXT(CHOICE+I),";;",2)
- +6 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- QUIT
- DO @Y
- GOTO MENU
- +7 ;
- 1 ; -- make appt
- +1 NEW SDPEP,SDMM,DIC
- +2 DO MSG^BVPU($$SP(10)_"Make Appointment for "_$$NAME,2,2,0)
- +3 SET SDPEP=1
- SET SDMM=0
- DO EN1^SDM
- SET DFN=BVPSAV
- DO SETPT^BVPMAIN(DFN)
- +4 QUIT
- +5 ;
- 2 ; -- cancel appt
- +1 NEW SDPEP,DA,NAME
- +2 DO MSG^BVPU($$SP(10)_"Cancel Appointment for "_$$NAME,2,2,0)
- +3 SET SDPEP=1
- SET DA=DFN
- SET NAME=$$NAME
- DO EN^SDCNP
- +4 SET DFN=BVPSAV
- DO SETPT^BVPMAIN(DFN)
- +5 QUIT
- +6 ;
- 3 ; -- check-in/walkin
- +1 NEW SDPEP,DIV
- +2 SET SDPEP=1
- DO PAT2^ASDI
- DO PAUSE^BVPU
- +3 SET DFN=BVPSAV
- DO SETPT^BVPMAIN(DFN)
- +4 QUIT
- +5 ;
- 4 ; -- display appts
- +1 NEW SDPEP,HDT,APL,SDRG,SDEDT,OTH,SDEND,DA,NAME
- +2 SET SDPEP=1
- SET NAME=$$NAME
- SET HDT=DT
- SET (APL,SDEDT,OTH)=""
- SET (SDRG,SDEND)=0
- +3 SET DA=DFN
- DO RD1^SDDPA
- DO PAUSE^BVPU
- +4 SET DFN=BVPSAV
- DO SETPT^BVPMAIN(DFN)
- +5 QUIT
- +6 ;
- 5 ; -- record no-show
- +1 NEW SDPEP,DA,NAME
- +2 DO MSG^BVPU($$SP(10)_"Record No-Show for "_$$NAME,2,2,0)
- +3 SET SDPEP=1
- SET DA=DFN
- SET NAME=$$NAME
- DO ^SDN
- +4 SET DFN=BVPSAV
- DO SETPT^BVPMAIN(DFN)
- +5 QUIT
- +6 ;
- NAME() ; -- returns printable name
- +1 QUIT $$GET1^DIQ(9000001,DFN,.01)
- +2 ;
- PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
- +1 QUIT $EXTRACT(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
- +2 ;
- SP(NUM) ; -- SUBRTN to pad spaces
- +1 QUIT $$PAD(" ",NUM)
- +2 ;
- CHOICE ;;
- +1 ;; 1. MAKE APPOINTMENT
- +2 ;; 2. CANCEL APPOINTMENT
- +3 ;; 3. CHECK-IN/WALK-IN/CHART REQUEST
- +4 ;; 4. DISPLAY APPOINTMENT
- +5 ;; 5. RECORD NO-SHOW
