- BDMGR ; IHS/CMI/LAB - BDM DMS GUI Reports ; [ 01/23/2009 4:11 PM ]
- ;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1,8**;JUN 14, 2007;Build 53
- ;
- ;
- ;cmi/anch/maw 1/25/2005 added line in FUR for uppercase dx type
- ;
- DEBUG(BDMRET,BDMSTR) ;-- debugger
- D DEBUG^%Serenji("FUR^BDMGR(.BDMRET,.BDMSTR)")
- Q
- ;
- HS(BDMRET,BDMSTR) ;-- get health summary data from BPC
- S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
- N BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,P
- S P="|"
- S APCHSPAT=$P(BDMSTR,P)
- S APCHSTYP=$P(BDMSTR,P,2)
- I APCHSTYP'?.N S APCHSTYP=$O(^APCHSCTL("B",APCHSTYP,0))
- S BDMI=0
- S BDMERR=""
- K ^BDMTMP($J)
- S BDMRET="^BDMTMP("_$J_")"
- S ^BDMTMP($J,BDMI)="T00080DATA"_$C(30)
- S IOM=80
- D GUIR^XBLM("EN^APCHS","^XTMP(""BDMHS"",$J)")
- I '$D(^XTMP("BDMHS",$J)) D Q
- . S BDMI=BDMI+1
- . S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
- . S ^BDMTMP($J,BDMI+1)=$C(31)
- S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMHS",$J,BDMDA)) Q:'BDMDA D
- . N BDMDATA
- . S BDMI=BDMI+1
- . S BDMDATA=$G(^XTMP("BDMHS",$J,BDMDA))
- . S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
- S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
- K ^XTMP("BDMHS",$J)
- Q
- ;
- FLS(BDMRET,BDMSTR) ;-- get flow sheet data
- S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
- N BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,P,BDMODFN
- S P="|"
- I $G(DFN) S BDMODFN=DFN
- S DFN=$P(BDMSTR,P)
- S BDMFDF=$P(BDMSTR,P,2)
- I BDMFDF'?.N S BDMFDF=$O(^APCHSFLC("B",BDMFDF,0))
- S BDMI=0
- S BDMERR=""
- D SETVARS^BDMFLOW
- K ^BDMTMP($J)
- S BDMRET="^BDMTMP("_$J_")"
- S ^BDMTMP($J,BDMI)="T00080DATA"_$C(30)
- S IOM=80
- D GUIR^XBLM("FLOWDISP^BDMFLOW","^XTMP(""BDMFLS"",$J)")
- I '$D(^XTMP("BDMFLS",$J)) D Q
- . S BDMI=BDMI+1
- . S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
- . S ^BDMTMP($J,BDMI+1)=$C(31)
- S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMFLS",$J,BDMDA)) Q:'BDMDA D
- . N BDMDATA
- . S BDMI=BDMI+1
- . S BDMDATA=$G(^XTMP("BDMFLS",$J,BDMDA))
- . S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
- S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
- K ^XTMP("BDMFLS",$J)
- K BDMSPAT,BDMFDF
- I $G(BDMODFN) S DFN=BDMODFN
- Q
- ;
- PCC(BDMRET,BDMSTR) ;-- display pcc visit
- S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
- N BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,BDMVIEN,P
- S P="|"
- S BDMPAT=$P(BDMSTR,P)
- S BDMVIEN=$P(BDMSTR,P,2)
- S BDMI=0
- S BDMERR=""
- K ^BDMTMP($J)
- S BDMRET="^BDMTMP("_$J_")"
- S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
- I '$G(BDMVIEN) D
- . S BDMIVDT=$O(^AUPNVSIT("AA",BDMPAT,0))
- . I 'BDMIVDT D Q
- .. S BDMI=BDMI+1
- .. S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
- .. S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
- . S BDMVIEN=$O(^AUPNVSIT("AA",BDMPAT,BDMIVDT,0))
- Q:'$G(BDMVIEN)
- N BDMGUI
- S BDMGUI=1
- D EN^APCDVDSG(BDMVIEN,"^XTMP(""BDMLV"",$J)",BDMGUI)
- I '$D(^XTMP("BDMLV",$J)) D Q
- . S BDMI=BDMI+1
- . S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
- . S ^BDMTMP($J,BDMI+1)=$C(31)
- S BDMDA=0 F S BDMDA=$O(^XTMP("BDMLV",$J,BDMDA)) Q:'BDMDA D
- . N BDMDATA
- . S BDMI=BDMI+1
- . S BDMDATA=$G(^XTMP("BDMLV",$J,BDMDA,0))
- . S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
- S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
- K ^XTMP("BDMLV",$J)
- Q
- ;
- MED(BDMRET,BDMSTR) ;-- medication profile all meds/dm meds
- S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
- N BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,DFN,P,BDMDMO
- K BDMONLY
- S P="|"
- S DFN=$P(BDMSTR,P)
- S BDMDMO=+$P(BDMSTR,P,2)
- I $G(BDMDMO) D
- . S BDMONLY=""
- . D DMMEDS
- S BDMI=0
- S BDMERR=""
- K ^BDMTMP($J)
- S BDMREGNM="IHS DIABETES REGISTER"
- S BDMRDA=$O(^ACM(41.1,"B",BDMREGNM,0))
- S BDMRET="^BDMTMP("_$J_")"
- S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
- D MINIT^BDMVRL1
- S BDMI=BDMI+1
- S ^BDMTMP($J,BDMI)="PATIENT NAME: "_$$GET1^DIQ(2,DFN,.01)_$C(30)
- S BDMI=BDMI+1
- S ^BDMTMP($J,BDMI)="CHART: "_$$HRN^AUPNPAT(DFN,DUZ(2))_$C(30)
- I '$D(^TMP("BDMVR",$J,2)) D Q
- . S BDMI=BDMI+1
- . S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
- . S ^BDMTMP($J,BDMI+1)=$C(31)
- S BDMDA=0 F S BDMDA=$O(^TMP("BDMVR",$J,BDMDA)) Q:'BDMDA D
- . N BDMDATA
- . S BDMI=BDMI+1
- . S BDMDATA=$G(^TMP("BDMVR",$J,BDMDA,0))
- . S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
- S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
- K ^XTMP("BDMVR",$J),BDMMEDS,BDM
- K ^TMP("BDMVR",$J)
- Q
- ;
- DMMEDS ;EP - setup array for dm meds
- N S,T,TX,X,Y,Z,BDMJ
- S (T,TX)="DM AUDIT "
- F S T=$O(^ATXAX("B",T)) Q:T=""!(T'[TX) D
- .S X=0
- .F S X=$O(^ATXAX("B",T,X)) Q:'X D
- ..Q:+$P($G(^ATXAX(X,0)),U,15)'=50
- ..S BDM(X)=""
- S BDMTXDA=0
- F S BDMTXDA=$O(BDM(BDMTXDA)) Q:'BDMTXDA D
- .S X=0
- .F S X=$O(^ATXAX(BDMTXDA,21,X)) Q:'X D
- ..S Y=$P($G(^ATXAX(BDMTXDA,21,X,0)),U)
- ..Q:'Y
- ..S BDMMEDS(Y)=""
- Q:'$D(BDMMEDS)
- S DA=DFN
- Q
- ;
- APP(BDMRET,BDMSTR) ;-- appointments
- S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
- N BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,DFN,P
- S P="|"
- S DFN=$P(BDMSTR,P)
- S BDMI=0
- S BDMERR=""
- K ^BDMTMP($J)
- S BDMRET="^BDMTMP("_$J_")"
- S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
- S BDMREGNM=$P(BDMSTR,P,2)
- S BDMRDA=$O(^ACM(41.1,"B",BDMREGNM,0))
- D APPINIT^BDMVRL
- I '$D(^TMP("BDMVR",$J,2)) D Q
- . S BDMI=BDMI+1
- . S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
- . S ^BDMTMP($J,BDMI+1)=$C(31)
- S BDMDA=0 F S BDMDA=$O(^TMP("BDMVR",$J,BDMDA)) Q:'BDMDA D
- . N BDMDATA
- . S BDMI=BDMI+1
- . S BDMDATA=$G(^TMP("BDMVR",$J,BDMDA,0))
- . S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
- S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
- K ^TMP("BDMVR",$J)
- Q
- ;
- AS(BDMRET,BDMSTR) ;-- audit status
- S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
- N X,BDMY,BDMZ,BDMQUIT,P
- S P="|"
- S DFN=$P(BDMSTR,P,1)
- S BDMRDA=$P(BDMSTR,P,2)
- F BDMY=91 D:'$D(BDMQUIT)
- .S X="BDMD"_BDMY
- .X ^%ZOSF("TEST")
- .I $T D Q
- ..S BDMJOB=$J
- ..S BDMBTH=$H
- ..S BDMDMRG=BDMRDA
- ..S ^XTMP(("BDMDM"_BDMY),BDMJOB,BDMBTH,"PATS",DFN)=""
- ..S ^TMP(("BDMDM"_BDMY),BDMJOB,BDMBTH,"PATS",DFN)=""
- ..S BDMZ="TIME^BDMD"_BDMY
- ..D @BDMZ
- ..Q:$G(BDMSTP)
- ..S BDMZ="IF^BDMD"_BDMY
- ..D @BDMZ
- ..S BDMQUIT=""
- I $D(BDMQUIT) K BDMQUIT Q
- S X="BDMD99"
- X ^%ZOSF("TEST")
- I $T D Q
- .S BDMJOB=$J
- .S BDMBTH=$H
- .S BDMDMRG=BDMRDA
- .S ^XTMP("BDMDM99",BDMJOB,BDMBTH,"PATS",DFN)=""
- .S ^TMP("BDMDM99",BDMJOB,BDMBTH,"PATS",DFN)=""
- .D TIME^BDMD99
- .Q:$G(BDMSTP)
- .D IF^BDMD99
- S BDMDFN=$O(^APCLRPT("B","APCL DIABETES PROGRAM QA AUDIT",0))
- Q:'BDMDFN
- S BDMPTS=1
- S BDMPREP=2
- S BDMCUML=0
- S ^XTMP("BDMPTS",$J,DFN)=""
- S ^TMP("BDMPTS",$J,DFN)=""
- D TIME^BDMASK
- Q:$G(BDMSTP)
- S BDMRTN="ZTM^BDMASK"
- D GUIR^XBLM(BDMRTN,"^XTMP(""BDMAS"",$J)")
- Q
- ;
- CS(BDMRET,BDMSTR) ;-- case summary
- S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
- N BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,DFN,P
- S P="|"
- S BDMCS=$P(BDMSTR,P)
- S BDMRDA=$O(^ACM(41.1,"B",BDMCS,0))
- S BDMRPDA=$P(BDMSTR,P,2)
- S DFN=$P(BDMSTR,P,3)
- S BDMI=0
- S BDMERR=""
- K ^BDMTMP($J)
- S BDMRET="^BDMTMP("_$J_")"
- S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
- S IOM=80
- D GUIR^XBLM("CS1^BDMVRL","^XTMP(""BDMCS"",$J)")
- I '$D(^XTMP("BDMCS",$J)) D Q
- . S BDMI=BDMI+1
- . S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
- . S ^BDMTMP($J,BDMI+1)=$C(31)
- S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMCS",$J,BDMDA)) Q:'BDMDA D
- . N BDMDATA
- . S BDMI=BDMI+1
- . S BDMDATA=$G(^XTMP("BDMCS",$J,BDMDA))
- . S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
- S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
- K ^TMP("BDMVR",$J)
- Q
- ;
- FS(BDMRET,BDMSTR) ;-- return patient reg face sheet
- S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
- N P,DFN,BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL
- S P="|"
- S DFN=$P(BDMSTR,P)
- S BDMI=0
- S BDMERR=""
- K ^BDMTMP($J)
- S BDMRET="^BDMTMP("_$J_")"
- S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
- S IOM=80
- D GUIR^XBLM("START^AGFACE","^XTMP(""BDMFS"",$J)")
- S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMFS",$J,BDMDA)) Q:'BDMDA D
- . N BDMDATA
- . S BDMI=BDMI+1
- . S BDMDATA=$G(^XTMP("BDMFS",$J,BDMDA))
- . S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
- S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
- K ^XTMP("BDMFS",$J)
- Q
- ;
- LET(BDMRET,BDMSTR) ;-- return letter
- S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
- N P,DFN,BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,BDMLDA,BDMLET
- S P="|"
- S DFN=$P(BDMSTR,P)
- S BDMLET=$P(BDMSTR,P,2)
- S BDMLDA=$O(^BDMLET("B",BDMLET,0))
- S BDMI=0
- S BDMERR=""
- K ^BDMTMP($J)
- S BDMRET="^BDMTMP("_$J_")"
- S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
- D GUIR^XBLM("PRINT^BDMLET","^XTMP(""BDMLET"",$J)")
- S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMLET",$J,BDMDA)) Q:'BDMDA D
- . N BDMDATA
- . S BDMI=BDMI+1
- . S BDMDATA=$G(^XTMP("BDMLET",$J,BDMDA))
- . S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
- S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
- K ^XTMP("BDMLET",$J)
- Q
- ;
- PLD(BDMRET,BDMSTR) ;-- return problem list display
- S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
- N BDMPIEN,P
- S P="|"
- S BDMPIEN=$P(BDMSTR,P)
- S BDMI=0
- S BDMERR=""
- K ^BDMTMP($J)
- S BDMRET="^BDMTMP("_$J_")"
- S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
- S DIC="^AUPNPROB(",DA=BDMPIEN,DIQ(0)="C"
- D GUIR^XBLM("EN^DIQ","^XTMP(""BDMPL"",$J)")
- S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMPL",$J,BDMDA)) Q:'BDMDA D
- . N BDMDATA
- . S BDMI=BDMI+1
- . S BDMDATA=$G(^XTMP("BDMPL",$J,BDMDA))
- . S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
- S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
- K ^XTMP("BDMPL",$J)
- K DIC,DA,DIQ
- Q
- ;
- FUPROT(BDMRET) ;-- return the FU Protocols
- S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
- S BDMI=0
- S BDMERR=""
- K ^BDMTMP($J)
- S BDMRET="^BDMTMP("_$J_")"
- S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
- S IOM=80
- D GUIR^XBLM("PINIT^BDMVRL42","^XTMP(""BDMFUP"",$J)")
- S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMFUP",$J,BDMDA)) Q:'BDMDA D
- . N BDMDATA
- . S BDMI=BDMI+1
- . S BDMDATA=$G(^XTMP("BDMFUP",$J,BDMDA))
- . S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
- S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
- K ^XTMP("BDMFUP",$J)
- Q
- ;
- FUR(RETVAL,BDMSTR) ;-- print the followup report
- S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
- N P,R,BDMRTYP,BDMRS,BDMST,BDMPS,BDMDD,BDMPA,BDMPABD,BDMPAED
- N BDMPBY,BDMPBYV,BDMRL,BDMLP,BDM,BDMDEMO
- S P="|",R="~"
- D EXIT^BDMVRL4
- I $G(BDMSTR)="" S BDMSTR=$$CATSTR^BDMGU(.BDMSTR)
- S BDMRTYP=$P(BDMSTR,P)
- S BDMRS=$P(BDMSTR,P,2)
- S BDMST=$P(BDMSTR,P,3)
- I $G(BDMST)]"" S BDM("SEARCH TEMPLATE")=$O(^DIBT("B",BDMST,0))
- S BDMPS=$P(BDMSTR,P,4)
- S BDM("STATUS")=BDMPS
- S BDMDD=$P(BDMSTR,P,5)
- ;cmi/anch/maw 1/25/2005 added following line
- N X S X=BDMDD X ^%ZOSF("UPPERCASE") S BDMDD=Y
- S BDM("DM DIAGNOSIS")=BDMDD
- S BDMPA=$P(BDMSTR,P,6)
- I $G(BDMPA)="Y" S BDMFUAPP=""
- S BDMPABD=$P(BDMSTR,P,7)
- S BDMBEGIN=BDMPABD
- S BDMPAED=$P(BDMSTR,P,8)
- S BDMEND=BDMPAED
- S BDMPBY=$P(BDMSTR,P,9)
- I $P(BDMPBY,"-",2)="Community" S BDMFL=9999999.05,BDMK="COMMUNITY"
- I $P(BDMPBY,"-",3)="Provider" S BDMFL=200,BDMK="PROVIDER"
- S BDMPBYV=$P(BDMSTR,P,10)
- I BDMPBYV="All" S BDMPBYV=""
- F J=1:1 D Q:$P(BDMPBYV,R,J)=""
- . Q:$P(BDMPBYV,R,J)=""
- . S BDMK($P(BDMPBYV,R,J))=$$GET1^DIQ(BDMFL,$P(BDMPBYV,R,J),.01)
- S BDMRL=$P(BDMSTR,P,11)
- S BDMFU=$P(BDMRL,"-",2)
- S BDMLP=$P(BDMSTR,P,12)
- I $G(BDMLP)]"" S BDMLDA=$O(^BDMLET("B",BDMLP,0))
- S BDMREGNM=$P(BDMSTR,P,13)
- S BDMDEMO=$P(BDMSTR,P,15)
- S IOM=80
- D GUIR^XBLM("SCREEN^BDMVRL42","^TMP($J,")
- S BDMRTYP=$TR(BDMRTYP,"~",",")
- I BDMRTYP="All" D
- . D ALL^BDMVRL42
- . S BDMY=Y
- . D PARSE^BDMVRL42
- I BDMRTYP'="All" S BDMY=BDMRTYP D PARSE^BDMVRL42
- ;N I
- ;F I=1:1 D Q:$P(BDMRTYP,R,I)=""
- ;. ;Q:$P(BDMRTYP,R,I)=""
- ;. ;S BDM("PARSE",$P(BDMRTYP,R,I))=""
- S BDMI=0
- S BDMERR=""
- K ^BDMTMP($J)
- S RETVAL="^BDMTMP("_$J_")"
- S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
- ;D BDMG^BDMVRL4(.BDM)
- ;D FUHEAD^BDMVRL42
- ;Q
- ;
- D BDMGA^BDMVRL4(.BDMERR,.BDM,$G(BDMFUAPP),BDMFL,.BDMK,BDMRL,BDMFU,$G(BDMLDA),BDMREGNM,1,BDMDEMO)
- ;S BDMJ=0
- ;D GUIR^XBLM("BDMG^BDMVRL4(.BDM)","^XTMP(""BDMFUR"",$J)")
- ;S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMFUR",$J,BDMDA)) Q:'BDMDA D
- ;. N BDMDATA
- ;. S BDMI=BDMI+1
- ;. S BDMDATA=$G(^XTMP("BDMFUR",$J,BDMDA))
- ;. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
- S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
- D EN^XBVK("BDM")
- Q
- ;
- SELF(RETVAL,BDMSTR) ;-- glucose self monitoring report
- N BDMRG,BDMST,BDMRT,BDME,BDMSRT,P,BDMDEMO
- S P="|"
- S BDMRG=$P(BDMSTR,P)
- S BDMRDA=$O(^ACM(41.1,"B",BDMRG,0))
- S BDMST=$P(BDMSTR,P,2)
- S BDMRT=$P(BDMSTR,P,3)
- S BDME=$P(BDMSTR,P,4)
- S BDMSRT=$P(BDMSTR,P,5)
- S BDMDEMO=$P(BDMSTR,P,6)
- S BDMI=0
- S BDMERR=""
- K ^BDMTMP($J)
- S RETVAL="^BDMTMP("_$J_")"
- S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
- S IOM=80
- D BDMGA^BDMSELFM(.BDMERR,BDMRDA,BDMST,BDMRT,BDME,BDMSRT,1,BDMDEMO)
- S ^BDMTMP($J,1)=$C(31)_$G(BDMERR)
- D EN^XBVK("BDM")
- Q
- ;
- LPA(RETVAL,BDMSTR) ;-- list patient appointments
- S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
- N BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,BDMREGNM,BDMBEGIN,BDMEND,P
- S P="|"
- S BDMREGNM=$P(BDMSTR,P)
- S BDMBEGIN=$P(BDMSTR,P,2)
- S BDMEND=$P(BDMSTR,P,3)
- S BDMRDA=$O(^ACM(41.1,"B",BDMREGNM,0))
- S BDMI=0
- S BDMERR=""
- K ^BDMTMP($J)
- S RETVAL="^BDMTMP("_$J_")"
- S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
- S IOM=80
- D BDMGA^BDMVRL6(.BDMERR,BDMBEGIN,BDMEND,BDMRDA,1)
- ;D APPINIT^BDMVRL6
- ;I '$D(^TMP("BDMVR",$J,2)) D Q
- ;. S BDMI=BDMI+1
- ;. S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
- ;. S ^BDMTMP($J,BDMI+1)=$C(31)
- ;S BDMDA=0 F S BDMDA=$O(^TMP("BDMVR",$J,BDMDA)) Q:'BDMDA D
- ;. N BDMDATA
- ;. S BDMI=BDMI+1
- ;. S BDMDATA=$G(^TMP("BDMVR",$J,BDMDA,0))
- ;. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
- S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
- D EN^XBVK("BDM")
- Q
- ;
- BDMGR ; IHS/CMI/LAB - BDM DMS GUI Reports ; [ 01/23/2009 4:11 PM ]
- +1 ;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1,8**;JUN 14, 2007;Build 53
- +2 ;
- +3 ;
- +4 ;cmi/anch/maw 1/25/2005 added line in FUR for uppercase dx type
- +5 ;
- DEBUG(BDMRET,BDMSTR) ;-- debugger
- +1 DO DEBUG^%Serenji("FUR^BDMGR(.BDMRET,.BDMSTR)")
- +2 QUIT
- +3 ;
- HS(BDMRET,BDMSTR) ;-- get health summary data from BPC
- +1 ; m error trap
- SET X="MERR^BDMGU"
- SET @^%ZOSF("TRAP")
- +2 NEW BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,P
- +3 SET P="|"
- +4 SET APCHSPAT=$PIECE(BDMSTR,P)
- +5 SET APCHSTYP=$PIECE(BDMSTR,P,2)
- +6 IF APCHSTYP'?.N
- SET APCHSTYP=$ORDER(^APCHSCTL("B",APCHSTYP,0))
- +7 SET BDMI=0
- +8 SET BDMERR=""
- +9 KILL ^BDMTMP($JOB)
- +10 SET BDMRET="^BDMTMP("_$JOB_")"
- +11 SET ^BDMTMP($JOB,BDMI)="T00080DATA"_$CHAR(30)
- +12 SET IOM=80
- +13 DO GUIR^XBLM("EN^APCHS","^XTMP(""BDMHS"",$J)")
- +14 IF '$DATA(^XTMP("BDMHS",$JOB))
- Begin DoDot:1
- +15 SET BDMI=BDMI+1
- +16 SET ^BDMTMP($JOB,BDMI)="NO DATA"_$CHAR(30)
- +17 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
- End DoDot:1
- QUIT
- +18 SET BDMDA=.5
- FOR
- SET BDMDA=$ORDER(^XTMP("BDMHS",$JOB,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:1
- +19 NEW BDMDATA
- +20 SET BDMI=BDMI+1
- +21 SET BDMDATA=$GET(^XTMP("BDMHS",$JOB,BDMDA))
- +22 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
- End DoDot:1
- +23 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
- +24 KILL ^XTMP("BDMHS",$JOB)
- +25 QUIT
- +26 ;
- FLS(BDMRET,BDMSTR) ;-- get flow sheet data
- +1 ; m error trap
- SET X="MERR^BDMGU"
- SET @^%ZOSF("TRAP")
- +2 NEW BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,P,BDMODFN
- +3 SET P="|"
- +4 IF $GET(DFN)
- SET BDMODFN=DFN
- +5 SET DFN=$PIECE(BDMSTR,P)
- +6 SET BDMFDF=$PIECE(BDMSTR,P,2)
- +7 IF BDMFDF'?.N
- SET BDMFDF=$ORDER(^APCHSFLC("B",BDMFDF,0))
- +8 SET BDMI=0
- +9 SET BDMERR=""
- +10 DO SETVARS^BDMFLOW
- +11 KILL ^BDMTMP($JOB)
- +12 SET BDMRET="^BDMTMP("_$JOB_")"
- +13 SET ^BDMTMP($JOB,BDMI)="T00080DATA"_$CHAR(30)
- +14 SET IOM=80
- +15 DO GUIR^XBLM("FLOWDISP^BDMFLOW","^XTMP(""BDMFLS"",$J)")
- +16 IF '$DATA(^XTMP("BDMFLS",$JOB))
- Begin DoDot:1
- +17 SET BDMI=BDMI+1
- +18 SET ^BDMTMP($JOB,BDMI)="NO DATA"_$CHAR(30)
- +19 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
- End DoDot:1
- QUIT
- +20 SET BDMDA=.5
- FOR
- SET BDMDA=$ORDER(^XTMP("BDMFLS",$JOB,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:1
- +21 NEW BDMDATA
- +22 SET BDMI=BDMI+1
- +23 SET BDMDATA=$GET(^XTMP("BDMFLS",$JOB,BDMDA))
- +24 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
- End DoDot:1
- +25 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
- +26 KILL ^XTMP("BDMFLS",$JOB)
- +27 KILL BDMSPAT,BDMFDF
- +28 IF $GET(BDMODFN)
- SET DFN=BDMODFN
- +29 QUIT
- +30 ;
- PCC(BDMRET,BDMSTR) ;-- display pcc visit
- +1 ; m error trap
- SET X="MERR^BDMGU"
- SET @^%ZOSF("TRAP")
- +2 NEW BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,BDMVIEN,P
- +3 SET P="|"
- +4 SET BDMPAT=$PIECE(BDMSTR,P)
- +5 SET BDMVIEN=$PIECE(BDMSTR,P,2)
- +6 SET BDMI=0
- +7 SET BDMERR=""
- +8 KILL ^BDMTMP($JOB)
- +9 SET BDMRET="^BDMTMP("_$JOB_")"
- +10 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
- +11 IF '$GET(BDMVIEN)
- Begin DoDot:1
- +12 SET BDMIVDT=$ORDER(^AUPNVSIT("AA",BDMPAT,0))
- +13 IF 'BDMIVDT
- Begin DoDot:2
- +14 SET BDMI=BDMI+1
- +15 SET ^BDMTMP($JOB,BDMI)="NO DATA"_$CHAR(30)
- +16 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
- End DoDot:2
- QUIT
- +17 SET BDMVIEN=$ORDER(^AUPNVSIT("AA",BDMPAT,BDMIVDT,0))
- End DoDot:1
- +18 IF '$GET(BDMVIEN)
- QUIT
- +19 NEW BDMGUI
- +20 SET BDMGUI=1
- +21 DO EN^APCDVDSG(BDMVIEN,"^XTMP(""BDMLV"",$J)",BDMGUI)
- +22 IF '$DATA(^XTMP("BDMLV",$JOB))
- Begin DoDot:1
- +23 SET BDMI=BDMI+1
- +24 SET ^BDMTMP($JOB,BDMI)="NO DATA"_$CHAR(30)
- +25 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
- End DoDot:1
- QUIT
- +26 SET BDMDA=0
- FOR
- SET BDMDA=$ORDER(^XTMP("BDMLV",$JOB,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:1
- +27 NEW BDMDATA
- +28 SET BDMI=BDMI+1
- +29 SET BDMDATA=$GET(^XTMP("BDMLV",$JOB,BDMDA,0))
- +30 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
- End DoDot:1
- +31 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
- +32 KILL ^XTMP("BDMLV",$JOB)
- +33 QUIT
- +34 ;
- MED(BDMRET,BDMSTR) ;-- medication profile all meds/dm meds
- +1 ; m error trap
- SET X="MERR^BDMGU"
- SET @^%ZOSF("TRAP")
- +2 NEW BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,DFN,P,BDMDMO
- +3 KILL BDMONLY
- +4 SET P="|"
- +5 SET DFN=$PIECE(BDMSTR,P)
- +6 SET BDMDMO=+$PIECE(BDMSTR,P,2)
- +7 IF $GET(BDMDMO)
- Begin DoDot:1
- +8 SET BDMONLY=""
- +9 DO DMMEDS
- End DoDot:1
- +10 SET BDMI=0
- +11 SET BDMERR=""
- +12 KILL ^BDMTMP($JOB)
- +13 SET BDMREGNM="IHS DIABETES REGISTER"
- +14 SET BDMRDA=$ORDER(^ACM(41.1,"B",BDMREGNM,0))
- +15 SET BDMRET="^BDMTMP("_$JOB_")"
- +16 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
- +17 DO MINIT^BDMVRL1
- +18 SET BDMI=BDMI+1
- +19 SET ^BDMTMP($JOB,BDMI)="PATIENT NAME: "_$$GET1^DIQ(2,DFN,.01)_$CHAR(30)
- +20 SET BDMI=BDMI+1
- +21 SET ^BDMTMP($JOB,BDMI)="CHART: "_$$HRN^AUPNPAT(DFN,DUZ(2))_$CHAR(30)
- +22 IF '$DATA(^TMP("BDMVR",$JOB,2))
- Begin DoDot:1
- +23 SET BDMI=BDMI+1
- +24 SET ^BDMTMP($JOB,BDMI)="NO DATA"_$CHAR(30)
- +25 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
- End DoDot:1
- QUIT
- +26 SET BDMDA=0
- FOR
- SET BDMDA=$ORDER(^TMP("BDMVR",$JOB,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:1
- +27 NEW BDMDATA
- +28 SET BDMI=BDMI+1
- +29 SET BDMDATA=$GET(^TMP("BDMVR",$JOB,BDMDA,0))
- +30 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
- End DoDot:1
- +31 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
- +32 KILL ^XTMP("BDMVR",$JOB),BDMMEDS,BDM
- +33 KILL ^TMP("BDMVR",$JOB)
- +34 QUIT
- +35 ;
- DMMEDS ;EP - setup array for dm meds
- +1 NEW S,T,TX,X,Y,Z,BDMJ
- +2 SET (T,TX)="DM AUDIT "
- +3 FOR
- SET T=$ORDER(^ATXAX("B",T))
- IF T=""!(T'[TX)
- QUIT
- Begin DoDot:1
- +4 SET X=0
- +5 FOR
- SET X=$ORDER(^ATXAX("B",T,X))
- IF 'X
- QUIT
- Begin DoDot:2
- +6 IF +$PIECE($GET(^ATXAX(X,0)),U,15)'=50
- QUIT
- +7 SET BDM(X)=""
- End DoDot:2
- End DoDot:1
- +8 SET BDMTXDA=0
- +9 FOR
- SET BDMTXDA=$ORDER(BDM(BDMTXDA))
- IF 'BDMTXDA
- QUIT
- Begin DoDot:1
- +10 SET X=0
- +11 FOR
- SET X=$ORDER(^ATXAX(BDMTXDA,21,X))
- IF 'X
- QUIT
- Begin DoDot:2
- +12 SET Y=$PIECE($GET(^ATXAX(BDMTXDA,21,X,0)),U)
- +13 IF 'Y
- QUIT
- +14 SET BDMMEDS(Y)=""
- End DoDot:2
- End DoDot:1
- +15 IF '$DATA(BDMMEDS)
- QUIT
- +16 SET DA=DFN
- +17 QUIT
- +18 ;
- APP(BDMRET,BDMSTR) ;-- appointments
- +1 ; m error trap
- SET X="MERR^BDMGU"
- SET @^%ZOSF("TRAP")
- +2 NEW BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,DFN,P
- +3 SET P="|"
- +4 SET DFN=$PIECE(BDMSTR,P)
- +5 SET BDMI=0
- +6 SET BDMERR=""
- +7 KILL ^BDMTMP($JOB)
- +8 SET BDMRET="^BDMTMP("_$JOB_")"
- +9 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
- +10 SET BDMREGNM=$PIECE(BDMSTR,P,2)
- +11 SET BDMRDA=$ORDER(^ACM(41.1,"B",BDMREGNM,0))
- +12 DO APPINIT^BDMVRL
- +13 IF '$DATA(^TMP("BDMVR",$JOB,2))
- Begin DoDot:1
- +14 SET BDMI=BDMI+1
- +15 SET ^BDMTMP($JOB,BDMI)="NO DATA"_$CHAR(30)
- +16 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
- End DoDot:1
- QUIT
- +17 SET BDMDA=0
- FOR
- SET BDMDA=$ORDER(^TMP("BDMVR",$JOB,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:1
- +18 NEW BDMDATA
- +19 SET BDMI=BDMI+1
- +20 SET BDMDATA=$GET(^TMP("BDMVR",$JOB,BDMDA,0))
- +21 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
- End DoDot:1
- +22 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
- +23 KILL ^TMP("BDMVR",$JOB)
- +24 QUIT
- +25 ;
- AS(BDMRET,BDMSTR) ;-- audit status
- +1 ; m error trap
- SET X="MERR^BDMGU"
- SET @^%ZOSF("TRAP")
- +2 NEW X,BDMY,BDMZ,BDMQUIT,P
- +3 SET P="|"
- +4 SET DFN=$PIECE(BDMSTR,P,1)
- +5 SET BDMRDA=$PIECE(BDMSTR,P,2)
- +6 FOR BDMY=91
- IF '$DATA(BDMQUIT)
- Begin DoDot:1
- +7 SET X="BDMD"_BDMY
- +8 XECUTE ^%ZOSF("TEST")
- +9 IF $TEST
- Begin DoDot:2
- +10 SET BDMJOB=$JOB
- +11 SET BDMBTH=$HOROLOG
- +12 SET BDMDMRG=BDMRDA
- +13 SET ^XTMP(("BDMDM"_BDMY),BDMJOB,BDMBTH,"PATS",DFN)=""
- +14 SET ^TMP(("BDMDM"_BDMY),BDMJOB,BDMBTH,"PATS",DFN)=""
- +15 SET BDMZ="TIME^BDMD"_BDMY
- +16 DO @BDMZ
- +17 IF $GET(BDMSTP)
- QUIT
- +18 SET BDMZ="IF^BDMD"_BDMY
- +19 DO @BDMZ
- +20 SET BDMQUIT=""
- End DoDot:2
- QUIT
- End DoDot:1
- +21 IF $DATA(BDMQUIT)
- KILL BDMQUIT
- QUIT
- +22 SET X="BDMD99"
- +23 XECUTE ^%ZOSF("TEST")
- +24 IF $TEST
- Begin DoDot:1
- +25 SET BDMJOB=$JOB
- +26 SET BDMBTH=$HOROLOG
- +27 SET BDMDMRG=BDMRDA
- +28 SET ^XTMP("BDMDM99",BDMJOB,BDMBTH,"PATS",DFN)=""
- +29 SET ^TMP("BDMDM99",BDMJOB,BDMBTH,"PATS",DFN)=""
- +30 DO TIME^BDMD99
- +31 IF $GET(BDMSTP)
- QUIT
- +32 DO IF^BDMD99
- End DoDot:1
- QUIT
- +33 SET BDMDFN=$ORDER(^APCLRPT("B","APCL DIABETES PROGRAM QA AUDIT",0))
- +34 IF 'BDMDFN
- QUIT
- +35 SET BDMPTS=1
- +36 SET BDMPREP=2
- +37 SET BDMCUML=0
- +38 SET ^XTMP("BDMPTS",$JOB,DFN)=""
- +39 SET ^TMP("BDMPTS",$JOB,DFN)=""
- +40 DO TIME^BDMASK
- +41 IF $GET(BDMSTP)
- QUIT
- +42 SET BDMRTN="ZTM^BDMASK"
- +43 DO GUIR^XBLM(BDMRTN,"^XTMP(""BDMAS"",$J)")
- +44 QUIT
- +45 ;
- CS(BDMRET,BDMSTR) ;-- case summary
- +1 ; m error trap
- SET X="MERR^BDMGU"
- SET @^%ZOSF("TRAP")
- +2 NEW BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,DFN,P
- +3 SET P="|"
- +4 SET BDMCS=$PIECE(BDMSTR,P)
- +5 SET BDMRDA=$ORDER(^ACM(41.1,"B",BDMCS,0))
- +6 SET BDMRPDA=$PIECE(BDMSTR,P,2)
- +7 SET DFN=$PIECE(BDMSTR,P,3)
- +8 SET BDMI=0
- +9 SET BDMERR=""
- +10 KILL ^BDMTMP($JOB)
- +11 SET BDMRET="^BDMTMP("_$JOB_")"
- +12 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
- +13 SET IOM=80
- +14 DO GUIR^XBLM("CS1^BDMVRL","^XTMP(""BDMCS"",$J)")
- +15 IF '$DATA(^XTMP("BDMCS",$JOB))
- Begin DoDot:1
- +16 SET BDMI=BDMI+1
- +17 SET ^BDMTMP($JOB,BDMI)="NO DATA"_$CHAR(30)
- +18 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
- End DoDot:1
- QUIT
- +19 SET BDMDA=.5
- FOR
- SET BDMDA=$ORDER(^XTMP("BDMCS",$JOB,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:1
- +20 NEW BDMDATA
- +21 SET BDMI=BDMI+1
- +22 SET BDMDATA=$GET(^XTMP("BDMCS",$JOB,BDMDA))
- +23 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
- End DoDot:1
- +24 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
- +25 KILL ^TMP("BDMVR",$JOB)
- +26 QUIT
- +27 ;
- FS(BDMRET,BDMSTR) ;-- return patient reg face sheet
- +1 ; m error trap
- SET X="MERR^BDMGU"
- SET @^%ZOSF("TRAP")
- +2 NEW P,DFN,BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL
- +3 SET P="|"
- +4 SET DFN=$PIECE(BDMSTR,P)
- +5 SET BDMI=0
- +6 SET BDMERR=""
- +7 KILL ^BDMTMP($JOB)
- +8 SET BDMRET="^BDMTMP("_$JOB_")"
- +9 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
- +10 SET IOM=80
- +11 DO GUIR^XBLM("START^AGFACE","^XTMP(""BDMFS"",$J)")
- +12 SET BDMDA=.5
- FOR
- SET BDMDA=$ORDER(^XTMP("BDMFS",$JOB,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:1
- +13 NEW BDMDATA
- +14 SET BDMI=BDMI+1
- +15 SET BDMDATA=$GET(^XTMP("BDMFS",$JOB,BDMDA))
- +16 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
- End DoDot:1
- +17 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
- +18 KILL ^XTMP("BDMFS",$JOB)
- +19 QUIT
- +20 ;
- LET(BDMRET,BDMSTR) ;-- return letter
- +1 ; m error trap
- SET X="MERR^BDMGU"
- SET @^%ZOSF("TRAP")
- +2 NEW P,DFN,BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,BDMLDA,BDMLET
- +3 SET P="|"
- +4 SET DFN=$PIECE(BDMSTR,P)
- +5 SET BDMLET=$PIECE(BDMSTR,P,2)
- +6 SET BDMLDA=$ORDER(^BDMLET("B",BDMLET,0))
- +7 SET BDMI=0
- +8 SET BDMERR=""
- +9 KILL ^BDMTMP($JOB)
- +10 SET BDMRET="^BDMTMP("_$JOB_")"
- +11 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
- +12 DO GUIR^XBLM("PRINT^BDMLET","^XTMP(""BDMLET"",$J)")
- +13 SET BDMDA=.5
- FOR
- SET BDMDA=$ORDER(^XTMP("BDMLET",$JOB,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:1
- +14 NEW BDMDATA
- +15 SET BDMI=BDMI+1
- +16 SET BDMDATA=$GET(^XTMP("BDMLET",$JOB,BDMDA))
- +17 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
- End DoDot:1
- +18 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
- +19 KILL ^XTMP("BDMLET",$JOB)
- +20 QUIT
- +21 ;
- PLD(BDMRET,BDMSTR) ;-- return problem list display
- +1 ; m error trap
- SET X="MERR^BDMGU"
- SET @^%ZOSF("TRAP")
- +2 NEW BDMPIEN,P
- +3 SET P="|"
- +4 SET BDMPIEN=$PIECE(BDMSTR,P)
- +5 SET BDMI=0
- +6 SET BDMERR=""
- +7 KILL ^BDMTMP($JOB)
- +8 SET BDMRET="^BDMTMP("_$JOB_")"
- +9 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
- +10 SET DIC="^AUPNPROB("
- SET DA=BDMPIEN
- SET DIQ(0)="C"
- +11 DO GUIR^XBLM("EN^DIQ","^XTMP(""BDMPL"",$J)")
- +12 SET BDMDA=.5
- FOR
- SET BDMDA=$ORDER(^XTMP("BDMPL",$JOB,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:1
- +13 NEW BDMDATA
- +14 SET BDMI=BDMI+1
- +15 SET BDMDATA=$GET(^XTMP("BDMPL",$JOB,BDMDA))
- +16 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
- End DoDot:1
- +17 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
- +18 KILL ^XTMP("BDMPL",$JOB)
- +19 KILL DIC,DA,DIQ
- +20 QUIT
- +21 ;
- FUPROT(BDMRET) ;-- return the FU Protocols
- +1 ; m error trap
- SET X="MERR^BDMGU"
- SET @^%ZOSF("TRAP")
- +2 SET BDMI=0
- +3 SET BDMERR=""
- +4 KILL ^BDMTMP($JOB)
- +5 SET BDMRET="^BDMTMP("_$JOB_")"
- +6 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
- +7 SET IOM=80
- +8 DO GUIR^XBLM("PINIT^BDMVRL42","^XTMP(""BDMFUP"",$J)")
- +9 SET BDMDA=.5
- FOR
- SET BDMDA=$ORDER(^XTMP("BDMFUP",$JOB,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:1
- +10 NEW BDMDATA
- +11 SET BDMI=BDMI+1
- +12 SET BDMDATA=$GET(^XTMP("BDMFUP",$JOB,BDMDA))
- +13 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
- End DoDot:1
- +14 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
- +15 KILL ^XTMP("BDMFUP",$JOB)
- +16 QUIT
- +17 ;
- FUR(RETVAL,BDMSTR) ;-- print the followup report
- +1 ; m error trap
- SET X="MERR^BDMGU"
- SET @^%ZOSF("TRAP")
- +2 NEW P,R,BDMRTYP,BDMRS,BDMST,BDMPS,BDMDD,BDMPA,BDMPABD,BDMPAED
- +3 NEW BDMPBY,BDMPBYV,BDMRL,BDMLP,BDM,BDMDEMO
- +4 SET P="|"
- SET R="~"
- +5 DO EXIT^BDMVRL4
- +6 IF $GET(BDMSTR)=""
- SET BDMSTR=$$CATSTR^BDMGU(.BDMSTR)
- +7 SET BDMRTYP=$PIECE(BDMSTR,P)
- +8 SET BDMRS=$PIECE(BDMSTR,P,2)
- +9 SET BDMST=$PIECE(BDMSTR,P,3)
- +10 IF $GET(BDMST)]""
- SET BDM("SEARCH TEMPLATE")=$ORDER(^DIBT("B",BDMST,0))
- +11 SET BDMPS=$PIECE(BDMSTR,P,4)
- +12 SET BDM("STATUS")=BDMPS
- +13 SET BDMDD=$PIECE(BDMSTR,P,5)
- +14 ;cmi/anch/maw 1/25/2005 added following line
- +15 NEW X
- SET X=BDMDD
- XECUTE ^%ZOSF("UPPERCASE")
- SET BDMDD=Y
- +16 SET BDM("DM DIAGNOSIS")=BDMDD
- +17 SET BDMPA=$PIECE(BDMSTR,P,6)
- +18 IF $GET(BDMPA)="Y"
- SET BDMFUAPP=""
- +19 SET BDMPABD=$PIECE(BDMSTR,P,7)
- +20 SET BDMBEGIN=BDMPABD
- +21 SET BDMPAED=$PIECE(BDMSTR,P,8)
- +22 SET BDMEND=BDMPAED
- +23 SET BDMPBY=$PIECE(BDMSTR,P,9)
- +24 IF $PIECE(BDMPBY,"-",2)="Community"
- SET BDMFL=9999999.05
- SET BDMK="COMMUNITY"
- +25 IF $PIECE(BDMPBY,"-",3)="Provider"
- SET BDMFL=200
- SET BDMK="PROVIDER"
- +26 SET BDMPBYV=$PIECE(BDMSTR,P,10)
- +27 IF BDMPBYV="All"
- SET BDMPBYV=""
- +28 FOR J=1:1
- Begin DoDot:1
- +29 IF $PIECE(BDMPBYV,R,J)=""
- QUIT
- +30 SET BDMK($PIECE(BDMPBYV,R,J))=$$GET1^DIQ(BDMFL,$PIECE(BDMPBYV,R,J),.01)
- End DoDot:1
- IF $PIECE(BDMPBYV,R,J)=""
- QUIT
+31 SET BDMRL=$PIECE(BDMSTR,P,11)
+32 SET BDMFU=$PIECE(BDMRL,"-",2)
+33 SET BDMLP=$PIECE(BDMSTR,P,12)
+34 IF $GET(BDMLP)]""
SET BDMLDA=$ORDER(^BDMLET("B",BDMLP,0))
+35 SET BDMREGNM=$PIECE(BDMSTR,P,13)
+36 SET BDMDEMO=$PIECE(BDMSTR,P,15)
+37 SET IOM=80
+38 DO GUIR^XBLM("SCREEN^BDMVRL42","^TMP($J,")
+39 SET BDMRTYP=$TRANSLATE(BDMRTYP,"~",",")
+40 IF BDMRTYP="All"
Begin DoDot:1
+41 DO ALL^BDMVRL42
+42 SET BDMY=Y
+43 DO PARSE^BDMVRL42
End DoDot:1
+44 IF BDMRTYP'="All"
SET BDMY=BDMRTYP
DO PARSE^BDMVRL42
+45 ;N I
+46 ;F I=1:1 D Q:$P(BDMRTYP,R,I)=""
+47 ;. ;Q:$P(BDMRTYP,R,I)=""
+48 ;. ;S BDM("PARSE",$P(BDMRTYP,R,I))=""
+49 SET BDMI=0
+50 SET BDMERR=""
+51 KILL ^BDMTMP($JOB)
+52 SET RETVAL="^BDMTMP("_$JOB_")"
+53 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+54 ;D BDMG^BDMVRL4(.BDM)
+55 ;D FUHEAD^BDMVRL42
+56 ;Q
+57 ;
+58 DO BDMGA^BDMVRL4(.BDMERR,.BDM,$GET(BDMFUAPP),BDMFL,.BDMK,BDMRL,BDMFU,$GET(BDMLDA),BDMREGNM,1,BDMDEMO)
+59 ;S BDMJ=0
+60 ;D GUIR^XBLM("BDMG^BDMVRL4(.BDM)","^XTMP(""BDMFUR"",$J)")
+61 ;S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMFUR",$J,BDMDA)) Q:'BDMDA D
+62 ;. N BDMDATA
+63 ;. S BDMI=BDMI+1
+64 ;. S BDMDATA=$G(^XTMP("BDMFUR",$J,BDMDA))
+65 ;. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
+66 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+67 DO EN^XBVK("BDM")
+68 QUIT
+69 ;
SELF(RETVAL,BDMSTR) ;-- glucose self monitoring report
+1 NEW BDMRG,BDMST,BDMRT,BDME,BDMSRT,P,BDMDEMO
+2 SET P="|"
+3 SET BDMRG=$PIECE(BDMSTR,P)
+4 SET BDMRDA=$ORDER(^ACM(41.1,"B",BDMRG,0))
+5 SET BDMST=$PIECE(BDMSTR,P,2)
+6 SET BDMRT=$PIECE(BDMSTR,P,3)
+7 SET BDME=$PIECE(BDMSTR,P,4)
+8 SET BDMSRT=$PIECE(BDMSTR,P,5)
+9 SET BDMDEMO=$PIECE(BDMSTR,P,6)
+10 SET BDMI=0
+11 SET BDMERR=""
+12 KILL ^BDMTMP($JOB)
+13 SET RETVAL="^BDMTMP("_$JOB_")"
+14 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+15 SET IOM=80
+16 DO BDMGA^BDMSELFM(.BDMERR,BDMRDA,BDMST,BDMRT,BDME,BDMSRT,1,BDMDEMO)
+17 SET ^BDMTMP($JOB,1)=$CHAR(31)_$GET(BDMERR)
+18 DO EN^XBVK("BDM")
+19 QUIT
+20 ;
LPA(RETVAL,BDMSTR) ;-- list patient appointments
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,BDMREGNM,BDMBEGIN,BDMEND,P
+3 SET P="|"
+4 SET BDMREGNM=$PIECE(BDMSTR,P)
+5 SET BDMBEGIN=$PIECE(BDMSTR,P,2)
+6 SET BDMEND=$PIECE(BDMSTR,P,3)
+7 SET BDMRDA=$ORDER(^ACM(41.1,"B",BDMREGNM,0))
+8 SET BDMI=0
+9 SET BDMERR=""
+10 KILL ^BDMTMP($JOB)
+11 SET RETVAL="^BDMTMP("_$JOB_")"
+12 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+13 SET IOM=80
+14 DO BDMGA^BDMVRL6(.BDMERR,BDMBEGIN,BDMEND,BDMRDA,1)
+15 ;D APPINIT^BDMVRL6
+16 ;I '$D(^TMP("BDMVR",$J,2)) D Q
+17 ;. S BDMI=BDMI+1
+18 ;. S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
+19 ;. S ^BDMTMP($J,BDMI+1)=$C(31)
+20 ;S BDMDA=0 F S BDMDA=$O(^TMP("BDMVR",$J,BDMDA)) Q:'BDMDA D
+21 ;. N BDMDATA
+22 ;. S BDMI=BDMI+1
+23 ;. S BDMDATA=$G(^TMP("BDMVR",$J,BDMDA,0))
+24 ;. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
+25 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
+26 DO EN^XBVK("BDM")
+27 QUIT
+28 ;
