BGPGTXU ;cmi/anch/maw - ATX Gui Taxonomy Utilities
;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
;
;generic Taxonomy GUI calls
;cmi/anch/maw 3/8/2007 modified MED to remove screen on inactive meds
;
Q
DEBUG(RETVAL,BGPSTR) ;run the debugger
D DEBUG^%Serenji("TAX^BGPGTXU(.RETVAL,.BGPSTR)")
Q
;
CATSTR(ATXSRET,STR) ;EP - concatenate string
N ATXDA
S ATXSRET=""
S ATXDA=0 F S ATXDA=$O(STR(ATXDA)) Q:'ATXDA D
. S ATXSRET=ATXSRET_$G(STR(ATXDA))
Q
;
MERR ; M TRAP
N X
X ("S X=$"_"ZE")
S X="MUMPS error: """_X_""""
D ERR(X)
Q
;
ERR(ERR) ;
N X
S X="ERROR|"_ERR_$C(30)
S @ATXRET@(1)=X
Q
;
FTAX(ATXRET,ATXSTR) ;-- get taxonomies w file # passed in
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N P,ATXI,ATXFN,ATXIEN
S P="|"
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ^ATXTMP($J,ATXI)="T00007BMXIEN^T00080Taxonomy"_$C(30)
S ATXFN=$P(ATXSTR,P)
S ATXIEN=0 F S ATXIEN=$O(^ATXAX("B",ATXIEN)) Q:ATXIEN="" D
. N ATXDA
. S ATXDA=0 F S ATXDA=$O(^ATXAX("B",ATXIEN,ATXDA)) Q:'ATXDA D
.. I ATXFN]"" Q:$P($G(^ATXAX(ATXDA,0)),U,15)'=ATXFN
.. S ATXI=ATXI+1
.. S ^ATXTMP($J,ATXI)=ATXDA_U_$P($G(^ATXAX(ATXDA,0)),U)_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
MED(ATXRET) ;-- drugs
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXMED,ATXI,ATXERR,ATXIEN
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00080MED"_$C(30)
S ATXMED=0 F S ATXMED=$O(^PSDRUG("B",ATXMED)) Q:ATXMED="" D
. S ATXIEN=0 F S ATXIEN=$O(^PSDRUG("B",ATXMED,ATXIEN)) Q:'ATXIEN D
.. ;Q:$G(^PSDRUG(ATXIEN,"I")) ;need to be able to add inactive drugs for BGP
.. S ATXI=ATXI+1
.. S ^ATXTMP($J,ATXI)=ATXMED_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
IMM(ATXRET) ;-- imm
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXIMM,ATXI,ATXERR,ATXIEN
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00080IMM"_$C(30)
S ATXIMM=0 F S ATXIMM=$O(^AUTTIMM("D",ATXIMM)) Q:ATXIMM="" D
. S ATXIEN=0 F S ATXIEN=$O(^AUTTIMM("D",ATXIMM,ATXIEN)) Q:'ATXIEN D
.. ;Q:$P($G(^AUTTIMM(ATXIEN,0)),U,7)
.. S ATXI=ATXI+1
.. S ^ATXTMP($J,ATXI)=ATXIMM_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
SKT(ATXRET) ;-- skin test
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXSKT,ATXI,ATXERR,ATXIEN
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00080SKT"_$C(30)
S ATXSKT=0 F S ATXSKT=$O(^AUTTSK("B",ATXSKT)) Q:ATXSKT="" D
. S ATXIEN=0 F S ATXIEN=$O(^AUTTSK("B",ATXSKT,ATXIEN)) Q:'ATXIEN D
.. S ATXI=ATXI+1
.. S ^ATXTMP($J,ATXI)=ATXSKT_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
DXP(ATXRET) ;-- diagnostic procedure
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXDXP,ATXI,ATXERR,ATXIEN
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00080DXP"_$C(30)
S ATXDXP=0 F S ATXDXP=$O(^AUTTDXPR("B",ATXDXP)) Q:ATXDXP="" D
. S ATXIEN=0 F S ATXIEN=$O(^AUTTDXPR("B",ATXDXP,ATXIEN)) Q:'ATXIEN D
.. S ATXI=ATXI+1
.. S ^ATXTMP($J,ATXI)=ATXDXP_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
XAM(ATXRET) ;-- exam
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXXAM,ATXI,ATXERR,ATXIEN
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00080XAM"_$C(30)
S ATXXAM=0 F S ATXXAM=$O(^AUTTEXAM("B",ATXXAM)) Q:ATXXAM="" D
. S ATXIEN=0 F S ATXIEN=$O(^AUTTEXAM("B",ATXXAM,ATXIEN)) Q:'ATXIEN D
.. S ATXI=ATXI+1
.. S ^ATXTMP($J,ATXI)=ATXXAM_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
RAD(ATXRET) ;-- rad
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXRAD,ATXI,ATXERR,ATXIEN
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00080RAD"_$C(30)
S ATXRAD=0 F S ATXRAD=$O(^RAMIS(71,"B",ATXRAD)) Q:ATXRAD="" D
. S ATXIEN=0 F S ATXIEN=$O(^RAMIS(71,"B",ATXRAD,ATXIEN)) Q:'ATXIEN D
.. S ATXI=ATXI+1
.. S ^ATXTMP($J,ATXI)=ATXRAD_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
RFL(ATXRET) ;-- refusal types
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXRFL,ATXI,ATXERR,ATXIEN
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00080REFUSAL"_$C(30)
S ATXRFL=0 F S ATXRFL=$O(^AUTTREFT("B",ATXRFL)) Q:ATXRFL="" D
. S ATXIEN=0 F S ATXIEN=$O(^AUTTREFT("B",ATXRFL,ATXIEN)) Q:'ATXIEN D
.. S ATXI=ATXI+1
.. S ^ATXTMP($J,ATXI)=ATXRFL_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
EDU(ATXRET) ;-- education topics
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXEDU,ATXI,ATXERR,ATXIEN
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00050EDUCATIONTOPICS"_$C(30)
S ATXEDU=0 F S ATXEDU=$O(^AUTTEDT("B",ATXEDU)) Q:ATXEDU="" D
. S ATXIEN=0 F S ATXIEN=$O(^AUTTEDT("B",ATXEDU,ATXIEN)) Q:'ATXIEN D
.. ;Q:$P($G(^AUTTEDT(ATXIEN,0)),U,3) ;inactive
.. S ATXI=ATXI+1
.. S ^ATXTMP($J,ATXI)=ATXEDU_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
DEDU(ATXRET) ;-- get all diabetes educ
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXEDU,ATXI,ATXERR,ATXIEN
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00050EDUCATIONTOPICS"_$C(30)
S ATXEDU=0 F S ATXEDU=$O(^AUTTEDT("B",ATXEDU)) Q:ATXEDU="" D
. S ATXIEN=0 F S ATXIEN=$O(^AUTTEDT("B",ATXEDU,ATXIEN)) Q:'ATXIEN D
.. ;Q:$P($G(^AUTTEDT(ATXIEN,0)),U,3)
.. Q:$E($P($G(^AUTTEDT(ATXIEN,0)),U),1,2)'="DM"
.. S ATXI=ATXI+1
.. S ^ATXTMP($J,ATXI)=ATXEDU_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
ICD(ATXRET) ;-- get all POV's
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXPOV,ATXI,ATXERR,ATXPOVE,ATXPOVD,ATXPIEN
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00100POVS"_$C(30)
S ATXPOV="" F S ATXPOV=$O(^ICD9("AB",ATXPOV)) Q:ATXPOV="" D
. S ATXPIEN=0 F S ATXPIEN=$O(^ICD9("AB",ATXPOV,ATXPIEN)) Q:'ATXPIEN D
.. Q:$E(ATXPOV,1,1)="["
.. Q:ATXPOV="delete"
.. ;S ATXPOVE=$P($G(^ICD9(ATXPIEN,0)),U)
.. S ATXPOVE=$P($$ICDDX^ICDCODE(ATXPIEN),U,2)
.. ;Q:$P($G(^ICD9(ATXPIEN,0)),U,9)
.. S ATXI=ATXI+1
.. ;S ATXPOVD=$P($G(^ICD9(ATXPIEN,0)),U,3)
.. S ATXPOVD=$P($$ICDDX^ICDCODE(ATXPIEN),U,4)
.. S ^ATXTMP($J,ATXI)=ATXPOVE_"-"_ATXPOVD_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
LAB(ATXRET) ;-- lab tests
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXLAB,ATXI,ATXERR
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00080LAB"_$C(30)
S ATXLAB=0 F S ATXLAB=$O(^LAB(60,"B",ATXLAB)) Q:ATXLAB="" D
. S ATXI=ATXI+1
. S ^ATXTMP($J,ATXI)=ATXLAB_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
HF(ATXRET) ;-- health factors
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXHF,ATXI,ATXERR,ATXDA,ATXTB,ATXIEN
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00080HF"_$C(30)
S ATXDA=0 F S ATXDA=$O(^AUTTHF("B",ATXDA)) Q:ATXDA="" D
. S ATXIEN=0 F S ATXIEN=$O(^AUTTHF("B",ATXDA,ATXIEN)) Q:'ATXIEN D
.. ;Q:$P($G(^AUTTHF(ATXIEN,0)),U,13)
.. Q:$P($G(^AUTTHF(ATXIEN,0)),U,10)'="F"
.. S ATXHF=$P($G(^AUTTHF(ATXIEN,0)),U)
.. S ATXI=ATXI+1
.. S ^ATXTMP($J,ATXI)=ATXHF_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
CPT(ATXRET) ;-- cpts
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXCPT,ATXI,ATXERR,ATXIEN,ATXDA,ATXCPTD
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00050CPT"_$C(30)
S ATXDA=0 F S ATXDA=$O(^ICPT(ATXDA)) Q:ATXDA="" D
. ;Q:$P($G(^ICPT(ATXDA,0)),U,4) ;inactive
. ;S ATXCPT=$P($G(^ICPT(ATXDA,0)),U)
. S ATXCPT=$P($$CPT^ICPTCOD(ATXDA),U,2)
. ;S ATXCPTD=$P($G(^ICPT(ATXDA,0)),U,2)
. S ATXCPTD=$P($$CPT^ICPTCOD(ATXDA),U,3)
. S ATXI=ATXI+1
. S ^ATXTMP($J,ATXI)=ATXCPT_"-"_ATXCPTD_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
ADA(ATXRET) ;-- ada
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXADA,ATXI,ATXERR,ATXIEN,ATXDA,ATXADAD
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00050ADA"_$C(30)
S ATXDA=0 F S ATXDA=$O(^AUTTADA(ATXDA)) Q:ATXDA="" D
. ;Q:$P($G(^AUTTADA(ATXDA,0)),U,8) ;inactive
. S ATXADA=$P($G(^AUTTADA(ATXDA,0)),U)
. S ATXADAD=$P($G(^AUTTADA(ATXDA,0)),U,2)
. S ATXI=ATXI+1
. S ^ATXTMP($J,ATXI)=ATXADA_"-"_ATXADAD_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
PRV(ATXRET) ;-- providers
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXPRV,ATXI,ATXERR,ATXIEN,ATXDA
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00050PRV"_$C(30)
S ATXDA=0 F S ATXDA=$O(^VA(200,"B",ATXDA)) Q:ATXDA="" D
. S ATXIEN=0 F S ATXIEN=$O(^VA(200,"B",ATXDA,ATXIEN)) Q:'ATXIEN D
.. Q:'$O(^VA(200,"AK.PROVIDER",ATXDA,0))
.. S ATXPRV=$P($G(^VA(200,ATXIEN,0)),U)
.. S ATXI=ATXI+1
.. S ^ATXTMP($J,ATXI)=ATXPRV_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
PRVC(ATXRET) ;-- provider classes
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXPRVC,ATXI,ATXERR,ATXDA
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00050PRVC"_$C(30)
S ATXDA=0 F S ATXDA=$O(^DIC(7,"B",ATXDA)) Q:ATXDA="" D
. ;S ATXPRVC=$P($G(^DIC(7,ATXDA,0)),U)
. S ATXI=ATXI+1
. S ^ATXTMP($J,ATXI)=ATXDA_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
LABL(ATXRET) ;-- lab loinc codes
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXLABL,ATXI,ATXERR,ATXIEN,ATXDA,ATXLABD
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00050LABL"_$C(30)
S ATXDA=0 F S ATXDA=$O(^LAB(95.3,"B",ATXDA)) Q:ATXDA="" D
. S ATXIEN=0 F S ATXIEN=$O(^LAB(95.3,"B",ATXDA,ATXIEN)) Q:'ATXIEN D
.. S ATXLABL=$P($G(^LAB(95.3,ATXIEN,0)),U)_"-"_$P($G(^LAB(95.3,ATXIEN,0)),U,15)
.. S ATXLABD=$G(^LAB(95.3,ATXIEN,80))
.. S ATXI=ATXI+1
.. S ^ATXTMP($J,ATXI)=ATXLABL_"/"_ATXLABD_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
DENO(ATXRET) ;-- dental op site
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXDENO,ATXI,ATXERR,ATXIEN,ATXDA
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00050DENO^T00007IEN"_$C(30)
S ATXDA=0 F S ATXDA=$O(^ADEOPS("B",ATXDA)) Q:ATXDA="" D
. S ATXIEN=0 F S ATXIEN=$O(^ADEOPS("B",ATXDA,ATXIEN)) Q:'ATXIEN D
.. S ATXDENO=$P($G(^ADEOPS(ATXIEN,0)),U)
.. S ATXI=ATXI+1
.. S ^ATXTMP($J,ATXI)=ATXDENO_U_ATXIEN_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
CLN(ATXRET) ;-- clinic stop codes
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXCLN,ATXI,ATXERR,ATXIEN,ATXDA
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00050CLN"_$C(30)
S ATXDA=0 F S ATXDA=$O(^DIC(40.7,"B",ATXDA)) Q:ATXDA="" D
. S ATXI=ATXI+1
. S ^ATXTMP($J,ATXI)=ATXDA_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
ICDO(ATXRET) ;-- icd operation
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXICDO,ATXICDD,ATXI,ATXERR,ATXIEN,ATXDA
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00050ICDO^T00007IEN"_$C(30)
S ATXDA=0 F S ATXDA=$O(^ICD0(ATXDA)) Q:'ATXDA D
. ;S ATXICD0=$P($G(^ICD0(ATXDA,0)),U)
. S ATXICD0=$P($$ICDOP^ICDCODE(ATXDA),U,2)
. ;S ATXICDD=$P($G(^ICD0(ATXDA,0)),U,4)
. S ATXICDD=$P($$ICDOP^ICDCODE(ATXDA),U,5)
. S ATXI=ATXI+1
. S ^ATXTMP($J,ATXI)=ATXICD0_"-"_ATXICDD_U_ATXDA_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
COM(ATXRET) ;-- communities
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXCOM,ATXCOMS,ATXI,ATXERR,ATXIEN,ATXDA
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00050CLN^T00007IEN"_$C(30)
S ATXDA=0 F S ATXDA=$O(^AUTTCOM("B",ATXDA)) Q:ATXDA="" D
. S ATXIEN=0 F S ATXIEN=$O(^AUTTCOM("B",ATXDA,ATXIEN)) Q:'ATXIEN D
.. S ATXCOM=$P($G(^AUTTCOM(ATXIEN,0)),U)
.. S ATXCOMS=$S($P($G(^AUTTCOM(ATXIEN,0)),U,3):$P($G(^DIC(5,$P($G(^AUTTCOM(ATXIEN,0)),U,3),0)),U,2),1:"")
.. S ATXI=ATXI+1
.. S ^ATXTMP($J,ATXI)=ATXCOM_"-"_ATXCOMS_U_ATXIEN_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
MSR(ATXRET) ;-- measurement
S X="MERR^BGPGTXU",@^%ZOSF("TRAP")
N ATXMST,ATXMSA,ATXMS,ATXMSTE,ATXI,ATXERR,ATXIEN
K ^ATXTMP($J)
S ATXRET="^ATXTMP("_$J_")"
S ATXI=0
S ATXERR=""
S ^ATXTMP($J,ATXI)="T00080MSR"_$C(30)
S ATXMST=0 F S ATXMST=$O(^AUTTMSR(ATXMST)) Q:'ATXMST D
. S ATXI=ATXI+1
. S ATXMSA=$P($G(^AUTTMSR(ATXMST,0)),U)
. S ATXMS=$P($G(^AUTTMSR(ATXMST,0)),U,2)
. S ^ATXTMP($J,ATXI)=ATXMS_$C(30)
S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
Q
;
BGPGTXU ;cmi/anch/maw - ATX Gui Taxonomy Utilities
+1 ;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
+2 ;
+3 ;generic Taxonomy GUI calls
+4 ;cmi/anch/maw 3/8/2007 modified MED to remove screen on inactive meds
+5 ;
+6 QUIT
DEBUG(RETVAL,BGPSTR) ;run the debugger
+1 DO DEBUG^%Serenji("TAX^BGPGTXU(.RETVAL,.BGPSTR)")
+2 QUIT
+3 ;
CATSTR(ATXSRET,STR) ;EP - concatenate string
+1 NEW ATXDA
+2 SET ATXSRET=""
+3 SET ATXDA=0
FOR
SET ATXDA=$ORDER(STR(ATXDA))
IF 'ATXDA
QUIT
Begin DoDot:1
+4 SET ATXSRET=ATXSRET_$GET(STR(ATXDA))
End DoDot:1
+5 QUIT
+6 ;
MERR ; M TRAP
+1 NEW X
+2 XECUTE ("S X=$"_"ZE")
+3 SET X="MUMPS error: """_X_""""
+4 DO ERR(X)
+5 QUIT
+6 ;
ERR(ERR) ;
+1 NEW X
+2 SET X="ERROR|"_ERR_$CHAR(30)
+3 SET @ATXRET@(1)=X
+4 QUIT
+5 ;
FTAX(ATXRET,ATXSTR) ;-- get taxonomies w file # passed in
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW P,ATXI,ATXFN,ATXIEN
+3 SET P="|"
+4 KILL ^ATXTMP($JOB)
+5 SET ATXRET="^ATXTMP("_$JOB_")"
+6 SET ATXI=0
+7 SET ^ATXTMP($JOB,ATXI)="T00007BMXIEN^T00080Taxonomy"_$CHAR(30)
+8 SET ATXFN=$PIECE(ATXSTR,P)
+9 SET ATXIEN=0
FOR
SET ATXIEN=$ORDER(^ATXAX("B",ATXIEN))
IF ATXIEN=""
QUIT
Begin DoDot:1
+10 NEW ATXDA
+11 SET ATXDA=0
FOR
SET ATXDA=$ORDER(^ATXAX("B",ATXIEN,ATXDA))
IF 'ATXDA
QUIT
Begin DoDot:2
+12 IF ATXFN]""
IF $PIECE($GET(^ATXAX(ATXDA,0)),U,15)'=ATXFN
QUIT
+13 SET ATXI=ATXI+1
+14 SET ^ATXTMP($JOB,ATXI)=ATXDA_U_$PIECE($GET(^ATXAX(ATXDA,0)),U)_$CHAR(30)
End DoDot:2
End DoDot:1
+15 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+16 QUIT
+17 ;
MED(ATXRET) ;-- drugs
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXMED,ATXI,ATXERR,ATXIEN
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00080MED"_$CHAR(30)
+8 SET ATXMED=0
FOR
SET ATXMED=$ORDER(^PSDRUG("B",ATXMED))
IF ATXMED=""
QUIT
Begin DoDot:1
+9 SET ATXIEN=0
FOR
SET ATXIEN=$ORDER(^PSDRUG("B",ATXMED,ATXIEN))
IF 'ATXIEN
QUIT
Begin DoDot:2
+10 ;Q:$G(^PSDRUG(ATXIEN,"I")) ;need to be able to add inactive drugs for BGP
+11 SET ATXI=ATXI+1
+12 SET ^ATXTMP($JOB,ATXI)=ATXMED_$CHAR(30)
End DoDot:2
End DoDot:1
+13 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+14 QUIT
+15 ;
IMM(ATXRET) ;-- imm
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXIMM,ATXI,ATXERR,ATXIEN
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00080IMM"_$CHAR(30)
+8 SET ATXIMM=0
FOR
SET ATXIMM=$ORDER(^AUTTIMM("D",ATXIMM))
IF ATXIMM=""
QUIT
Begin DoDot:1
+9 SET ATXIEN=0
FOR
SET ATXIEN=$ORDER(^AUTTIMM("D",ATXIMM,ATXIEN))
IF 'ATXIEN
QUIT
Begin DoDot:2
+10 ;Q:$P($G(^AUTTIMM(ATXIEN,0)),U,7)
+11 SET ATXI=ATXI+1
+12 SET ^ATXTMP($JOB,ATXI)=ATXIMM_$CHAR(30)
End DoDot:2
End DoDot:1
+13 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+14 QUIT
+15 ;
SKT(ATXRET) ;-- skin test
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXSKT,ATXI,ATXERR,ATXIEN
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00080SKT"_$CHAR(30)
+8 SET ATXSKT=0
FOR
SET ATXSKT=$ORDER(^AUTTSK("B",ATXSKT))
IF ATXSKT=""
QUIT
Begin DoDot:1
+9 SET ATXIEN=0
FOR
SET ATXIEN=$ORDER(^AUTTSK("B",ATXSKT,ATXIEN))
IF 'ATXIEN
QUIT
Begin DoDot:2
+10 SET ATXI=ATXI+1
+11 SET ^ATXTMP($JOB,ATXI)=ATXSKT_$CHAR(30)
End DoDot:2
End DoDot:1
+12 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+13 QUIT
+14 ;
DXP(ATXRET) ;-- diagnostic procedure
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXDXP,ATXI,ATXERR,ATXIEN
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00080DXP"_$CHAR(30)
+8 SET ATXDXP=0
FOR
SET ATXDXP=$ORDER(^AUTTDXPR("B",ATXDXP))
IF ATXDXP=""
QUIT
Begin DoDot:1
+9 SET ATXIEN=0
FOR
SET ATXIEN=$ORDER(^AUTTDXPR("B",ATXDXP,ATXIEN))
IF 'ATXIEN
QUIT
Begin DoDot:2
+10 SET ATXI=ATXI+1
+11 SET ^ATXTMP($JOB,ATXI)=ATXDXP_$CHAR(30)
End DoDot:2
End DoDot:1
+12 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+13 QUIT
+14 ;
XAM(ATXRET) ;-- exam
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXXAM,ATXI,ATXERR,ATXIEN
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00080XAM"_$CHAR(30)
+8 SET ATXXAM=0
FOR
SET ATXXAM=$ORDER(^AUTTEXAM("B",ATXXAM))
IF ATXXAM=""
QUIT
Begin DoDot:1
+9 SET ATXIEN=0
FOR
SET ATXIEN=$ORDER(^AUTTEXAM("B",ATXXAM,ATXIEN))
IF 'ATXIEN
QUIT
Begin DoDot:2
+10 SET ATXI=ATXI+1
+11 SET ^ATXTMP($JOB,ATXI)=ATXXAM_$CHAR(30)
End DoDot:2
End DoDot:1
+12 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+13 QUIT
+14 ;
RAD(ATXRET) ;-- rad
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXRAD,ATXI,ATXERR,ATXIEN
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00080RAD"_$CHAR(30)
+8 SET ATXRAD=0
FOR
SET ATXRAD=$ORDER(^RAMIS(71,"B",ATXRAD))
IF ATXRAD=""
QUIT
Begin DoDot:1
+9 SET ATXIEN=0
FOR
SET ATXIEN=$ORDER(^RAMIS(71,"B",ATXRAD,ATXIEN))
IF 'ATXIEN
QUIT
Begin DoDot:2
+10 SET ATXI=ATXI+1
+11 SET ^ATXTMP($JOB,ATXI)=ATXRAD_$CHAR(30)
End DoDot:2
End DoDot:1
+12 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+13 QUIT
+14 ;
RFL(ATXRET) ;-- refusal types
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXRFL,ATXI,ATXERR,ATXIEN
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00080REFUSAL"_$CHAR(30)
+8 SET ATXRFL=0
FOR
SET ATXRFL=$ORDER(^AUTTREFT("B",ATXRFL))
IF ATXRFL=""
QUIT
Begin DoDot:1
+9 SET ATXIEN=0
FOR
SET ATXIEN=$ORDER(^AUTTREFT("B",ATXRFL,ATXIEN))
IF 'ATXIEN
QUIT
Begin DoDot:2
+10 SET ATXI=ATXI+1
+11 SET ^ATXTMP($JOB,ATXI)=ATXRFL_$CHAR(30)
End DoDot:2
End DoDot:1
+12 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+13 QUIT
+14 ;
EDU(ATXRET) ;-- education topics
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXEDU,ATXI,ATXERR,ATXIEN
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00050EDUCATIONTOPICS"_$CHAR(30)
+8 SET ATXEDU=0
FOR
SET ATXEDU=$ORDER(^AUTTEDT("B",ATXEDU))
IF ATXEDU=""
QUIT
Begin DoDot:1
+9 SET ATXIEN=0
FOR
SET ATXIEN=$ORDER(^AUTTEDT("B",ATXEDU,ATXIEN))
IF 'ATXIEN
QUIT
Begin DoDot:2
+10 ;Q:$P($G(^AUTTEDT(ATXIEN,0)),U,3) ;inactive
+11 SET ATXI=ATXI+1
+12 SET ^ATXTMP($JOB,ATXI)=ATXEDU_$CHAR(30)
End DoDot:2
End DoDot:1
+13 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+14 QUIT
+15 ;
DEDU(ATXRET) ;-- get all diabetes educ
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXEDU,ATXI,ATXERR,ATXIEN
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00050EDUCATIONTOPICS"_$CHAR(30)
+8 SET ATXEDU=0
FOR
SET ATXEDU=$ORDER(^AUTTEDT("B",ATXEDU))
IF ATXEDU=""
QUIT
Begin DoDot:1
+9 SET ATXIEN=0
FOR
SET ATXIEN=$ORDER(^AUTTEDT("B",ATXEDU,ATXIEN))
IF 'ATXIEN
QUIT
Begin DoDot:2
+10 ;Q:$P($G(^AUTTEDT(ATXIEN,0)),U,3)
+11 IF $EXTRACT($PIECE($GET(^AUTTEDT(ATXIEN,0)),U),1,2)'="DM"
QUIT
+12 SET ATXI=ATXI+1
+13 SET ^ATXTMP($JOB,ATXI)=ATXEDU_$CHAR(30)
End DoDot:2
End DoDot:1
+14 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+15 QUIT
+16 ;
ICD(ATXRET) ;-- get all POV's
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXPOV,ATXI,ATXERR,ATXPOVE,ATXPOVD,ATXPIEN
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00100POVS"_$CHAR(30)
+8 SET ATXPOV=""
FOR
SET ATXPOV=$ORDER(^ICD9("AB",ATXPOV))
IF ATXPOV=""
QUIT
Begin DoDot:1
+9 SET ATXPIEN=0
FOR
SET ATXPIEN=$ORDER(^ICD9("AB",ATXPOV,ATXPIEN))
IF 'ATXPIEN
QUIT
Begin DoDot:2
+10 IF $EXTRACT(ATXPOV,1,1)="["
QUIT
+11 IF ATXPOV="delete"
QUIT
+12 ;S ATXPOVE=$P($G(^ICD9(ATXPIEN,0)),U)
+13 SET ATXPOVE=$PIECE($$ICDDX^ICDCODE(ATXPIEN),U,2)
+14 ;Q:$P($G(^ICD9(ATXPIEN,0)),U,9)
+15 SET ATXI=ATXI+1
+16 ;S ATXPOVD=$P($G(^ICD9(ATXPIEN,0)),U,3)
+17 SET ATXPOVD=$PIECE($$ICDDX^ICDCODE(ATXPIEN),U,4)
+18 SET ^ATXTMP($JOB,ATXI)=ATXPOVE_"-"_ATXPOVD_$CHAR(30)
End DoDot:2
End DoDot:1
+19 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+20 QUIT
+21 ;
LAB(ATXRET) ;-- lab tests
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXLAB,ATXI,ATXERR
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00080LAB"_$CHAR(30)
+8 SET ATXLAB=0
FOR
SET ATXLAB=$ORDER(^LAB(60,"B",ATXLAB))
IF ATXLAB=""
QUIT
Begin DoDot:1
+9 SET ATXI=ATXI+1
+10 SET ^ATXTMP($JOB,ATXI)=ATXLAB_$CHAR(30)
End DoDot:1
+11 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+12 QUIT
+13 ;
HF(ATXRET) ;-- health factors
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXHF,ATXI,ATXERR,ATXDA,ATXTB,ATXIEN
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00080HF"_$CHAR(30)
+8 SET ATXDA=0
FOR
SET ATXDA=$ORDER(^AUTTHF("B",ATXDA))
IF ATXDA=""
QUIT
Begin DoDot:1
+9 SET ATXIEN=0
FOR
SET ATXIEN=$ORDER(^AUTTHF("B",ATXDA,ATXIEN))
IF 'ATXIEN
QUIT
Begin DoDot:2
+10 ;Q:$P($G(^AUTTHF(ATXIEN,0)),U,13)
+11 IF $PIECE($GET(^AUTTHF(ATXIEN,0)),U,10)'="F"
QUIT
+12 SET ATXHF=$PIECE($GET(^AUTTHF(ATXIEN,0)),U)
+13 SET ATXI=ATXI+1
+14 SET ^ATXTMP($JOB,ATXI)=ATXHF_$CHAR(30)
End DoDot:2
End DoDot:1
+15 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+16 QUIT
+17 ;
CPT(ATXRET) ;-- cpts
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXCPT,ATXI,ATXERR,ATXIEN,ATXDA,ATXCPTD
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00050CPT"_$CHAR(30)
+8 SET ATXDA=0
FOR
SET ATXDA=$ORDER(^ICPT(ATXDA))
IF ATXDA=""
QUIT
Begin DoDot:1
+9 ;Q:$P($G(^ICPT(ATXDA,0)),U,4) ;inactive
+10 ;S ATXCPT=$P($G(^ICPT(ATXDA,0)),U)
+11 SET ATXCPT=$PIECE($$CPT^ICPTCOD(ATXDA),U,2)
+12 ;S ATXCPTD=$P($G(^ICPT(ATXDA,0)),U,2)
+13 SET ATXCPTD=$PIECE($$CPT^ICPTCOD(ATXDA),U,3)
+14 SET ATXI=ATXI+1
+15 SET ^ATXTMP($JOB,ATXI)=ATXCPT_"-"_ATXCPTD_$CHAR(30)
End DoDot:1
+16 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+17 QUIT
+18 ;
ADA(ATXRET) ;-- ada
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXADA,ATXI,ATXERR,ATXIEN,ATXDA,ATXADAD
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00050ADA"_$CHAR(30)
+8 SET ATXDA=0
FOR
SET ATXDA=$ORDER(^AUTTADA(ATXDA))
IF ATXDA=""
QUIT
Begin DoDot:1
+9 ;Q:$P($G(^AUTTADA(ATXDA,0)),U,8) ;inactive
+10 SET ATXADA=$PIECE($GET(^AUTTADA(ATXDA,0)),U)
+11 SET ATXADAD=$PIECE($GET(^AUTTADA(ATXDA,0)),U,2)
+12 SET ATXI=ATXI+1
+13 SET ^ATXTMP($JOB,ATXI)=ATXADA_"-"_ATXADAD_$CHAR(30)
End DoDot:1
+14 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+15 QUIT
+16 ;
PRV(ATXRET) ;-- providers
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXPRV,ATXI,ATXERR,ATXIEN,ATXDA
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00050PRV"_$CHAR(30)
+8 SET ATXDA=0
FOR
SET ATXDA=$ORDER(^VA(200,"B",ATXDA))
IF ATXDA=""
QUIT
Begin DoDot:1
+9 SET ATXIEN=0
FOR
SET ATXIEN=$ORDER(^VA(200,"B",ATXDA,ATXIEN))
IF 'ATXIEN
QUIT
Begin DoDot:2
+10 IF '$ORDER(^VA(200,"AK.PROVIDER",ATXDA,0))
QUIT
+11 SET ATXPRV=$PIECE($GET(^VA(200,ATXIEN,0)),U)
+12 SET ATXI=ATXI+1
+13 SET ^ATXTMP($JOB,ATXI)=ATXPRV_$CHAR(30)
End DoDot:2
End DoDot:1
+14 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+15 QUIT
+16 ;
PRVC(ATXRET) ;-- provider classes
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXPRVC,ATXI,ATXERR,ATXDA
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00050PRVC"_$CHAR(30)
+8 SET ATXDA=0
FOR
SET ATXDA=$ORDER(^DIC(7,"B",ATXDA))
IF ATXDA=""
QUIT
Begin DoDot:1
+9 ;S ATXPRVC=$P($G(^DIC(7,ATXDA,0)),U)
+10 SET ATXI=ATXI+1
+11 SET ^ATXTMP($JOB,ATXI)=ATXDA_$CHAR(30)
End DoDot:1
+12 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+13 QUIT
+14 ;
LABL(ATXRET) ;-- lab loinc codes
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXLABL,ATXI,ATXERR,ATXIEN,ATXDA,ATXLABD
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00050LABL"_$CHAR(30)
+8 SET ATXDA=0
FOR
SET ATXDA=$ORDER(^LAB(95.3,"B",ATXDA))
IF ATXDA=""
QUIT
Begin DoDot:1
+9 SET ATXIEN=0
FOR
SET ATXIEN=$ORDER(^LAB(95.3,"B",ATXDA,ATXIEN))
IF 'ATXIEN
QUIT
Begin DoDot:2
+10 SET ATXLABL=$PIECE($GET(^LAB(95.3,ATXIEN,0)),U)_"-"_$PIECE($GET(^LAB(95.3,ATXIEN,0)),U,15)
+11 SET ATXLABD=$GET(^LAB(95.3,ATXIEN,80))
+12 SET ATXI=ATXI+1
+13 SET ^ATXTMP($JOB,ATXI)=ATXLABL_"/"_ATXLABD_$CHAR(30)
End DoDot:2
End DoDot:1
+14 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+15 QUIT
+16 ;
DENO(ATXRET) ;-- dental op site
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXDENO,ATXI,ATXERR,ATXIEN,ATXDA
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00050DENO^T00007IEN"_$CHAR(30)
+8 SET ATXDA=0
FOR
SET ATXDA=$ORDER(^ADEOPS("B",ATXDA))
IF ATXDA=""
QUIT
Begin DoDot:1
+9 SET ATXIEN=0
FOR
SET ATXIEN=$ORDER(^ADEOPS("B",ATXDA,ATXIEN))
IF 'ATXIEN
QUIT
Begin DoDot:2
+10 SET ATXDENO=$PIECE($GET(^ADEOPS(ATXIEN,0)),U)
+11 SET ATXI=ATXI+1
+12 SET ^ATXTMP($JOB,ATXI)=ATXDENO_U_ATXIEN_$CHAR(30)
End DoDot:2
End DoDot:1
+13 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+14 QUIT
+15 ;
CLN(ATXRET) ;-- clinic stop codes
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXCLN,ATXI,ATXERR,ATXIEN,ATXDA
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00050CLN"_$CHAR(30)
+8 SET ATXDA=0
FOR
SET ATXDA=$ORDER(^DIC(40.7,"B",ATXDA))
IF ATXDA=""
QUIT
Begin DoDot:1
+9 SET ATXI=ATXI+1
+10 SET ^ATXTMP($JOB,ATXI)=ATXDA_$CHAR(30)
End DoDot:1
+11 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+12 QUIT
+13 ;
ICDO(ATXRET) ;-- icd operation
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXICDO,ATXICDD,ATXI,ATXERR,ATXIEN,ATXDA
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00050ICDO^T00007IEN"_$CHAR(30)
+8 SET ATXDA=0
FOR
SET ATXDA=$ORDER(^ICD0(ATXDA))
IF 'ATXDA
QUIT
Begin DoDot:1
+9 ;S ATXICD0=$P($G(^ICD0(ATXDA,0)),U)
+10 SET ATXICD0=$PIECE($$ICDOP^ICDCODE(ATXDA),U,2)
+11 ;S ATXICDD=$P($G(^ICD0(ATXDA,0)),U,4)
+12 SET ATXICDD=$PIECE($$ICDOP^ICDCODE(ATXDA),U,5)
+13 SET ATXI=ATXI+1
+14 SET ^ATXTMP($JOB,ATXI)=ATXICD0_"-"_ATXICDD_U_ATXDA_$CHAR(30)
End DoDot:1
+15 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+16 QUIT
+17 ;
COM(ATXRET) ;-- communities
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXCOM,ATXCOMS,ATXI,ATXERR,ATXIEN,ATXDA
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00050CLN^T00007IEN"_$CHAR(30)
+8 SET ATXDA=0
FOR
SET ATXDA=$ORDER(^AUTTCOM("B",ATXDA))
IF ATXDA=""
QUIT
Begin DoDot:1
+9 SET ATXIEN=0
FOR
SET ATXIEN=$ORDER(^AUTTCOM("B",ATXDA,ATXIEN))
IF 'ATXIEN
QUIT
Begin DoDot:2
+10 SET ATXCOM=$PIECE($GET(^AUTTCOM(ATXIEN,0)),U)
+11 SET ATXCOMS=$SELECT($PIECE($GET(^AUTTCOM(ATXIEN,0)),U,3):$PIECE($GET(^DIC(5,$PIECE($GET(^AUTTCOM(ATXIEN,0)),U,3),0)),U,2),1:"")
+12 SET ATXI=ATXI+1
+13 SET ^ATXTMP($JOB,ATXI)=ATXCOM_"-"_ATXCOMS_U_ATXIEN_$CHAR(30)
End DoDot:2
End DoDot:1
+14 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+15 QUIT
+16 ;
MSR(ATXRET) ;-- measurement
+1 SET X="MERR^BGPGTXU"
SET @^%ZOSF("TRAP")
+2 NEW ATXMST,ATXMSA,ATXMS,ATXMSTE,ATXI,ATXERR,ATXIEN
+3 KILL ^ATXTMP($JOB)
+4 SET ATXRET="^ATXTMP("_$JOB_")"
+5 SET ATXI=0
+6 SET ATXERR=""
+7 SET ^ATXTMP($JOB,ATXI)="T00080MSR"_$CHAR(30)
+8 SET ATXMST=0
FOR
SET ATXMST=$ORDER(^AUTTMSR(ATXMST))
IF 'ATXMST
QUIT
Begin DoDot:1
+9 SET ATXI=ATXI+1
+10 SET ATXMSA=$PIECE($GET(^AUTTMSR(ATXMST,0)),U)
+11 SET ATXMS=$PIECE($GET(^AUTTMSR(ATXMST,0)),U,2)
+12 SET ^ATXTMP($JOB,ATXI)=ATXMS_$CHAR(30)
End DoDot:1
+13 SET ^ATXTMP($JOB,ATXI+1)=$CHAR(31)_$GET(ATXERR)
+14 QUIT
+15 ;
