BSDCLA.m

BSDCLA ; IHS/ANMC/LJF - LIST CLINIC ABBREVIATIONS ;  [ 01/13/2004  2:10 PM ]

 ;;5.3;PIMS;;APR 26, 2002

 ;

 S Y=$$BROWSE^BDGF I Y="B" D EN^BSDCLA Q

 I Y="P" D ZIS^BDGF("PQ","START^BSDCLA","LIST CLINIC ABBREV") Q

 K POP

 Q

 ;

START ;EP; called if printing to paper

 NEW BSDPG,ABBRV,CLN

 U IO S BSDPG=0 D HED

 S ABBRV=0 F  S ABBRV=$O(^SC("C",ABBRV)) Q:ABBRV=""  D

 . S CLN=0 F  S CLN=$O(^SC("C",ABBRV,CLN)) Q:CLN=""  D

 .. Q:$P(^SC(CLN,0),U,3)'["C"  Q:'$$ACTV^BSDU(CLN,DT)

 .. I $Y>(IOSL-4) D HED

 .. W !,ABBRV,?10,$P(^SC(CLN,0),U)

 D ^%ZISC Q

 ;

EN ;EP -- main entry point for BSDRM CLINIC ABBREVIATIONS

 NEW VALMCNT D TERM^VALM0,CLEAR^VALM1

 D EN^VALM("BSDRM CLINIC ABBREVIATIONS")

 D CLEAR^VALM1

 Q

 ;

HDR ; -- header code

 Q

 ;

INIT ; -- init variables and list array

 D MSG^BDGF("Gathering clinics and sorting by abbreviations...",1,0)

 NEW ABBRV,CLN

 S VALMCNT=0 K ^TMP("BSDCLA",$J)

 S ABBRV=0 F  S ABBRV=$O(^SC("C",ABBRV)) Q:ABBRV=""  D

 . S CLN=0 F  S CLN=$O(^SC("C",ABBRV,CLN)) Q:CLN=""  D

 .. Q:$P(^SC(CLN,0),U,3)'["C"  Q:'$$ACTV^BSDU(CLN,DT)

 .. S VALMCNT=VALMCNT+1

 .. S ^TMP("BSDCLA",$J,VALMCNT,0)=$$PAD(ABBRV,10)_$$GET1^DIQ(44,CLN,.01)

 I VALMCNT=0 S ^TMP("BSDCLA",$J,1,0)="NO ACTIVE CLINICS FOUND",VALMCNT=1

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 K ^TMP("BSDCLA",$J),POP

 Q

 ;

EXPND ; -- expand code

 Q

 ;

HED ; -- heading

 I (BSDPG>0) W @IOF

 S BSDPG=BSDPG+1 W !!?25,"CLINIC ABBREVIATIONS",?70,"Page ",BSDPG

 W !,$$REPEAT^XLFSTR("=",80),!

 Q

 ;

PAD(D,L) ;EP -- SUBRTN to pad length of data

 ; -- D=data L=length

 Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)

 ;

SP(N) ; -- SUBRTN to pad N number of spaces

 Q $$PAD(" ",N)

BSDCLA    ; IHS/ANMC/LJF - LIST CLINIC ABBREVIATIONS ;  [ 01/13/2004  2:10 PM ]

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

 +2       ;

 +3        SET Y=$$BROWSE^BDGF

           IF Y="B"

               DO EN^BSDCLA

               QUIT 

 +4        IF Y="P"

               DO ZIS^BDGF("PQ","START^BSDCLA","LIST CLINIC ABBREV")

               QUIT 

 +5        KILL POP

 +6        QUIT 

 +7       ;

START     ;EP; called if printing to paper

 +1        NEW BSDPG,ABBRV,CLN

 +2        USE IO

           SET BSDPG=0

           DO HED

 +3        SET ABBRV=0

           FOR 

               SET ABBRV=$ORDER(^SC("C",ABBRV))

               IF ABBRV=""

                   QUIT 

               Begin DoDot:1

 +4                SET CLN=0

                   FOR 

                       SET CLN=$ORDER(^SC("C",ABBRV,CLN))

                       IF CLN=""

                           QUIT 

                       Begin DoDot:2

 +5                        IF $PIECE(^SC(CLN,0),U,3)'["C"

                               QUIT 

                           IF '$$ACTV^BSDU(CLN,DT)

                               QUIT 

 +6                        IF $Y>(IOSL-4)

                               DO HED

 +7                        WRITE !,ABBRV,?10,$PIECE(^SC(CLN,0),U)

                       End DoDot:2

               End DoDot:1

 +8        DO ^%ZISC

           QUIT 

 +9       ;

EN        ;EP -- main entry point for BSDRM CLINIC ABBREVIATIONS

 +1        NEW VALMCNT

           DO TERM^VALM0

           DO CLEAR^VALM1

 +2        DO EN^VALM("BSDRM CLINIC ABBREVIATIONS")

 +3        DO CLEAR^VALM1

 +4        QUIT 

 +5       ;

HDR       ; -- header code

 +1        QUIT 

 +2       ;

INIT      ; -- init variables and list array

 +1        DO MSG^BDGF("Gathering clinics and sorting by abbreviations...",1,0)

 +2        NEW ABBRV,CLN

 +3        SET VALMCNT=0

           KILL ^TMP("BSDCLA",$JOB)

 +4        SET ABBRV=0

           FOR 

               SET ABBRV=$ORDER(^SC("C",ABBRV))

               IF ABBRV=""

                   QUIT 

               Begin DoDot:1

 +5                SET CLN=0

                   FOR 

                       SET CLN=$ORDER(^SC("C",ABBRV,CLN))

                       IF CLN=""

                           QUIT 

                       Begin DoDot:2

 +6                        IF $PIECE(^SC(CLN,0),U,3)'["C"

                               QUIT 

                           IF '$$ACTV^BSDU(CLN,DT)

                               QUIT 

 +7                        SET VALMCNT=VALMCNT+1

 +8                        SET ^TMP("BSDCLA",$JOB,VALMCNT,0)=$$PAD(ABBRV,10)_$$GET1^DIQ(44,CLN,.01)

                       End DoDot:2

               End DoDot:1

 +9        IF VALMCNT=0

               SET ^TMP("BSDCLA",$JOB,1,0)="NO ACTIVE CLINICS FOUND"

               SET VALMCNT=1

 +10       QUIT 

 +11      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL ^TMP("BSDCLA",$JOB),POP

 +2        QUIT 

 +3       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

HED       ; -- heading

 +1        IF (BSDPG>0)

               WRITE @IOF

 +2        SET BSDPG=BSDPG+1

           WRITE !!?25,"CLINIC ABBREVIATIONS",?70,"Page ",BSDPG

 +3        WRITE !,$$REPEAT^XLFSTR("=",80),!

 +4        QUIT 

 +5       ;

PAD(D,L)  ;EP -- SUBRTN to pad length of data

 +1       ; -- D=data L=length

 +2        QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)

 +3       ;

SP(N)     ; -- SUBRTN to pad N number of spaces

 +1        QUIT $$PAD(" ",N)