BSDB.m

BSDB ; IHS/ANMC/LJF - SET UP A CLINIC VIA SCREENMAN ;

 ;;5.3;PIMS;**1009,1010**;APR 26, 2002

 ;

 ;cmi/anch/maw 10/20/2008 PATCH 1010 added INST which is called from DATA VALIDATION of the DIVISION field of the BSD SET UP CLINIC form

 ;

SETUP(BSDDA) ;EP; clinic setup

 ; called by ^SDB

 ;

 ; -- if no entry in Clinic Setup Parameters file, add one

 NEW DA,DIC,DDR,DLAYGO,BSDERR

 I '$D(^BSDSC(BSDDA)) D  I $G(BSDERR) D MSG^BDGF(BSDERR) Q

 . K DD,DO S DIC="^BSDSC(",DLAYGO=9009017.2,DIC(0)="L"

 . S (X,DINUM)=BSDDA D FILE^DICN

 . I Y=-1 S BSDERR="Adding to IHS file failed; contact supervisor."

 ;

 ; -- if new clinic, ask length of appt up front

 I '$G(^SC(BSDDA,"SL")) D

 . S DIE=44,DA=BSDDA,DR="1912" D ^DIE

 ;

 ; -- call ScreenMan to add/edit parameters

 S DDSFILE=9009017.2,DA=BSDDA,DR="[BSD SET UP CLINIC]" D ^DDS

 K DDSFILE,DR

 Q

 ;

HELP1 ;EP; called by HLPD^SDB1 for help on AVAILABILITY DATE

 W !!?5,"For each day of the week that this clinic meets, enter the"

 W !?5,"FIRST date available.  You will then be asked for the range"

 W !?5,"of appointment times and the number of slots per appointment."

 W !?5,"If you enter a date that has already been set up, you will"

 W !?5,"be changing its appointment schedule.  BE CAREFUL!",!

 Q

 ;

INST(DA,BSDX) ;-- stuff the institution of the division in the HOSPITAL LOCATION file from the DIVISION selected in Set Up A Clinic

 N BSDINST

 S BSDINST=$P($G(^DG(40.8,BSDX,0)),U,7)

 S DIE="^SC(",DR="3////"_$G(BSDINST)

 D ^DIE

 K DIE

 Q

 ;

BSDB      ; IHS/ANMC/LJF - SET UP A CLINIC VIA SCREENMAN ;

 +1       ;;5.3;PIMS;**1009,1010**;APR 26, 2002

 +2       ;

 +3       ;cmi/anch/maw 10/20/2008 PATCH 1010 added INST which is called from DATA VALIDATION of the DIVISION field of the BSD SET UP CLINIC form

 +4       ;

SETUP(BSDDA) ;EP; clinic setup

 +1       ; called by ^SDB

 +2       ;

 +3       ; -- if no entry in Clinic Setup Parameters file, add one

 +4        NEW DA,DIC,DDR,DLAYGO,BSDERR

 +5        IF '$DATA(^BSDSC(BSDDA))

               Begin DoDot:1

 +6                KILL DD,DO

                   SET DIC="^BSDSC("

                   SET DLAYGO=9009017.2

                   SET DIC(0)="L"

 +7                SET (X,DINUM)=BSDDA

                   DO FILE^DICN

 +8                IF Y=-1

                       SET BSDERR="Adding to IHS file failed; contact supervisor."

               End DoDot:1

               IF $GET(BSDERR)

                   DO MSG^BDGF(BSDERR)

                   QUIT 

 +9       ;

 +10      ; -- if new clinic, ask length of appt up front

 +11       IF '$GET(^SC(BSDDA,"SL"))

               Begin DoDot:1

 +12               SET DIE=44

                   SET DA=BSDDA

                   SET DR="1912"

                   DO ^DIE

               End DoDot:1

 +13      ;

 +14      ; -- call ScreenMan to add/edit parameters

 +15       SET DDSFILE=9009017.2

           SET DA=BSDDA

           SET DR="[BSD SET UP CLINIC]"

           DO ^DDS

 +16       KILL DDSFILE,DR

 +17       QUIT 

 +18      ;

HELP1     ;EP; called by HLPD^SDB1 for help on AVAILABILITY DATE

 +1        WRITE !!?5,"For each day of the week that this clinic meets, enter the"

 +2        WRITE !?5,"FIRST date available.  You will then be asked for the range"

 +3        WRITE !?5,"of appointment times and the number of slots per appointment."

 +4        WRITE !?5,"If you enter a date that has already been set up, you will"

 +5        WRITE !?5,"be changing its appointment schedule.  BE CAREFUL!",!

 +6        QUIT 

 +7       ;

INST(DA,BSDX) ;-- stuff the institution of the division in the HOSPITAL LOCATION file from the DIVISION selected in Set Up A Clinic

 +1        NEW BSDINST

 +2        SET BSDINST=$PIECE($GET(^DG(40.8,BSDX,0)),U,7)

 +3        SET DIE="^SC("

           SET DR="3////"_$GET(BSDINST)

 +4        DO ^DIE

 +5        KILL DIE

 +6        QUIT 

 +7       ;