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

BSDX41E.m

Go to the documentation of this file. 
  1. BSDX41E ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
  1.  ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
  1.  ;
  1. OFFHX ; ********** OFFSPRING HISTORY * 9000012 **********
  1.  ; <SETUP>
  1.  Q:$P(^DPT(APCHSPAT,0),U,2)'="F"
  1.  Q:'$D(^AUPNOFFH("AA",APCHSPAT))
  1.  X APCHSCKP Q:$D(APCHSQIT)  X:'APCHSNPG APCHSBRK
  1.  X APCHSCKP Q:$D(APCHSQIT)  D OFFHDR
  1.  ; <DISPLAY>
  1.  S APCHSDAT=0 F APCHSQ=0:0 S APCHSDAT=$O(^AUPNOFFH("AA",APCHSPAT,APCHSDAT)) Q:'APCHSDAT  S APCHSDFN=0 F APCHSQ=0:0 S APCHSDFN=$O(^AUPNOFFH("AA",APCHSPAT,APCHSDAT,APCHSDFN)) Q:'APCHSDFN  D OFFDSP Q:$D(APCHSQIT)
  1. OFFHXX K APCHSDAT,APCHSDFN,APCHSN,APCHSP,X,Y
  1.  Q
  1. OFFDSP ;
  1.  S APCHSN=^AUPNOFFH(APCHSDFN,0)
  1.  X APCHSCKP Q:$D(APCHSQIT)  D:APCHSNPG OFFHDR
  1.  S Y=APCHSDAT X APCHSCVD
  1.  S BSDXDSP=Y_$$FILL^BSDX41(10-$L(Y))_$P(APCHSN,U,4)
  1.  S BSDXDSP=BSDXDSP_$$FILL^BSDX41(20-$L(BSDXDSP))_$P(APCHSN,U,5)
  1.  S BSDXDSP=BSDXDSP_$$FILL^BSDX41(24-$L(BSDXDSP))_$J(+$P(APCHSN,U,6),5,2)
  1.  S BSDXDSP=BSDXDSP_$$FILL^BSDX41(31-$L(BSDXDSP))_$P(APCHSN,U,7)
  1.  I $P(APCHSN,U,8) S BSDXDSP=BSDXDSP_$$FILL^BSDX41(35-$L(BSDXDSP))_$P(APCHSN,U,8)_"/"_$S($P(APCHSN,U,9):$P(APCHSN,U,9),1:"-")
  1.  I $P(APCHSN,U,11) S Y=$P(APCHSN,U,11) X APCHSCVD S Y="("_Y_$S($P(APCHSN,U,12)]"":": "_$P(APCHSN,U,12),1:"")_")" S BSDXDSP=BSDXDSP_$$FILL^BSDX41(42-$L(BSDXDSP))_$E(Y,1,36)
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXDSP_$C(30)
  1. PNC I $O(^AUPNOFFH(APCHSDFN,21,0)) D
  1.  . S BSDXDSP="         "_"PERINATAL COMPLICATION: "
  1.  . S APCHSP=0
  1.  . F  S APCHSP=$O(^AUPNOFFH(APCHSDFN,21,APCHSP)) Q:'APCHSP  S Y=^(APCHSP,0) D OUTC Q:$D(APCHSQIT)
  1.  . S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXDSP_$C(30)
  1.  Q:$D(APCHSQIT)
  1. NNC I $O(^AUPNOFFH(APCHSDFN,31,0)) D
  1.  . S BSDXDSP="         "_"NEONATAL COMPLICATION: "
  1.  . S APCHSP=0
  1.  . F  S APCHSP=$O(^AUPNOFFH(APCHSDFN,31,APCHSP)) Q:'APCHSP  S Y=^(APCHSP,0) D OUTC Q:$D(APCHSQIT)
  1.  . S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXDSP_$C(30)
  1.  Q
  1. OFFHDR S BSDXDSP="DOB"
  1.  S BSDXDSP=BSDXDSP_$$FILL^BSDX41(10_$L(BSDXDSP))_"NAME"
  1.  S BSDXDSP=BSDXDSP_$$FILL^BSDX41(20-$L(BSDXDSP))_"SEX"
  1.  S BSDXDSP=BSDXDSP_$$FILL^BSDX41(25-$L(BSDXDSP))_"BWT"
  1.  S BSDXDSP=BSDXDSP_$$FILL^BSDX41(31-$L(BSDXDSP))_"EGA"
  1.  S BSDXDSP=BSDXDSP_$$FILL^BSDX41(35-$L(BSDXDSP))_"APGAR"
  1.  S BSDXDSP=BSDXDSP_$$FILL^BSDX41(42-$L(BSDXDSP))_"DEATH"
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXDSP_$C(30)
  1.  Q
  1. OUTC X APCHSCKP Q:$D(APCHSQIT)  D:APCHSNPG OFFHDR
  1.  S BSDXDSP=BSDXDSP_$$FILL^BSDX41(34-$L(BSDXDSP))_Y_$C(10,13)
  1.  Q
  1.  ;
  1. REPHX ; ********** REPRODUCTIVE HISTORY * 9000017 **********
  1.  ; <SETUP>
  1.  Q:$P(^DPT(APCHSPAT,0),U,2)'="F"
  1.  Q:'$D(^AUPNREP(APCHSPAT))
  1.  S APCHSN=^AUPNREP(APCHSPAT,0)
  1.  I $D(^DD(9000017,2101)) D NEWREP G REPHXX
  1.  ; <DISPLAY>
  1.  X APCHSCKP Q:$D(APCHSQIT)  X:'APCHSNPG APCHSBRK
  1.  S X=$P(APCHSN,U,2) I X]"" S BSDXTMP=X S APCHSP=3 D DTOBT S BSDXTMP=BSDXTMP_"  "
  1.  S X=$P(APCHSN,U,4) S:X="" X="<not recorded>" S Y=X X:+X APCHSCVD S BSDXTMP=BSDXTMP_"LMP "_Y S APCHSP=5 D DTOBT S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  S X=$P(APCHSN,U,6) I X]""
  1.  S Y=$P(^DD(9000017,3,0),U,3),X=$P(Y,";",X+1)
  1.  S APCHSM=$P(X,":",2)
  1.  X APCHSCKP
  1.  G:$D(APCHSQIT) REPHXX
  1.  S BSDXTMP="CONTRACEPTION: "_APCHSM
  1.  S X=$P(APCHSN,U,7)
  1.  X:+X "S Y=X X APCHSCVD S BSDXTMP=BSDXTMP_"", EFFECTIVE ""_Y"
  1.  S APCHSP=8
  1.  D DTOBT
  1.  S BSDXI=BSDXI+1
  1.  S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  S X=$P(APCHSN,U,9) I X]"" X APCHSCKP G:$D(APCHSQIT) REPHXX D EDC
  1. REPHXX K APCHSN,APCHSM,APCHSN11
  1.  Q
  1.  ;
  1. NEWREP ;new reproductive factors dd
  1.  S APCHSN11=$G(^AUPNREP(APCHSPAT,0))
  1.  X APCHSCKP Q:$D(APCHSQIT)  X:'APCHSNPG APCHSBRK
  1.  S X=$$RHX^AUPNREP(APCHSPAT) I X]""
  1.  . S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30)
  1.  . S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)="Reproductive History: "_$C(30)
  1.  . S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=" "_$P(X,";",1,4)_";"_$C(30)
  1.  . S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)="  "_$P(X,";",5,7)_$C(30)
  1.  . S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)="  "_";"_$P(X,";",8,99)_$C(30)
  1.  X APCHSCKP Q:$D(APCHSQIT)  ;X:'APCHSNPG APCHSBRK
  1.  S X=$P(APCHSN,U,4) I X]"" S BSDXTMP="LMP: " S Y=X X APCHSCVD S BSDXTMP=BSDXTMP_Y S APCHSP=5 D DTOBT S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  S X=$P(APCHSN,U,6) I X]""
  1.  S Y=$P(^DD(9000017,3,0),U,3),X=$P(Y,";",X+1)
  1.  S APCHSM=$P(X,":",2)
  1.  X APCHSCKP
  1.  G:$D(APCHSQIT) REPHXX
  1.  S BSDXTMP="CONTRACEPTION: "_APCHSM
  1.  S X=$P(APCHSN,U,7)
  1.  X:+X "S Y=X X APCHSCVD S BSDXTMP=BSDXTMP_"", EFFECTIVE ""_Y"
  1.  S APCHSP=8
  1.  D DTOBT
  1.  S BSDXI=BSDXI+1
  1.  S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  S X=$P(APCHSN,U,9) I X]"" X APCHSCKP G:$D(APCHSQIT) REPHXX D EDC
  1.  Q
  1.  ;
  1. LATER ;
  1.  I $O(^AUPNREP(APCHSPAT,2101,0)) D
  1.  .X APCHSCKP Q:$D(APCHSQIT)  ;X:'APCHSNPG APCHSBRK
  1.  .S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30)
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30)
  1.  .S BSDXDSP="  "_"Contraceptive Method"
  1.  .S BSDXDSP=BSDXDSP_$$FILL^BSDX41(40-$L(BSDXDSP))_"Date Started"
  1.  .S BSDXDSP=BSDXDSP_$$FILL^BSDX41(55-$L(BSDXDSP))_"Date Ended"
  1.  .S APCHX=0 F  S APCHX=$O(^AUPNREP(APCHSPAT,2101,APCHX)) Q:APCHX'=+APCHX  D
  1.  ..S APCHC=$P(^AUPNREP(APCHSPAT,2101,APCHX,0),U,1) I APCHC D
  1.  ...X APCHSCKP Q:$D(APCHSQIT)  ;X:'APCHSNPG APCHSBRK
  1.  ...S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXDSP_$C(30)
  1.  ...S BSDXDSP="    "_$P(^AUTTCM(APCHC,0),U)
  1.  ...S Y=$P(^AUPNREP(APCHSPAT,2101,APCHX,0),U,2) I Y]"" X APCHSCVD S BSDXDSP=BSDXDSP_$$FILL^BSDX41(40-$L(BSDXDSP))_Y
  1.  ...S Y=$P(^AUPNREP(APCHSPAT,2101,APCHX,0),U,3) I Y]"" X APCHSCVD S BSDXDSP=BSDXDSP_$$FILL^BSDX41(55-$L(BSDXDSP))_Y
  1.  .S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXDSP_$C(30)
  1.  Q
  1. DTOBT S Y=$P(APCHSN,U,APCHSP) I Y]"" X APCHSCVD S BSDXTMP=" (obtained "_Y_")"
  1.  Q
  1.  ;
  1. EDC S Y=$P(APCHSN,U,9)
  1.  X APCHSCVD S BSDXTMP="*** NOTE: EDC "_Y S APCHSP=11 D DTOBT
  1.  I X<DT S BSDXTMP=BSDXTMP_" -- OUTDATED!"
  1.  E  S X=$P(APCHSN,U,10),APCHSM="UNKNOWN METHOD" S:X Y=$P(^DD(9000017,4.05,0),U,3),X=$P(Y,";",X+1),APCHSM=$P(X,":",2)  S BSDXTMP=BSDXTMP_" BY "_APCHSM
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  Q
  1.  ;
  1. TRTMT ; ********** TREATMENTS * 9000010.15 **********
  1.  ; <SETUP>
  1.  Q:'$D(^AUPNVTRT("AA",APCHSPAT))
  1.  X APCHSCKP Q:$D(APCHSQIT)  X:'APCHSNPG APCHSBRK
  1.  ; <DISPLAY>
  1.  S APCHSIVD="" F APCHSQ=0:0 S APCHSIVD=$O(^AUPNVTRT("AA",APCHSPAT,APCHSIVD)) Q:APCHSIVD=""!(APCHSIVD>APCHSDLM)  S Y=-APCHSIVD\1+9999999 X APCHSCVD S APCHSDTT=Y S APCHSDTU=0 D ONEDATE Q:$D(APCHSQIT)  S APCHSNDM=APCHSNDM-APCHSDTU Q:APCHSNDM=0
  1.  ; <CLEANUP>
  1. TRTMTX K APCHSVDF,APCHSIVD,APCHSDTU,APCHSDTT,APCHSDFN,APCHSFO,APCHSFAC,APCHSNT,APCHST,APCHSLVL,APCHSLVT,APCHSN
  1.  K APCHSNFL,APCHSNSH,APCHSNAB,APCHSVSC,APCHSITE
  1.  Q
  1. ONEDATE S APCHSDFN="" F APCHSQ=0:0 S APCHSDFN=$O(^AUPNVTRT("AA",APCHSPAT,APCHSIVD,APCHSDFN)) Q:APCHSDFN=""  D TRTCHK Q:$D(APCHSQIT)
  1.  Q
  1. TRTCHK S APCHSN=^AUPNVTRT(APCHSDFN,0)
  1.  Q:'$P(^AUTTTRT($P(APCHSN,U,1),0),U,3)
  1.  S APCHSVDF=$P(APCHSN,U,3) D GETSITEV^APCHSUTL Q:"ADTC"'[APCHSVSC
  1.  X APCHSCKP Q:$D(APCHSQIT)  S:APCHSNPG APCHSDTU=0
  1.  S BSDXTMP=""
  1.  I 'APCHSDTU S BSDXTMP=APCHSDTT S APCHSFO=""
  1.  I APCHSNSH=APCHSFO S APCHSFAC=""
  1.  E  S (APCHSFAC,APCHSFO)=APCHSNSH
  1.  S APCHSDTU=1
  1.  S APCHST=$P(APCHSN,U,1),APCHST=$P(^AUTTTRT(APCHST,0),U,1)
  1.  S APCHSNT=+$P(APCHSN,U,4)
  1.  S APCHSLVL=$P(APCHSN,U,6),APCHSLVT=""
  1.  I APCHSLVL]"" S APCHSLVT=$P(^DD(9000010.15,.06,0),U,3),APCHSLVT=$P($P(APCHSLVT,APCHSLVL_":",2),";",1),APCHSLVT=" - "_$P(APCHSLVT,",",1)_" UNDERSTANDING"
  1.  X APCHSCKP Q:$D(APCHSQIT)  I APCHSNPG D
  1.  . S BSDXDSP=APCHSDTT
  1.  . S BSDXDSP=BSDXDSP_$$FILL^BSDX41(10-$L(BSDXDSP))_$E(APCHSFAC,1,10)
  1.  . S BSDXDSP=BSDXDSP_$$FILL^BSDX41(21-$L(BSDXDSP))_APCHST_" ("_APCHSNT_")"_APCHSLVT
  1.  . S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_BSDXDSP_$C(30)
  1.  Q
  1.  ;
  1. TXC ;EP - called from component 
  1.  ; <SETUP>
  1.  Q:'$D(^AUPNVTXC("AA",APCHSPAT))
  1.  X APCHSBRK
  1.  ; <DISPLAY>
  1.  S APCHST="" F APCHSQ=0:0 S APCHST=$O(^AUPNVTXC("AA",APCHSPAT,APCHST)) Q:APCHST=""  S APCHSTX=$$EXTSET^XBFUNC(9000010.39,.01,APCHST),APCHSTL=$L(APCHSTX) X APCHSCKP Q:$D(APCHSQIT)  D TXDSP6
  1.  ; <CLEANUP>
  1. TXCX K APCHST,APCHSTX,APCHSTL,APCHSIVD,APCHSDFN,APCHSDI,APCHSVDF,APCHSDAT,APCHSCNT,APCHS,X,Y
  1.  K APCHSNFL,APCHSNSH,APCHSNAB,APCHSVSC,APCHSITE
  1.  Q
  1. TXDSP6 ;get contract type
  1.  S APCHSCNT=0
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30)
  1.  X APCHSCKP Q:$D(APCHSQIT)
  1.  S BSDXDSP=BSDXDSP_APCHSTX
  1.  S APCHSIVD=""
  1.  F APCHSQ=0:0 S APCHSIVD=$O(^AUPNVTXC("AA",APCHSPAT,APCHST,APCHSIVD)) S APCHSCNT=APCHSCNT+1 Q:APCHSIVD=""!(APCHSCNT>6)  D TXDSP13
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXDSP_$C(30)
  1.  Q
  1. TXDSP13 ;
  1.  S Y=-APCHSIVD\1+9999999 X APCHSCVD S APCHSDAT=Y
  1.  S APCHSDFN=0 F APCHSQ=0:0 S APCHSDFN=$O(^AUPNVTXC("AA",APCHSPAT,APCHST,APCHSIVD,APCHSDFN)) Q:'APCHSDFN!(APCHSCNT>6)  D TXDSP23
  1.  Q
  1. TXDSP23 ;
  1.  S Y=-APCHSIVD\1+9999999 X APCHSCVD S APCHSDAT=Y
  1.  S APCHSVDF=$P(^AUPNVTXC(APCHSDFN,0),U,3)
  1.  S APCHSDI=$$VAL^XBDIQ1(9000010.39,APCHSDFN,.04)
  1.  S APCHSPI=$$VAL^XBDIQ1(9000010.39,APCHSDFN,.05)
  1.  X APCHSCKP Q:$D(APCHSQIT)  I APCHSNPG D
  1.  . S BSDXDSP=BSDXDSP_APCHSTX
  1.  . S BSDXDSP=BSDXDSP_$$FILL^BSDX41(20-$L(BSDXDSP))_APCHSDI
  1.  . S BSDXDSP=BSDXDSP_$$FILL^BSDX41(40-$L(BSDXDSP))_APCHSPI_$C(10,13)
  1.  Q
  1. BIRTHM ; ********** BIRTH MEASUREMENTS 9000024 AND V INFANT FEEDING 9000010.44 **********
  1.  ; <SETUP>
  1.  I '$D(^AUPNBMSR("B",APCHSPAT)),'$O(^AUPNVIF("AC",APCHSPAT,0)) Q
  1.  X APCHSCKP Q:$D(APCHSQIT)  X:'APCHSNPG APCHSBRK
  1.  ; <DISPLAY>
  1.  S APCHX=$G(^AUPNBMSR(APCHSPAT,0))
  1.  S BSDXDSP="BIRTH WEIGHT (kg)"
  1.  S BSDXDSP=BSDXDSP_$$FILL^BSDX41(30-$L(BSDXDSP))_$P(APCHX,U,18)
  1.  S BSDXTMP=BSDXDSP
  1.  X APCHSCKP Q:$D(APCHSQIT)
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  S BSDXDSP="BIRTH ORDER" S X=$P(APCHX,U,11) S:X["W" X=+X_" weeks" S:X["D" X=+X_" days" S:X["M" X=+X_" months" S:X["Y" X=+X_" years" S BSDXDSP=BSDXDSP_$$FILL^BSDX41(30-$L(BSDXDSP))_X
  1.  S BSDXTMP=BSDXDSP
  1.  X APCHSCKP Q:$D(APCHSQIT)
  1.  S X=$P(APCHX,U,12)
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  S BSDXDSP="FORMULA STARTED (age)" S:X["W" X=+X_" weeks" S:X["D" X=+X_" days" S:X["M" X=+X_" months" S:X["Y" X=+X_" years" S BSDXDSP=BSDXDSP_$$FILL^BSDX41(30-$L(BSDXDSP))_X
  1.  S BSDXTMP=BSDXDSP
  1.  X APCHSCKP Q:$D(APCHSQIT)
  1.  S X=$P(APCHX,U,14)
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  S BSDXDSP="BREAST STOPPED (age)" S:X["W" X=+X_" weeks" S:X["D" X=+X_" days" S:X["M" X=+X_" months" S:X["Y" X=+X_" years" S BSDXDSP=BSDXDSP_$$FILL^BSDX41(30-$L(BSDXDSP))_X
  1.  S BSDXTMP=BSDXDSP
  1.  X APCHSCKP Q:$D(APCHSQIT)
  1.  S X=$P(APCHX,U,16)
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  S BSDXDSP="SOLIDS BEGUN (age)" S:X["W" X=+X_" weeks" S:X["D" X=+X_" days" S:X["M" X=+X_" months" S:X["Y" X=+X_" years" S BSDXDSP=BSDXDSP_$$FILL^BSDX41(30-$L(BSDXDSP))_X
  1.  S BSDXTMP=BSDXDSP
  1.  Q:'$O(^AUPNVIF("AC",APCHSPAT,0))
  1.  K APCHT S APCHX=0 F  S APCHX=$O(^AUPNVIF("AC",APCHSPAT,APCHX)) Q:APCHX'=+APCHX  D
  1.  .S V=$P(^AUPNVIF(APCHX,0),U,3)
  1.  .Q:'V
  1.  .S V=$P($P($G(^AUPNVSIT(V,0)),U),".")
  1.  .Q:V=""
  1.  .S APCHT(V,APCHX)=$$AGE^AUPNPAT(APCHSPAT,V,"E")_U_$$VAL^XBDIQ1(9000010.44,APCHX,.01)
  1.  .Q
  1.  ;write out data
  1.  X APCHSCKP Q:$D(APCHSQIT)
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30)
  1.  S BSDXDSP="VISIT DATE"
  1.  S BSDXDSP=BSDXDSP_$$FILL^BSDX41(20-$L(BSDXDSP))_"AGE"
  1.  S BSDXDSP=BSDXDSP_$$FILL^BSDX41(32-$L(BSDXDSP))_"FEEDING CHOICE"
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXDSP_$C(30)
  1.  S APCHD=0 F  S APCHD=$O(APCHT(APCHD)) Q:APCHD'=+APCHD!($D(APCHSQIT))  S APCHX=0 F  S APCHX=$O(APCHT(APCHD,APCHX)) Q:APCHX'=+APCHX!($D(APCHSQIT))  D
  1.  .X APCHSCKP Q:$D(APCHSQIT)
  1.  .S BSDXDSP=$$DATE^APCHSMU(APCHD)
  1.  .S BSDXDSP=BSDXDSP_$$FILL^BSDX41(20-$L(BSDXDSP))_$P(APCHT(APCHD,APCHX),U)
  1.  .S BSDXDSP=BSDXDSP_$$FILL^BSDX41(32-$L(BSDXDSP))_$P(APCHT(APCHD,APCHX),U,2)
  1.  .S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXDSP_$C(30)
  1.  .Q
  1. BRTHX K APCHSDAT,APCHSDFN,APCHSN,APCHSP,X,Y,APCHX,APCHT,APCHD
  1.  Q