BVPSD.m

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

 ;

MENU ; -- menu of scheduling actions for v5.0

 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       ;

MENU      ; -- menu of scheduling actions for v5.0

 +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