- 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)
