BDGIPL5 ; IHS/ANMC/LJF - CURR INPTS BY SRV & PROV ;
;;5.3;PIMS;**1007**;FEB 27, 2007
;
;
;cmi/anch/maw 2/22/2007 added code in PRINT to not close device if multiple copies PATCH 1007 item 1007.39
;
I $E(IOST,1,2)="P-" D INIT,PRINT Q
;
EN ; -- main entry point for BDG IPL BY PROVIDER
; assumes BDGSRT and BDGSRT1 are set
NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BDG IPL BY PROVIDER")
D CLEAR^VALM1
Q
;
HDR ; -- header code
NEW X
S VALMHDR(1)=$$SP(12)_"** "_$$CONF^BDGF_" **"
S X=$S(BDGSRT="A":"For ALL Treating Specialties",1:$P(BDGSRT,U,2))
S X=X_" / "_$S(BDGSRT1="A":"For ALL Providers",1:$P(BDGSRT1,U,2))
S VALMHDR(2)=$$SP(79-$L(X)\2)_X
I $G(BDGSRT2) D
. S X=$S(BDGSRT2=1:"Inpatients Only",BDGSRT2=2:"Observations Only",1:"")
. I X]"" S VALMHDR(3)=$$SP(75-$L(X)\2)_X
Q
;
INIT ; -- init variables and list array
NEW BDGSRV,BDGSVN,BDGCNT,SRV,PROV,LINE,DFN,X
K ^TMP("BDGIPL",$J),^TMP("BDGIPL1",$J)
S VALMCNT=0,BDGCNT=1
;11/1/O2 WAR - following change per P37 LJF30
;IHS/ANMC/LJF 10/31/2002 add ability to print >1 service
;S BDGSRV=$S(BDGSRT="A":0,1:+BDGSRT)
;I BDGSRV S BDGSVN=$P(BDGSRT,U,2) D PATLOOP,TRANSFER I 1 ;one service
;
; if user asked for all services
;E F S BDGSRV=$O(^DPT("ATR",BDGSRV)) Q:'BDGSRV D
I '$D(BDGSRT2) S BDGSRT2=""
S BDGSRV=0 F S BDGSRV=$O(^DPT("ATR",BDGSRV)) Q:'BDGSRV D
. I BDGSRT=0,'$D(BDGSRT(BDGSRV)) Q ;not in list of selected services
. ;IHS/ANMC/LJF 10/31/2002 end of mods
. S BDGSVN=$$GET1^DIQ(45.7,BDGSRV,.01) ;service name
. I BDGSRT2=1,BDGSVN["OBSERVATION" Q ;inpt only
. I BDGSRT2=2,BDGSVN'["OBSERVATION" Q ;observation only
. D PATLOOP,TRANSFER
;
; pull sorted list and create display array
S SRV=0 F S SRV=$O(^TMP("BDGIPL1",$J,SRV)) Q:SRV="" D
. ;
. ; set up service name subheading
. I SRV'["**" D SET($G(IORVON)_SRV_$G(IORVOFF),.VALMCNT,BDGCNT,"")
. ;
. S PROV=0 F S PROV=$O(^TMP("BDGIPL1",$J,SRV,PROV)) Q:PROV="" D
.. ;
.. ; if SRV contains "**" means list of transfers out of service
.. I SRV["**" D
... S X="Admitted to "_$P(SRV,"**")_" ("_PROV_")"_" then tranferred:"
... D SET(X,.VALMCNT,BDGCNT,"")
.. ;
.. ; set up provider subheading
.. E D
... S X=$$SP(3)_$G(IORVON)_PROV_$G(IORVOFF)
... D SET(X,.VALMCNT,BDGCNT,"")
.. ;
.. S DFN=0 F S DFN=$O(^TMP("BDGIPL1",$J,SRV,PROV,DFN)) Q:'DFN D
... ;
... S LINE=$S($E(IOST,1,2)="P-":$$SP(5),1:$J(BDGCNT,3)_") ")
... S LINE=LINE_$E($$GET1^DIQ(2,DFN,.01),1,20) ;patient
... S LINE=$$PAD(LINE,27)_$J($$HRCN^BDGF2(DFN,DUZ(2)),6) ;chart#
... S LINE=$$PAD(LINE,36)_$$GET1^DIQ(9000001,DFN,1102.98) ;age
... S LINE=$$PAD(LINE,44)_$$GET1^DIQ(2,DFN,.02,"I") ;sex
... S LINE=$$PAD(LINE,47)_$E($$GET1^DIQ(9000001,DFN,1118),1,15) ;comm
... S LINE=$$PAD(LINE,64)_$E($$CURDX^BDGF1(DFN),1,16) ;adm dx
... D SET(LINE,.VALMCNT,BDGCNT,DFN)
... ;
... S LINE=$$SP(10)_"Admitted: "
... S LINE=LINE_$P($$INPT1^BDGF1(DFN,DT),":",1,2) ;admit dt
... S LINE=LINE_" ("_$$CURLOS^BDGF1(DFN,1)_")" ;los
... S LINE=$$PAD(LINE,50)_$$WRDABRV^BDGF1(DFN)_" Ward" ;ward
... S X=$G(^DPT(DFN,.101)) I X]"" S LINE=LINE_" ("_X_")" ;room-bed
... D SET(LINE,.VALMCNT,BDGCNT,DFN)
... ;
... ; if transferred, display date and new service
... S X=^TMP("BDGIPL1",$J,SRV,PROV,DFN) I X]"" D
.... S LINE=$$SP(12)_"To "_$$GET1^DIQ(2,DFN,.103)
.... S LINE=LINE_" ("_$$CURPRV^BDGF1(DFN,32)_")"
.... S LINE=LINE_" on "_$P(X,":",1,2)
.... D SET(LINE,.VALMCNT,BDGCNT,DFN)
... ;
... D SET("",.VALMCNT,BDGCNT,DFN) ;blank line between patients
... ; increment counter
... S BDGCNT=BDGCNT+1
.. ;
.. ; skip line between services
.. I $O(^TMP("BDGIPL1",$J,SRV,PROV))="" D SET("",.VALMCNT,BDGCNT,"")
;
K ^TMP("BDGIPL1",$J)
Q
;
PATLOOP ; loop by dfn then sort results by provider
NEW DFN,X
Q:BDGSVN="" ;in case of incomplete admissions in file
S DFN=0 F S DFN=$O(^DPT("ATR",BDGSRV,DFN)) Q:'DFN D
. S X=$$CURPRV^BDGF1(DFN) I X="" S X="??"
. I BDGSRT1,(X'=$P(BDGSRT1,U,2)) Q ;not provider selected
. S ^TMP("BDGIPL1",$J,BDGSVN,X,DFN)=""
Q
;
TRANSFER ; returns new service and date if transferred from admtg service
NEW CA,SRV,DATE,X,DFN
S WARD=0 F S WARD=$O(^DPT("CN",WARD)) Q:WARD="" D
. S DFN=0 F S DFN=$O(^DPT("CN",WARD,DFN)) Q:'DFN D
.. S CA=$G(^DPT(DFN,.105)) ;admission ien
.. S SRV=$$ADMSRV^BDGF1(CA,DFN) S:SRV="" SRV="??" ;admission service
.. ;
.. ; if adm service not equal current service, continue
.. I SRV'=$$GET1^DIQ(2,DFN,.103) D
... ;11/1/O2 WAR - following change per P37 LJF30
... ;IHS/ANMC/LJF 10/31/2002 check array of sevices
... ;I BDGSRT'="A" Q:SRV'=BDGSVN ;not looking for this service
... I BDGSRT'="A" NEW X S X=$O(^DIC(45.7,"B",SRV,0)) Q:'X I '$D(BDGSRT(X)) Q
... ;IHS/ANMC/LJF 10/31/2002 end of mods
... I BDGSRT="A",$G(BDGSRT2)=2 Q:SRV'["OBSERVATION"
... S DATE=$$GET1^DIQ(405,+$$LASTTXN^BDGF1(CA,DFN),.01) ;transf date
... ;
... ; subscript is adm service
... S X=$$ADMPRV^BDGF1(CA,DFN,"PRM") S:X="" X="??" ;primary inpt prv
... S ^TMP("BDGIPL1",$J,SRV_"**",X,DFN)=DATE
Q
;
SET(LINE,NUM,COUNT,IEN) ; put display line into array
D SET^BDGIPL1(LINE,.NUM,COUNT,IEN)
Q
;
PRINT ; print report to paper
NEW BDGX,BDGPG
U IO D INIT^BDGF,HDG
;
S BDGX=0 F S BDGX=$O(^TMP("BDGIPL",$J,BDGX)) Q:'BDGX D
. I $Y>(IOSL-4) D HDG
. W !,^TMP("BDGIPL",$J,BDGX,0)
I '$G(BDGCOP) D ^%ZISC ;cmi/anch/maw 2/22/2007 added for no close of device if multiple copies PATCH 1007 item 1007.39
D PRTKL^BDGF,EXIT
;D ^%ZISC,PRTKL^BDGF,EXIT cmi/anch/maw 2/22/2007 orig line
Q ;cmi/anch/maw 7/11/2007 was appended to previous line PATCH 1007
;
HDG ; heading for paper report
S BDGPG=$G(BDGPG)+1 I BDGPG>1 W @IOF
W !,BDGUSR,?16,$$CONF^BDGF
W !,BDGDATE,?20,"Current Inpatients by Service/Provider"
;11/1/O2 WAR - following change per P37 LJF30
;S X=$S(BDGSRT="A":"For ALL Treating Specialties",1:$P(BDGSRT,U,2)) ;IHS/ANMC/LJF 10/31/2002
S X=$S(BDGSRT="A":"For ALL Treating Specialties",1:$$SERVS) ;IHS/ANMC/LJF 10/31/2002
W ?70,"Page: ",BDGPG
S X=X_$S(BDGSRT1="A":" / For ALL Providers",1:$P(BDGSRT1,U,2))
W !,BDGTIME,?(80-$L(X)\2),X
I $G(BDGSRT2) D
. S X=$S(BDGSRT2=1:"Inpatients",BDGSRT2=2:"Observations",1:"")
. I X]"" S X="("_X_" Only)" W !?(80-$L(X)\2),X
W !,$$REPEAT^XLFSTR("-",80)
W !?5,"Patient Name",?27,"Chart #",?36,"Age",?43,"Sex Community"
W ?64,"Admitting Dx"
W !,$$REPEAT^XLFSTR("=",80)
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("BDGIPL",$J)
;K BDGSRT,BDGSRT1,DGPMIFN cmi/anch/maw 7/25/2007 is needed for multiple copies patch 1007
Q
;
EXPND ; -- expand code
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)
;
;11/1/O2 WAR - following change per P37 LJF30
SERVS() ; returns service name or "selected services";IHS/ANMC/LJF 10/31/2002
NEW X
S X=$O(BDGSRT(0)) I $O(BDGSRT(X)) Q "Selected Services"
Q BDGSRT(X)
BDGIPL5 ; IHS/ANMC/LJF - CURR INPTS BY SRV & PROV ;
+1 ;;5.3;PIMS;**1007**;FEB 27, 2007
+2 ;
+3 ;
+4 ;cmi/anch/maw 2/22/2007 added code in PRINT to not close device if multiple copies PATCH 1007 item 1007.39
+5 ;
+6 IF $EXTRACT(IOST,1,2)="P-"
DO INIT
DO PRINT
QUIT
+7 ;
EN ; -- main entry point for BDG IPL BY PROVIDER
+1 ; assumes BDGSRT and BDGSRT1 are set
+2 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+3 DO EN^VALM("BDG IPL BY PROVIDER")
+4 DO CLEAR^VALM1
+5 QUIT
+6 ;
HDR ; -- header code
+1 NEW X
+2 SET VALMHDR(1)=$$SP(12)_"** "_$$CONF^BDGF_" **"
+3 SET X=$SELECT(BDGSRT="A":"For ALL Treating Specialties",1:$PIECE(BDGSRT,U,2))
+4 SET X=X_" / "_$SELECT(BDGSRT1="A":"For ALL Providers",1:$PIECE(BDGSRT1,U,2))
+5 SET VALMHDR(2)=$$SP(79-$LENGTH(X)\2)_X
+6 IF $GET(BDGSRT2)
Begin DoDot:1
+7 SET X=$SELECT(BDGSRT2=1:"Inpatients Only",BDGSRT2=2:"Observations Only",1:"")
+8 IF X]""
SET VALMHDR(3)=$$SP(75-$LENGTH(X)\2)_X
End DoDot:1
+9 QUIT
+10 ;
INIT ; -- init variables and list array
+1 NEW BDGSRV,BDGSVN,BDGCNT,SRV,PROV,LINE,DFN,X
+2 KILL ^TMP("BDGIPL",$JOB),^TMP("BDGIPL1",$JOB)
+3 SET VALMCNT=0
SET BDGCNT=1
+4 ;11/1/O2 WAR - following change per P37 LJF30
+5 ;IHS/ANMC/LJF 10/31/2002 add ability to print >1 service
+6 ;S BDGSRV=$S(BDGSRT="A":0,1:+BDGSRT)
+7 ;I BDGSRV S BDGSVN=$P(BDGSRT,U,2) D PATLOOP,TRANSFER I 1 ;one service
+8 ;
+9 ; if user asked for all services
+10 ;E F S BDGSRV=$O(^DPT("ATR",BDGSRV)) Q:'BDGSRV D
+11 IF '$DATA(BDGSRT2)
SET BDGSRT2=""
+12 SET BDGSRV=0
FOR
SET BDGSRV=$ORDER(^DPT("ATR",BDGSRV))
IF 'BDGSRV
QUIT
Begin DoDot:1
+13 ;not in list of selected services
IF BDGSRT=0
IF '$DATA(BDGSRT(BDGSRV))
QUIT
+14 ;IHS/ANMC/LJF 10/31/2002 end of mods
+15 ;service name
SET BDGSVN=$$GET1^DIQ(45.7,BDGSRV,.01)
+16 ;inpt only
IF BDGSRT2=1
IF BDGSVN["OBSERVATION"
QUIT
+17 ;observation only
IF BDGSRT2=2
IF BDGSVN'["OBSERVATION"
QUIT
+18 DO PATLOOP
DO TRANSFER
End DoDot:1
+19 ;
+20 ; pull sorted list and create display array
+21 SET SRV=0
FOR
SET SRV=$ORDER(^TMP("BDGIPL1",$JOB,SRV))
IF SRV=""
QUIT
Begin DoDot:1
+22 ;
+23 ; set up service name subheading
+24 IF SRV'["**"
DO SET($GET(IORVON)_SRV_$GET(IORVOFF),.VALMCNT,BDGCNT,"")
+25 ;
+26 SET PROV=0
FOR
SET PROV=$ORDER(^TMP("BDGIPL1",$JOB,SRV,PROV))
IF PROV=""
QUIT
Begin DoDot:2
+27 ;
+28 ; if SRV contains "**" means list of transfers out of service
+29 IF SRV["**"
Begin DoDot:3
+30 SET X="Admitted to "_$PIECE(SRV,"**")_" ("_PROV_")"_" then tranferred:"
+31 DO SET(X,.VALMCNT,BDGCNT,"")
End DoDot:3
+32 ;
+33 ; set up provider subheading
+34 IF '$TEST
Begin DoDot:3
+35 SET X=$$SP(3)_$GET(IORVON)_PROV_$GET(IORVOFF)
+36 DO SET(X,.VALMCNT,BDGCNT,"")
End DoDot:3
+37 ;
+38 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("BDGIPL1",$JOB,SRV,PROV,DFN))
IF 'DFN
QUIT
Begin DoDot:3
+39 ;
+40 SET LINE=$SELECT($EXTRACT(IOST,1,2)="P-":$$SP(5),1:$JUSTIFY(BDGCNT,3)_") ")
+41 ;patient
SET LINE=LINE_$EXTRACT($$GET1^DIQ(2,DFN,.01),1,20)
+42 ;chart#
SET LINE=$$PAD(LINE,27)_$JUSTIFY($$HRCN^BDGF2(DFN,DUZ(2)),6)
+43 ;age
SET LINE=$$PAD(LINE,36)_$$GET1^DIQ(9000001,DFN,1102.98)
+44 ;sex
SET LINE=$$PAD(LINE,44)_$$GET1^DIQ(2,DFN,.02,"I")
+45 ;comm
SET LINE=$$PAD(LINE,47)_$EXTRACT($$GET1^DIQ(9000001,DFN,1118),1,15)
+46 ;adm dx
SET LINE=$$PAD(LINE,64)_$EXTRACT($$CURDX^BDGF1(DFN),1,16)
+47 DO SET(LINE,.VALMCNT,BDGCNT,DFN)
+48 ;
+49 SET LINE=$$SP(10)_"Admitted: "
+50 ;admit dt
SET LINE=LINE_$PIECE($$INPT1^BDGF1(DFN,DT),":",1,2)
+51 ;los
SET LINE=LINE_" ("_$$CURLOS^BDGF1(DFN,1)_")"
+52 ;ward
SET LINE=$$PAD(LINE,50)_$$WRDABRV^BDGF1(DFN)_" Ward"
+53 ;room-bed
SET X=$GET(^DPT(DFN,.101))
IF X]""
SET LINE=LINE_" ("_X_")"
+54 DO SET(LINE,.VALMCNT,BDGCNT,DFN)
+55 ;
+56 ; if transferred, display date and new service
+57 SET X=^TMP("BDGIPL1",$JOB,SRV,PROV,DFN)
IF X]""
Begin DoDot:4
+58 SET LINE=$$SP(12)_"To "_$$GET1^DIQ(2,DFN,.103)
+59 SET LINE=LINE_" ("_$$CURPRV^BDGF1(DFN,32)_")"
+60 SET LINE=LINE_" on "_$PIECE(X,":",1,2)
+61 DO SET(LINE,.VALMCNT,BDGCNT,DFN)
End DoDot:4
+62 ;
+63 ;blank line between patients
DO SET("",.VALMCNT,BDGCNT,DFN)
+64 ; increment counter
+65 SET BDGCNT=BDGCNT+1
End DoDot:3
+66 ;
+67 ; skip line between services
+68 IF $ORDER(^TMP("BDGIPL1",$JOB,SRV,PROV))=""
DO SET("",.VALMCNT,BDGCNT,"")
End DoDot:2
End DoDot:1
+69 ;
+70 KILL ^TMP("BDGIPL1",$JOB)
+71 QUIT
+72 ;
PATLOOP ; loop by dfn then sort results by provider
+1 NEW DFN,X
+2 ;in case of incomplete admissions in file
IF BDGSVN=""
QUIT
+3 SET DFN=0
FOR
SET DFN=$ORDER(^DPT("ATR",BDGSRV,DFN))
IF 'DFN
QUIT
Begin DoDot:1
+4 SET X=$$CURPRV^BDGF1(DFN)
IF X=""
SET X="??"
+5 ;not provider selected
IF BDGSRT1
IF (X'=$PIECE(BDGSRT1,U,2))
QUIT
+6 SET ^TMP("BDGIPL1",$JOB,BDGSVN,X,DFN)=""
End DoDot:1
+7 QUIT
+8 ;
TRANSFER ; returns new service and date if transferred from admtg service
+1 NEW CA,SRV,DATE,X,DFN
+2 SET WARD=0
FOR
SET WARD=$ORDER(^DPT("CN",WARD))
IF WARD=""
QUIT
Begin DoDot:1
+3 SET DFN=0
FOR
SET DFN=$ORDER(^DPT("CN",WARD,DFN))
IF 'DFN
QUIT
Begin DoDot:2
+4 ;admission ien
SET CA=$GET(^DPT(DFN,.105))
+5 ;admission service
SET SRV=$$ADMSRV^BDGF1(CA,DFN)
IF SRV=""
SET SRV="??"
+6 ;
+7 ; if adm service not equal current service, continue
+8 IF SRV'=$$GET1^DIQ(2,DFN,.103)
Begin DoDot:3
+9 ;11/1/O2 WAR - following change per P37 LJF30
+10 ;IHS/ANMC/LJF 10/31/2002 check array of sevices
+11 ;I BDGSRT'="A" Q:SRV'=BDGSVN ;not looking for this service
+12 IF BDGSRT'="A"
NEW X
SET X=$ORDER(^DIC(45.7,"B",SRV,0))
IF 'X
QUIT
IF '$DATA(BDGSRT(X))
QUIT
+13 ;IHS/ANMC/LJF 10/31/2002 end of mods
+14 IF BDGSRT="A"
IF $GET(BDGSRT2)=2
IF SRV'["OBSERVATION"
QUIT
+15 ;transf date
SET DATE=$$GET1^DIQ(405,+$$LASTTXN^BDGF1(CA,DFN),.01)
+16 ;
+17 ; subscript is adm service
+18 ;primary inpt prv
SET X=$$ADMPRV^BDGF1(CA,DFN,"PRM")
IF X=""
SET X="??"
+19 SET ^TMP("BDGIPL1",$JOB,SRV_"**",X,DFN)=DATE
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
SET(LINE,NUM,COUNT,IEN) ; put display line into array
+1 DO SET^BDGIPL1(LINE,.NUM,COUNT,IEN)
+2 QUIT
+3 ;
PRINT ; print report to paper
+1 NEW BDGX,BDGPG
+2 USE IO
DO INIT^BDGF
DO HDG
+3 ;
+4 SET BDGX=0
FOR
SET BDGX=$ORDER(^TMP("BDGIPL",$JOB,BDGX))
IF 'BDGX
QUIT
Begin DoDot:1
+5 IF $Y>(IOSL-4)
DO HDG
+6 WRITE !,^TMP("BDGIPL",$JOB,BDGX,0)
End DoDot:1
+7 ;cmi/anch/maw 2/22/2007 added for no close of device if multiple copies PATCH 1007 item 1007.39
IF '$GET(BDGCOP)
DO ^%ZISC
+8 DO PRTKL^BDGF
DO EXIT
+9 ;D ^%ZISC,PRTKL^BDGF,EXIT cmi/anch/maw 2/22/2007 orig line
+10 ;cmi/anch/maw 7/11/2007 was appended to previous line PATCH 1007
QUIT
+11 ;
HDG ; heading for paper report
+1 SET BDGPG=$GET(BDGPG)+1
IF BDGPG>1
WRITE @IOF
+2 WRITE !,BDGUSR,?16,$$CONF^BDGF
+3 WRITE !,BDGDATE,?20,"Current Inpatients by Service/Provider"
+4 ;11/1/O2 WAR - following change per P37 LJF30
+5 ;S X=$S(BDGSRT="A":"For ALL Treating Specialties",1:$P(BDGSRT,U,2)) ;IHS/ANMC/LJF 10/31/2002
+6 ;IHS/ANMC/LJF 10/31/2002
SET X=$SELECT(BDGSRT="A":"For ALL Treating Specialties",1:$$SERVS)
+7 WRITE ?70,"Page: ",BDGPG
+8 SET X=X_$SELECT(BDGSRT1="A":" / For ALL Providers",1:$PIECE(BDGSRT1,U,2))
+9 WRITE !,BDGTIME,?(80-$LENGTH(X)\2),X
+10 IF $GET(BDGSRT2)
Begin DoDot:1
+11 SET X=$SELECT(BDGSRT2=1:"Inpatients",BDGSRT2=2:"Observations",1:"")
+12 IF X]""
SET X="("_X_" Only)"
WRITE !?(80-$LENGTH(X)\2),X
End DoDot:1
+13 WRITE !,$$REPEAT^XLFSTR("-",80)
+14 WRITE !?5,"Patient Name",?27,"Chart #",?36,"Age",?43,"Sex Community"
+15 WRITE ?64,"Admitting Dx"
+16 WRITE !,$$REPEAT^XLFSTR("=",80)
+17 QUIT
+18 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("BDGIPL",$JOB)
+2 ;K BDGSRT,BDGSRT1,DGPMIFN cmi/anch/maw 7/25/2007 is needed for multiple copies patch 1007
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
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)
+2 ;
+3 ;11/1/O2 WAR - following change per P37 LJF30
SERVS() ; returns service name or "selected services";IHS/ANMC/LJF 10/31/2002
+1 NEW X
+2 SET X=$ORDER(BDGSRT(0))
IF $ORDER(BDGSRT(X))
QUIT "Selected Services"
+3 QUIT BDGSRT(X)
