Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BSDX41I

BSDX41I.m

Go to the documentation of this file. 
  1. BSDX41I ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
  1.  ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
  1.  ;
  1. OUTPT ; ********** OUTPATIENT ENCOUNTERS * 9000010/9000010.07 **********
  1.  ; <SETUP>
  1.  Q:'$D(^AUPNVSIT("AA",APCHSPAT))
  1.  S APCHSOVT="ARSCOTE" ; NOTE: THIS CONTROLS TYPES OF VISITS DISPLAYED
  1.  ;X APCHSCKP Q:$D(APCHSQIT)  X:'APCHSNPG APCHSBRK
  1.  ; <DISPLAY>
  1.  S APCHSPVD=0
  1.  S APCHSPFN=""
  1.  S APCHSDCX="",APCHSDPR=""
  1.  I $D(^APCHSCTL(APCHSTYP,2)),$P(^(2),U,3)="Y" S APCHSDCX=1
  1.  I $D(^APCHSCTL(APCHSTYP,2)),$P(^(2),U,5)=1 S APCHSDPR=1
  1.  I 'APCHSDPR,'APCHSDCX S APCHSDCL=23
  1.  I APCHSDCX,'APCHSDPR S APCHSDCL=32
  1.  I APCHSDCX,APCHSDPR S APCHSDCL=35
  1.  I 'APCHSDCX,APCHSDPR S APCHSDCL=28
  1.  S APCHSICF=$S('$D(APCHSTYP):"L",'$D(^APCHSCTL(APCHSTYP,2)):"L",$P(^APCHSCTL(APCHSTYP,2),U,1)]"":$P(^APCHSCTL(APCHSTYP,2),U,1),1:"L")
  1.  F APCHSIVD=0:0 S APCHSIVD=$O(^AUPNVSIT("AA",APCHSPAT,APCHSIVD)) Q:APCHSIVD=""!(APCHSIVD>APCHSDLM)  D  Q:APCHSNDM=0!(APCHSQT)
  1.  .  S APCHSQT=1
  1.  .  D ONEDATE
  1.  .  Q:$D(APCHSQIT)
  1.  .  S:(APCHSDAT'=APCHSPVD)&APCHSDTU APCHSNDM=APCHSNDM-APCHSDTU,APCHSPVD=APCHSDAT
  1.  .  S APCHSQT=0
  1.  .  Q
  1.  ;
  1. OUTPTX ; <CLEANUP>
  1.  K APCHSIVD,APCHSDTU,APCHSDAT,APCHSVDF,APCHSFAC,APCHSPFN,APCHSSCL,APCHSMTX,APCHSMOD,APCHSPVD,APCHSOVT,APCHSNDT,APCHSCLI,APCHSPDN,APCHSICD,APCHSICL,APCHSNRQ,APCHSDPR,APCHSDCX
  1.  K APCHSNFL,APCHSNSH,APCHSCCL,APCHSNAB,APCHSVSC,APCHSITE,APCHSQT,APCHSDCL,Y,APCHCSVD
  1.  Q
  1.  ;
  1. ONEDATE ;
  1.  S APCHSCCL=""
  1.  S (Y,APCHCSVD)=-APCHSIVD\1+9999999 X APCHSCVD S APCHSDAT=Y
  1.  ;S (APCHSPFN,APCHSSCL)="",APCHSDTU=0,APCHSNDT=(APCHSDAT'=APCHSPVD)
  1.  S APCHSDTU=0,APCHSNDT=(APCHSDAT'=APCHSPVD)
  1.  S APCHSVDF="" F APCHSQ=0:0 S APCHSVDF=$O(^AUPNVSIT("AA",APCHSPAT,APCHSIVD,APCHSVDF)) Q:APCHSVDF=""  D  Q:APCHSQT
  1.  .  S APCHSQT=1
  1.  .  S APCHSSCL=""
  1.  .  S APCHSN=^AUPNVSIT(APCHSVDF,0)
  1.  .  I $P(APCHSN,U,7)="E",'$D(^AUPNVPOV("AD",APCHSVDF)) S APCHSQT=0 Q  ;don't display events with no pov
  1.  .  I $P(APCHSN,U,7)="I",'$D(^AUPNVPOV("AD",APCHSVDF)) S APCHSQT=0 Q  ;don't display in hosp visits with no pov
  1.  .  I +$P(APCHSN,U,9),'$P(APCHSN,U,11) D GETCLN,GETPROV,GETSITEV D
  1.  ..  I APCHSOVT[APCHSVSC D DSPVIS
  1.  ..  Q
  1.  .  Q:$D(APCHSQIT)
  1.  .  S APCHSQT=0
  1.  .  Q
  1.  Q
  1.  ;
  1. GETPROV ;
  1.  S APCHSPRV=$$PRIMPROV^APCLV(APCHSVDF,"T")
  1.  Q
  1. GETCLN ;
  1.  S APCHSCLI=$P(APCHSN,U,8) I APCHSCLI="" S APCHSCCL="<none>" Q
  1.  S APCHSCLI=$P(APCHSN,U,8) Q:APCHSCLI=""
  1.  Q:'$D(^DIC(40.7,APCHSCLI))
  1.  I $D(^DIC(40.7,APCHSCLI,9999999)),$P(^(9999999),U,1)]"" S APCHSCLI=$E($P(^DIC(40.7,APCHSCLI,9999999),U,1),1,6),APCHSCCL=APCHSCLI Q
  1.  S APCHSCLI=$E($P(^DIC(40.7,APCHSCLI,0),U,1),1,8)
  1.  S APCHSCCL=APCHSCLI
  1.  Q
  1. DSPVIS ;
  1.  S APCHSDTU=1
  1.  I $O(^AUPNVPOV("AD",APCHSVDF,""))="" D NOPOV Q
  1.  S APCHSPDN="" F APCHSQ=0:0 S APCHSPDN=$O(^AUPNVPOV("AD",APCHSVDF,APCHSPDN)) Q:'APCHSPDN  S APCHSN=^AUPNVPOV(APCHSPDN,0) D HASPOV
  1.  Q
  1.  ;
  1. NOPOV ;
  1.  S (APCHSICD,APCHSNRQ)="<purpose of visit not yet entered>",APCHSMOD=""
  1.  G COMMON
  1.  ;
  1. HASPOV ;
  1.  S APCHSICD=$P(APCHSN,U,1) D GETICDDX^APCHSUTL
  1.  S APCHSNRQ=$P(APCHSN,U,4) D GETNARR^APCHSUTL I $P(APCHSN,U,5)]"" S APCHSNRQ=APCHSNRQ_"  (Stage: "_$P(APCHSN,U,5)_")"  ;IHS/CMI/LAB - patched to display stage of 0
  1.  S APCHSMOD=$P(APCHSN,U,6)
  1. COMMON ;
  1.  ;X APCHSCKP Q:$D(APCHSQIT)  S:APCHSNPG APCHSNDT=1
  1.  I APCHSNDT S BSDXTMP=APCHSDAT S (APCHSPFN,APCHSSCL)="",APCHSNDT=0
  1.  I APCHSNSH=APCHSPFN S APCHSFAC=""
  1.  E  S (APCHSFAC,APCHSPFN)=APCHSNSH,APCHSSCL=""
  1.  I APCHSCCL=APCHSSCL S APCHSCLI=""
  1.  E  S (APCHSCLI,APCHSSCL)=APCHSCCL
  1.  I APCHSICD["<purpose of visit not"&(APCHSSCL="<none>") S APCHSCLI=""
  1.  I APCHSMOD]"" S APCHSMTX=$P(^DD(9000010.07,.06,0),U,3),APCHSMTX=$P($P(APCHSMTX,APCHSMOD_":",2),";",1),APCHSMTX=$P(APCHSMTX,",",1),APCHSICD=APCHSMTX_" "_APCHSICD
  1.  S:$D(^AUPNVCHS("AD",APCHSVDF)) APCHSNTE="*** CHS ***"
  1.  ;S APCHSICL=$S(APCHSCLI'=" ":35,1:23)
  1.  S BSDXTMP=BSDXTMP_$$FILL^BSDX41(10-$L(BSDXTMP))_APCHSFAC
  1.  I APCHSDCX,APCHSDPR S BSDXTMP=BSDXTMP_$$FILL^BSDX41(23-$L(BSDXTMP))_$E(APCHSCLI,1,6) S BSDXTMP=BSDXTMP_$$FILL^BSDX41(30-$L(BSDXTMP))_APCHSPRV
  1.  I APCHSDCX,'APCHSDPR S BSDXTMP=BSDXTMP_$$FILL^BSDX41(23-$L(BSDXTMP))_APCHSCLI
  1.  I 'APCHSDCX,APCHSDPR S BSDXTMP=BSDXTMP_$$FILL^BSDX41(23-$L(BSDXTMP))_APCHSPRV
  1.  S APCHSICL=APCHSDCL
  1.  S:0 APCHSICD=APCHSVSC_":"_APCHSICD D PRTICD^BSDX41F
  1.  Q
  1. INHOSP ; ********** INHOSPITAL ENCOUNTERS * 9000010/9000010.07 **********
  1.  ; <SETUP>
  1.  Q:'$D(^AUPNVSIT("AA",APCHSPAT))
  1.  S APCHSOVT="I" ; NOTE: This controls types of visits displayed
  1.  ;X APCHSCKP Q:$D(APCHSQIT)  X:'APCHSNPG APCHSBRK
  1.  ; <DISPLAY>
  1.  S APCHSDCX="",APCHSDPR=""
  1.  I $D(^APCHSCTL(APCHSTYP,2)),$P(^(2),U,3)="Y" S APCHSDCX=1
  1.  I $D(^APCHSCTL(APCHSTYP,2)),$P(^(2),U,5)=1 S APCHSDPR=1
  1.  I 'APCHSDPR,'APCHSDCX S APCHSDCL=23
  1.  I APCHSDCX,'APCHSDPR S APCHSDCL=32
  1.  I APCHSDCX,APCHSDPR S APCHSDCL=35
  1.  I 'APCHSDCX,APCHSDPR S APCHSDCL=28
  1.  S APCHSPVD=0
  1.  F APCHSIVD=0:0 S APCHSIVD=$O(^AUPNVSIT("AA",APCHSPAT,APCHSIVD)) Q:APCHSIVD=""!(APCHSIVD>APCHSDLM)  D ONEDATE Q:$D(APCHSQIT)  S:(APCHSDAT'=APCHSPVD)&APCHSDTU APCHSNDM=APCHSNDM-APCHSDTU,APCHSPVD=APCHSDAT Q:APCHSNDM=0
  1.  ; <CLEANUP>
  1. INHOSPX K APCHSIVD,APCHSDTU,APCHSDAT,APCHSVDF,APCHSFAC,APCHSPFN,APCHSSCL,APCHSMTX,APCHSMOD,APCHSPVD,APCHSOVT,APCHSNDT,APCHSCLI,APCHSPDN,APCHSICD,APCHSICL,APCHSNRQ
  1.  K APCHSNFL,APCHSNSH,APCHSNAB,APCHSVSC,APCHSITE,Y
  1.  Q
  1.  ;
  1. GETSITEV ;ENTRY POINT
  1.  S APCHSP=^AUPNVSIT(APCHSVDF,0),APCHSVSC=$P(APCHSP,U,7),APCHSITE=$P(APCHSP,U,6)
  1. GETSITE ;ENTRY POINT
  1.  S:APCHSITE="" APCHSITE="null"
  1.  S APCHSP=$G(^AUTTLOC(APCHSITE,0))
  1.  S:'$D(APCHSVDF) APCHSVDF=-1
  1.  ;S APCHSNFL=$P(APCHSP,U,1),APCHSNFL=$S($D(^DIC(4,APCHSNFL,0)):$P(^(0),U,1),$D(^AUPNVSIT(APCHSVDF,21))#2:$P(^(21),U),1:"<"_APCHSITE_">") ;IHS/CMI/LAB - commented out and replaced with line below
  1.  S APCHSNFL=$P(APCHSP,U,1) S:APCHSNFL="" APCHSNFL="null" S APCHSNFL=$S($D(^DIC(4,APCHSNFL,0)):$P(^DIC(4,APCHSNFL,0),U,1),$P($G(^AUPNVSIT(APCHSVDF,21)),U)]"":$P(^AUPNVSIT(APCHSVDF,21),U),1:"<"_APCHSITE_">") ;IHS/CMI/LAB - fixed this line
  1.  ;S APCHSNSH=$P(APCHSP,U,2) S:$D(^AUPNVSIT(APCHSVDF,21))#2 APCHSNSH=$E($P(^(21),U),1,12) I APCHSNSH="" S APCHSNSH="<"_APCHSITE_">" ;IHS/CMI/LAB - commented out
  1.  S APCHSNSH=$P(APCHSP,U,2) S:$P($G(^AUPNVSIT(APCHSVDF,21)),U)]"" APCHSNSH=$E($P(^AUPNVSIT(APCHSVDF,21),U),1,12) I APCHSNSH="" S APCHSNSH="<"_APCHSITE_">" ;IHS/CMI/LAB - fixed this line to replace the one above
  1.  K:APCHSVDF=-1 APCHSVDF
  1.  S APCHSNAB=$J($P(APCHSP,U,7),4) I APCHSNAB="" S APCHSNAB="<"_APCHSITE_">"
  1.  Q
  1.  ;
  1. INPT ; ********** HOSPITALIZATION ENCOUNTERS * 9000010/900010.07 **********
  1.  ; <SETUP>
  1.  Q:'$D(^AUPNVSIT("AAH",APCHSPAT))
  1.  ;X APCHSCKP Q:$D(APCHSQIT)  X:'APCHSNPG APCHSBRK
  1.  ; <DISPLAY>
  1.  S APCHSPVD=0
  1.  S APCHSIVD="" F APCHSQ=0:0 S APCHSIVD=$O(^AUPNVSIT("AAH",APCHSPAT,APCHSIVD)) Q:APCHSIVD=""!(APCHSIVD>APCHSDLM)  D IONEDATE Q:$D(APCHSQIT)  S:APCHSDAT'=APCHSPVD APCHSNDM=APCHSNDM-1,APCHSPVD=APCHSDAT Q:APCHSNDM=0
  1.  ; <CLEANUP>
  1. INPTX K APCHSIVD,APCHSDTU,APCHSDAT,APCHSVDF,APCHSFAC,APCHSFO,APCHSMTX,APCHSMOD,APCHSPVD,APCHSHDN,APCHSDDC,APCHSCDN,APCHSICD,APCHSICL,APCHSN,APCHSNRQ,APCHSPDN,APCHSVTP
  1.  K APCHSNFL,APCHSNSH,APCHSNAB,APCHSVSC,APCHSITE,Y,APCHSIVD,APCHCSVD
  1.  Q
  1. IONEDATE S (Y,APCHCSVD)=-APCHSIVD\1+9999999 X APCHSCVD S APCHSDAT=Y S APCHSDTU=(APCHSDAT=APCHSPVD)
  1.  S APCHSVDF="" F APCHSQ=0:0 S APCHSVDF=$O(^AUPNVSIT("AAH",APCHSPAT,APCHSIVD,APCHSVDF)) Q:APCHSVDF=""  S APCHSN=^AUPNVSIT(APCHSVDF,0) D GETSITEV D:"H"[APCHSVSC HOSP Q:$D(APCHSQIT)
  1.  Q
  1.  ;
  1. HOSP ;
  1.  Q:$P(APCHSN,U,9)=0!($P(APCHSN,U,11)=1)
  1.  S APCHSVTP=$P(APCHSN,U,3)
  1.  S APCHSDTU=1
  1.  S APCHSFAC=APCHSNSH
  1.  S APCHSDDC="?"
  1.  I APCHSVTP'="C" S APCHSHDN=$O(^AUPNVINP("AD",APCHSVDF,0)) I APCHSHDN S Y=+^AUPNVINP(APCHSHDN,0) X APCHSCVD S APCHSDDC=Y
  1.  I APCHSVTP="C" S APCHSCDN=$O(^AUPNVCHS("AD",APCHSVDF,0)) I APCHSCDN S Y=$P(^AUPNVCHS(APCHSCDN,0),U,7) X APCHSCVD S APCHSDDC=Y
  1.  X APCHSCKP Q:$D(APCHSQIT)
  1.  D IHDR
  1.  S APCHSPDN="" F APCHSQ=0:0 S APCHSPDN=$O(^AUPNVPOV("AD",APCHSVDF,APCHSPDN)) Q:'APCHSPDN  S APCHSN=^AUPNVPOV(APCHSPDN,0) D DSPPOV
  1.  I $X S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$$FILL^BSDX41(32)_"<no visit data>"_$C(30)
  1.  Q
  1.  ;
  1. DSPPOV S APCHSICD=$P(APCHSN,U,1) D GETICDDX^APCHSUTL
  1.  S APCHSNRQ=$P(APCHSN,U,4)
  1.  D GETNARR^APCHSUTL
  1.  S APCHSMOD=$P(APCHSN,U,6)
  1.  I APCHSMOD]"" S APCHSMTX=$P(^DD(9000010.07,.06,0),U,3),APCHSMTX=$P($P(APCHSMTX,APCHSMOD_":",2),";",1),APCHSMTX=$P(APCHSMTX,",",1),APCHSICD=APCHSMTX_" "_APCHSICD
  1.  S:$D(^AUPNVCHS("AD",APCHSVDF)) APCHSNTE="*** CHS ***"
  1.  ;X APCHSCKP Q:$D(APCHSQIT)
  1.  D:APCHSNPG IHDR S APCHSICL=33 S:0 APCHSICD=APCHSVSC_":"_APCHSICD D PRTICD^BSDX41F
  1.  Q
  1.  ;
  1. IHDR S BSDXTMP=APCHSDAT_"-"_APCHSDDC
  1.  S BSDXTMP=BSDXTMP_$$FILL^BSDX41(18-$L(BSDXTMP))_APCHSFAC
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  S BSDXTMP=""
  1.  Q
  1.  ;
  1. SCHENC ; ********** SCHEDULED ENCOUNTERS * 2/44 **********  (APCHS2D)
  1.  ; <SETUP>
  1.  Q:'$D(^DPT(APCHSPAT,"S"))
  1.  ;X APCHSCKP Q:$D(APCHSQIT)  X:'APCHSNPG APCHSBRK
  1.  ; <DISPLAY>
  1.  S APCHSI=$O(^DPT(APCHSPAT,"S",0)) I APCHSI,APCHSI<DT D PAST
  1.  D:$O(^DPT(APCHSPAT,"S",DT)) PEND
  1.  ; <CLEANUP>
  1. SCHENCX K APCHSVDT,APCHSVD1,APCHSIVD,APCHSDAT,APCHSPVD,APCHSN,APCHSVT,APCHSCN,APCHSCP,APCHSTST,APCHSI,APCHSJ,APCHSET,APCHSHP,APCHSVN,APCHSVNT,Y
  1.  Q
  1.  ;
  1. PAST ;
  1.  K ^TMP($J,"APCHS")
  1.  S APCHSVD1=9999999-APCHSDLM,APCHSDAT=0,APCHSI=0
  1.  S APCHSVDT=APCHSVD1 F APCHSQ=0:0 S APCHSVDT=$O(^DPT(APCHSPAT,"S",APCHSVDT)) Q:'APCHSVDT!(APCHSVDT>DT)  D ADDONE
  1.  Q:'$O(^TMP($J,"APCHS",""))
  1.  S APCHSET="PAST:"
  1.  ;X APCHSCKP Q:$D(APCHSQIT)
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=APCHSET_$C(30)
  1.  S APCHSIVD=0 F APCHSQ=0:0 S APCHSIVD=$O(^TMP($J,"APCHS",APCHSIVD)) Q:'APCHSIVD  S APCHSVDT=^(APCHSIVD) D ONEVIS Q:$D(APCHSQIT)
  1.  K ^TMP($J,"APCHS")
  1.  Q
  1.  ;
  1. ADDONE S APCHSIVD=9999999.9999-APCHSVDT
  1.  S APCHSI=APCHSI+1,^TMP($J,"APCHS",APCHSIVD)=APCHSVDT,^TMP($J,"APCHS","B",APCHSVDT)=""
  1.  I APCHSNDM>0,APCHSI>APCHSNDM S APCHSI=APCHSI-1,APCHSJ=$O(^TMP($J,"APCHS","B","")) K ^(APCHSJ) K ^TMP($J,"APCHS",9999999.9999-APCHSJ)
  1.  Q
  1. PEND ;
  1.  S APCHSET="PENDING:"
  1.  ;X APCHSCKP Q:$D(APCHSQIT)
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=APCHSET_$C(30)
  1.  S APCHSDAT=0,APCHSVDT=DT-.01 F APCHSQ=0:0 S APCHSVDT=$O(^DPT(APCHSPAT,"S",APCHSVDT)) Q:'APCHSVDT  D ONEVIS Q:$D(APCHSQIT)
  1.  Q
  1.  ;
  1. ONEVIS S APCHSN=^DPT(APCHSPAT,"S",APCHSVDT,0)
  1.  Q:"CP"[$E($P(APCHSN,U,2)_" ")
  1.  S APCHSAM="am"
  1.  ;Q:$P(APCHSN,U,7)=4  ;skip unscheduled
  1.  I APCHSVDT\1'=APCHSDAT S Y=APCHSVDT\1 X APCHSCVD S (APCHSPVD,APCHSDAT)=Y,APCHSNDM=APCHSNDM-1
  1.  S APCHSVT=$E($P(APCHSVDT,".",2)_"000",1,4) S:APCHSVT>1159 APCHSAM="pm" S:APCHSVT>1300 APCHSVT=APCHSVT-1200 S:$L(APCHSVT)=3 APCHSVT=" "_APCHSVT S:$E(APCHSVT)="0" APCHSVT=" "_$E(APCHSVT,2,4) S APCHSVT=$E(APCHSVT,1,2)_":"_$E(APCHSVT,3,4)
  1.  S APCHSTST="" F APCHSI=3,4,5 S APCHSJ=$P(APCHSN,U,APCHSI) I APCHSJ S:APCHSTST]"" APCHSTST=APCHSTST_"," S APCHSTST=APCHSTST_$P("^^LAB^XRAY^EKG^",U,APCHSI)
  1.  S APCHSCP=+APCHSN,APCHSCN=$P($G(^SC(APCHSCP,0)),U,1) Q:APCHSCN=""
  1.  S APCHSTST="",APCHSVNT=""
  1.  S APCHSVN=0 F APCHSQ=0:0 S APCHSVN=$O(^SC(APCHSCP,"S",APCHSVDT,1,APCHSVN)) Q:'APCHSVN  I +^(APCHSVN,0)=APCHSPAT S APCHSTST=$P(^(0),U,2),APCHSVNT=$P(^(0),U,4) S:APCHSTST APCHSTST=APCHSTST_" min."
  1.  F APCHSI=3,4,5 S APCHSJ=$P(APCHSN,U,APCHSI) I APCHSJ S:APCHSTST]"" APCHSTST=APCHSTST_"," S APCHSTST=APCHSTST_$P("^^LAB^XRAY^EKG^",U,APCHSI)
  1.  D L1
  1.  I APCHSVNT]"" D
  1.  .;X APCHSCKP Q:$D(APCHSQIT)
  1.  .D:APCHSNPG L1 S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$$FILL^BSDX41(19)_APCHSVNT_$C(30)
  1.  Q
  1. L1 ;X APCHSCKP Q:$D(APCHSQIT)
  1.  I APCHSNPG S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=APCHSET_$C(30) S APCHSDAT=APCHSPVD
  1.  S BSDXTMP=" "_APCHSDAT
  1.  S BSDXTMP=BSDXTMP_$$FILL^BSDX41(11-$L(BSDXTMP))_APCHSVT_APCHSAM
  1.  S BSDXTMP=BSDXTMP_$$FILL^BSDX41(20-$L(BSDXTMP))_APCHSCN
  1.  I APCHSTST]"" S BSDXTMP=BSDXTMP_" ("_APCHSTST_")"
  1.  I $P(APCHSN,U,2)["N" S BSDXTMP=BSDXTMP_$$FILL^BSDX41(37-$L(BSDXTMP))_"*** DNKA ***"
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  Q