BSDPARM.m

BSDPARM ; IHS/ANMC/LJF - IHS SCHEDULING PARAMETERS ;

 ;;5.3;PIMS;;APR 26, 2002

 ;

 NEW BSDF,BSDIV,DIE,DA,DR,DD,DO,DIC,DLAYGO,Y,X,DINUM,BSDERR

 ;

 ; -- get MAS Parameter file entry (only one allowed) and edit

 I '$D(^DG(43,1)) D  I $G(BSDERR)]"" D MSG^BDGF(BSDERR,1,0) Q

 . S BSDIV=$$CHOOSE(43,1,.BSDERR)

 Q:'$D(^DG(43,1,0))

 ;

 D TERM^VALM0

 D MSG^BDGF($G(IORVON)_"Editing system-wide parameters:"_$G(IORVOFF),1,1)

 S DIE=43,DA=1,DR="12T;11;212;205///5.3" D ^DIE Q:$D(Y)

 D MSG^BDGF($G(IORVON)_"Editing facility-wide parameters:"_$G(IORVOFF),3,1)

 ;

 ; -- if no entry in IHS Scheduling Parameter file, add one

 ;

 I '$O(^BSDPAR(0)) D  I $G(BSDERR) D MSG^BDGF(BSDERR,1,0) Q

 . ;

 . ; if no medical center division or > 1, add or choose one

 . S BSDF=$O(^DG(40.8,0))

 . I 'BSDF!$O(^DG(40.8,+BSDF)) S BSDF=+$$CHOOSE(40.8,"",.BSDERR)

 . Q:BSDF<1

 . ;

 . ; add ihs sched parameter entry to match

 . S BSDF=+$$CHOOSE(9009020.2,BSDF,.BSDERR)

 ;

AGAIN ;

 ; -- else choose facility to edit

 I '$G(BSDF) S BSDF=+$$CHOOSE(9009020.2,"",.BSDERR) Q:BSDF<1

 I $G(BSDERR)]"" D MSG^BDGF(BSDERR,1,0) Q

 ;

 ; -- check stuffed fields for IHS answers

 S DIE=40.8,DA=BSDF

 S DR=".07;1;35.01///^S X=""NO"";35.03///^S X=""NO"";100.01///0"

 D ^DIE Q:$D(Y)

 ;

 ;

 ; -- call ScreenMan to add/edit parameters

 NEW DDSFILE,DA,DR

 S DDSFILE=9009020.2,DA=BSDF,DR="[BSD PARAM]" D ^DDS

 K BSDF D AGAIN

 Q

 ;

 ;

CHOOSE(FILE,ENTRY,ERROR) ; calls DIC for file, add allowed

 NEW DD,DO,DIC,DLAYGO,X,DINUM

 K DD,DO S (DIC,DLAYGO)=FILE,DIC(0)="AMEQZL"

 I ENTRY]"" S (X,DINUM)=ENTRY D FILE^DICN I Y=-1 S ERROR="Adding entry to file "_FILE_" failed; contact supervisor." Q Y

 D ^DIC

 Q Y

BSDPARM   ; IHS/ANMC/LJF - IHS SCHEDULING PARAMETERS ;

 +1       ;;5.3;PIMS;;APR 26, 2002

 +2       ;

 +3        NEW BSDF,BSDIV,DIE,DA,DR,DD,DO,DIC,DLAYGO,Y,X,DINUM,BSDERR

 +4       ;

 +5       ; -- get MAS Parameter file entry (only one allowed) and edit

 +6        IF '$DATA(^DG(43,1))

               Begin DoDot:1

 +7                SET BSDIV=$$CHOOSE(43,1,.BSDERR)

               End DoDot:1

               IF $GET(BSDERR)]""

                   DO MSG^BDGF(BSDERR,1,0)

                   QUIT 

 +8        IF '$DATA(^DG(43,1,0))

               QUIT 

 +9       ;

 +10       DO TERM^VALM0

 +11       DO MSG^BDGF($GET(IORVON)_"Editing system-wide parameters:"_$GET(IORVOFF),1,1)

 +12       SET DIE=43

           SET DA=1

           SET DR="12T;11;212;205///5.3"

           DO ^DIE

           IF $DATA(Y)

               QUIT 

 +13       DO MSG^BDGF($GET(IORVON)_"Editing facility-wide parameters:"_$GET(IORVOFF),3,1)

 +14      ;

 +15      ; -- if no entry in IHS Scheduling Parameter file, add one

 +16      ;

 +17       IF '$ORDER(^BSDPAR(0))

               Begin DoDot:1

 +18      ;

 +19      ; if no medical center division or > 1, add or choose one

 +20               SET BSDF=$ORDER(^DG(40.8,0))

 +21               IF 'BSDF!$ORDER(^DG(40.8,+BSDF))

                       SET BSDF=+$$CHOOSE(40.8,"",.BSDERR)

 +22               IF BSDF<1

                       QUIT 

 +23      ;

 +24      ; add ihs sched parameter entry to match

 +25               SET BSDF=+$$CHOOSE(9009020.2,BSDF,.BSDERR)

               End DoDot:1

               IF $GET(BSDERR)

                   DO MSG^BDGF(BSDERR,1,0)

                   QUIT 

 +26      ;

AGAIN     ;

 +1       ; -- else choose facility to edit

 +2        IF '$GET(BSDF)

               SET BSDF=+$$CHOOSE(9009020.2,"",.BSDERR)

               IF BSDF<1

                   QUIT 

 +3        IF $GET(BSDERR)]""

               DO MSG^BDGF(BSDERR,1,0)

               QUIT 

 +4       ;

 +5       ; -- check stuffed fields for IHS answers

 +6        SET DIE=40.8

           SET DA=BSDF

 +7        SET DR=".07;1;35.01///^S X=""NO"";35.03///^S X=""NO"";100.01///0"

 +8        DO ^DIE

           IF $DATA(Y)

               QUIT 

 +9       ;

 +10      ;

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

 +12       NEW DDSFILE,DA,DR

 +13       SET DDSFILE=9009020.2

           SET DA=BSDF

           SET DR="[BSD PARAM]"

           DO ^DDS

 +14       KILL BSDF

           DO AGAIN

 +15       QUIT 

 +16      ;

 +17      ;

CHOOSE(FILE,ENTRY,ERROR) ; calls DIC for file, add allowed

 +1        NEW DD,DO,DIC,DLAYGO,X,DINUM

 +2        KILL DD,DO

           SET (DIC,DLAYGO)=FILE

           SET DIC(0)="AMEQZL"

 +3        IF ENTRY]""

               SET (X,DINUM)=ENTRY

               DO FILE^DICN

               IF Y=-1

                   SET ERROR="Adding entry to file "_FILE_" failed; contact supervisor."

                   QUIT Y

 +4        DO ^DIC

 +5        QUIT Y