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

BDMEDMUP.m

Go to the documentation of this file. 
  1. BDMEDMUP ; IHS/CMI/LAB - EDITS FOR AUPNVSIT (VISIT:9000010) 24-MAY-1993 ; 20 Sep 2013  2:49 PM
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**7,8,10**;JUN 14, 2007;Build 12
  1.  ;
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR("DMS DATA ENTRY",80)
  1.  W !!,$$CTR("Diabetes Patient Data Update",80)
  1.  W !
  1.  S BDMEDMPT="" D GETPAT
  1.  I BDMEDMPT="" D XIT Q
  1.  W !!,"The data you enter for the above patient will be updated in the PCC",!,"database.",!
  1.  S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="Y" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) D XIT Q
  1.  I 'Y D XIT Q
  1.  W !!,"Okay, one more thing ... If you intend to update the DM Date of Onset, you"
  1.  W !,"must have the patient's DM problem number available from the problem list"
  1.  W !,"The problem number must be entered in the correct field in the following"
  1.  W !,"format: XXnn, where XX is the facility abbreviation and nn is the"
  1.  W !,"problem number, e.g.: MU7",!
  1.  S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="Y" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) D XIT Q
  1.  I 'Y D XIT Q
  1.  S BDMEDA="" D CREATE
  1.  I BDMEDA="" W !!,"Exiting..." H 2 D XIT Q
  1.  ;do screenman
  1.  S DA=BDMEDA,DDSFILE=9003203.2,DR="[BDME DM UPDATE]" D ^DDS
  1.  I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!!  ***NOTIFY PROGRAMMER***" D DEL K DIMSG H 3 D XIT Q
  1.  D UPDPCC
  1.  I $D(BDMEDMER) W !!,"the following errors occurred when updating PCC" D
  1.  .S X=0 F  S X=$O(BDMEDMER(X)) Q:X'=+X  W !?5,BDMEDMER(X)
  1.  .Q
  1.  D REF
  1.  D XIT
  1.  Q
  1.  ;
  1. UPDPCC ;update pcc
  1.  W !!,"Updating PCC database....hold on a moment...",!
  1.  D EN(BDMEDA,.BDMEDMER)
  1.  Q
  1. EN(BDMEDA,BDMEDMER) ;PEP - called from DM GUI
  1.  ;I DUZ=2836 S ^LORITMP(1)=BDMEDA
  1.  S BDMEERR=0
  1.  K BDMEDMER
  1.  Q:'$D(^BDMEDMUP(BDMEDA,0))
  1.  S BDMEREC=^BDMEDMUP(BDMEDA,0)
  1.  S BDMEREC1=$G(^BDMEDMUP(BDMEDA,11))
  1.  ;S BDMERE14=$G(^BDMEDMUP(BDMEDA,14))
  1.  I '$G(BDMEDMPT) S (AUPNPAT,BDMEDMPT)=$P(BDMEREC,U)  ;cmi/maw added 4/20/2004 for GUI Dms
  1.  D PROB
  1.  D HT
  1.  D WT
  1.  D BP^BDMEDMU2
  1.  D SMOKEHF
  1.  D TBHF^BDMEDMU2
  1.  D SGHF^BDMEDMU2
  1.  D FOOT^BDMEDMU1
  1.  D EYE^BDMEDMU1
  1.  D DEPR^BDMEDMU1
  1.  D DENTAL^BDMEDMU1
  1.  D PAP^BDMEDMU1
  1.  D MAM^BDMEDMU1
  1.  D FLU^BDMEDMU1
  1.  D PNEU^BDMEDMU1
  1.  D TD^BDMEDMU1
  1.  D HEPB^BDMEDMU1
  1.  D PPD^BDMEDMU2
  1.  D EKG^BDMEDMU2
  1.  D EDUC^BDMEDMU2
  1.  D LAB^BDMEDMU2
  1.  D MED^BDMEDMU2
  1.  D RTLHF^BDMEDMU3
  1.  D LPHF^BDMEDMU3
  1.  D BTLHF^BDMEDMU3
  1.  D ENDSHF^BDMEDMU2
  1. DEL S DA=BDMEDA,DIK="^BDMEDMUP(" D ^DIK
  1.  Q
  1. REF ;update refusals?
  1.  S DIR(0)="Y",DIR("A")="Do you want to enter any Patient REFUSALS/SERVICES NOT DONE",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G DEL
  1.  I 'Y G DEL
  1.  D REF^BDMEDMU3
  1.  Q
  1. ERR(T) ;EP
  1.  S BDMEERR=BDMEERR+1,BDMEDMER(BDMEERR)=T
  1.  Q
  1. XIT ;
  1.  D KILL^AUPNPAT
  1.  K DIADD,DLAYGO
  1.  D EN^XBVK("APCD"),EN^XBVK("AUPN")
  1.  D ^XBFMK
  1.  Q
  1. PROB ;
  1.  I $P(BDMEREC,U,3)="" Q
  1.  I $P(BDMEREC,U,4)="" Q
  1.  S N=$P(BDMEREC,U,4) ;problem number to update
  1.  S BDMEN=$$PROBNUM(N)
  1.  I 'BDMEN S T="<<< Could not update Problem Number "_N_" with Date of DM Onset. >>>" D ERR(T) Q
  1.  S BDMED=$P(BDMEREC,U,3)
  1.  D ^XBFMK
  1.  S DA=BDMEN,DIE="^AUPNPROB(",DR=".13///"_$$FMTE^XLFDT(BDMED) D ^DIE
  1.  I $D(Y) S T="<<< Could not update Problem Number "_N_" with Date of DM Onset.  DIE failed. >>>" D ERR(T)
  1.  D ^XBFMK
  1.  Q
  1. HT ;
  1.  K BDMEVSIT
  1.  I $P(BDMEREC,U,5)="" Q
  1.  I $P(BDMEREC,U,6)="" Q
  1.  S BDMEDMDT=$P(BDMEREC,U,5)
  1.  S BDMEMTYP=$O(^AUTTMSR("B","HT",0))
  1.  D EVSIT ;get event visit
  1.  I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update height." D ERR(T) Q
  1.  S (X,G)=0 F  S X=$O(^AUPNVMSR("AD",BDMEVSIT,X)) Q:X'=+X!(G)  I $P(^AUPNVMSR(X,0),U)=BDMEMTYP,$P(^AUPNVMSR(X,0),U,4)=$P(BDMEREC,U,6) S G=1
  1.  I G S T="Already have a height of "_$P(BDMEREC,U,6)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(BDMEVSIT,0),U)) D ERR(T) Q
  1.  K APCDALVR
  1.  S APCDALVR("APCDPAT")=BDMEDMPT
  1.  S APCDALVR("APCDVSIT")=BDMEVSIT
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.01 (ADD)]"
  1.  S APCDALVR("APCDTTYP")="`"_BDMEMTYP
  1.  S APCDALVR("APCDTVAL")=$P(BDMEREC,U,6)
  1.  D ^APCDALVR
  1.  I $D(APCDALVR("APCDAFLG")) S T="Error creating V Measurement Entry for Height.  PCC not updated." D ERR(T)
  1.  K APCDALVR
  1.  Q
  1. WT ;
  1.  K BDMEVSIT
  1.  I $P(BDMEREC,U,7)="" Q
  1.  I $P(BDMEREC,U,8)="" Q
  1.  S BDMEDMDT=$P(BDMEREC,U,7)
  1.  S BDMEMTYP=$O(^AUTTMSR("B","WT",0))
  1.  D EVSIT ;get event visit
  1.  I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update weight." D ERR(T) Q
  1.  S (X,G)=0 F  S X=$O(^AUPNVMSR("AD",BDMEVSIT,X)) Q:X'=+X!(G)  I $P(^AUPNVMSR(X,0),U)=BDMEMTYP,$P(^AUPNVMSR(X,0),U,4)=$P(BDMEREC,U,8) S G=1
  1.  I G S T="Already have a weight of "_$P(BDMEREC,U,8)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(BDMEVSIT,0),U)) D ERR(T) Q
  1.  K APCDALVR
  1.  S APCDALVR("APCDPAT")=BDMEDMPT
  1.  S APCDALVR("APCDVSIT")=BDMEVSIT
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.01 (ADD)]"
  1.  S APCDALVR("APCDTTYP")="`"_BDMEMTYP
  1.  S APCDALVR("APCDTVAL")=$P(BDMEREC,U,8)
  1.  D ^APCDALVR
  1.  I $D(APCDALVR("APCDAFLG")) S T="Error creating V Measurement Entry for Weight.  PCC not updated." D ERR(T)
  1.  K APCDALVR
  1.  Q
  1. SMOKEHF ;
  1.  K BDMEVSIT
  1.  I $P(BDMEREC,U,9)="" Q
  1.  S BDMEDMDT=$S($P(BDMEREC1,U,14)]"":$P(BDMEREC1,U,14),1:DT)
  1.  S BDMEMTYP=$P(BDMEREC,U,9)
  1.  S BDMEMCAT=$P(^AUTTHF(BDMEMTYP,0),U,3)
  1.  D EVSIT ;get event visit
  1.  I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update smoking health factor." D ERR(T) Q
  1.  S (X,G)=0 F  S X=$O(^AUPNVHF("AD",BDMEVSIT,X)) Q:X'=+X!(G)  I $P(^AUPNVHF(X,0),U)=BDMEMTYP S G=1
  1.  I G S T="Already have a health factor of "_$P(^AUTTHF($P(BDMEREC,U,9),0),U)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(BDMEVSIT,0),U)) D ERR(T) Q
  1.  K APCDALVR
  1.  S APCDALVR("APCDPAT")=BDMEDMPT
  1.  S APCDALVR("APCDVSIT")=BDMEVSIT
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"
  1.  S APCDALVR("APCDTHF")="`"_BDMEMTYP
  1.  D ^APCDALVR
  1.  I $D(APCDALVR("APCDAFLG")) S T="Error creating V Health Factor Entry for Smoking.  PCC not updated." D ERR(T)
  1.  K APCDALVR
  1.  ;;update health status
  1.  ;S BDMEHSE="",X=0 F  S X=$O(^AUPNHF("AC",BDMEDMPT,X)) Q:X'=+X!(BDMEHSE)  I $P(^AUTTHF($P(^AUPNHF(X,0),U),0),U,3)=BDMEMCAT S BDMEHSE=X
  1.  ;I BDMEHSE D  Q
  1.  ;.D ^XBFMK K DIADD
  1.  ;.S DA=BDMEHSE,DIE="^AUPNHF(",DR=".01///`"_BDMEMTYP_";.03////"_DT D ^DIE
  1.  ;.I $D(Y) S T="Error updating Health Status entry for Tobacco." D ERR(T)
  1.  ;.D ^XBFMK
  1.  ;D ^XBFMK
  1.  ;;S X=BDMEMTYP,DIC("DR")=".02////"_BDMEDMPT_";.03////"_DT,DIC(0)="L",DIADD=1,DLAYGO=9000019,DIC="^AUPNHF(" D FILE^DICN
  1.  ;I Y=-1 S T="Error adding health status entry for Tobacco." D ERR(T)
  1.  D ^XBFMK K DIADD,DLAYGO
  1.  Q
  1. BSD ;
  1.  K BDMEIN
  1.  S BDMEIN("PAT")=BDMEDMPT
  1.  S BDMEIN("VISIT DATE")=BDMEDMDT_".12"
  1.  S BDMEIN("SITE")=DUZ(2)
  1.  S BDMEIN("VISIT TYPE")=$S($P($G(^APCCCTRL(DUZ(2),0)),U,4)]"":$P(^APCCCTRL(DUZ(2),0),U,4),1:"O")
  1.  S BDMEIN("SRV CAT")="E"
  1.  S BDMEIN("TIME RANGE")=0
  1.  S BDMEIN("USR")=DUZ
  1.  K APCDALVR
  1.  K BDMEBSDV
  1.  D GETVISIT^APCDAPI4(.BDMEIN,.BDMEBSDV)
  1.  S T=$P(BDMEBSDV(0),U,2)
  1.  I T]"" Q  ;errored
  1.  S V=$O(BDMEBSDV(0)) S BDMEVSIT=V
  1.  I $G(BDMEBSDV(V))="ADD" D DEDT^APCDEA2(BDMEVSIT)
  1.  Q
  1. EVSIT ;EP - get/create event visit
  1.  I $L($T(^BSDAPI4)) D  Q
  1.  .D BSD
  1.  K BDMEVSIT
  1.  K APCDALVR
  1.  S APCDALVR("APCDAUTO")=""
  1.  S APCDALVR("APCDPAT")=BDMEDMPT
  1.  S APCDALVR("APCDCAT")="E"
  1.  S APCDALVR("APCDLOC")=DUZ(2)
  1.  S APCDALVR("APCDTYPE")=$S($P($G(^APCCCTRL(DUZ(2),0)),U,4)]"":$P(^APCCCTRL(DUZ(2),0),U,4),1:"O")
  1.  S APCDALVR("APCDDATE")=BDMEDMDT_".12"
  1.  D ^APCDALV
  1.  S BDMEVSIT=$G(APCDALVR("APCDVSIT"))
  1.  I $G(APCDALVR("APCDVSIT","NEW")) D DEDT^APCDEA2(BDMEVSIT)
  1.  K APCDALVR
  1.  Q
  1. CREATE ;create entry in fileman file
  1.  S BDMEDA=""
  1.  D ^XBFMK
  1.  S X=BDMEDMPT,DIC(0)="L",DIC("DR")=".02////^S X=DT",DIC="^BDMEDMUP(",DIADD=1,DLAYGO=9003203.2 K DD,DO,D0 D FILE^DICN
  1.  I Y=-1 S T="Error creating fileman file entry.  Notify programmer" D ERR(T) Q
  1.  S BDMEDA=+Y
  1.  D ^XBFMK K DIADD,DLAYGO
  1.  Q
  1. GETPAT ;
  1.  S BDMEDMPT=""
  1.  W !
  1.  I '$P($G(^BDMESITE(DUZ(2),0)),U,34) S AUPNLK("INAC")=1
  1.  S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC
  1.  Q:Y<0
  1.  I $D(BDMEPARM),$P(BDMEPARM,U,3)="Y" W !?25,"Ok" S %=1 D YN^DICN Q:%'=1
  1.  S BDMEDMPT=+Y
  1.  D INAC^APCDEA(BDMEDMPT,.X) I 'X S BDMEDMPT="" Q
  1.  I DUZ("AG")="I" D ^APCDEMDI
  1.  Q
  1.  ;
  1. VSIT01 ;EP;9000010,.01 (VISIT,VISIT/ADMIT DATE&TIME)
  1.  I '$D(AUPNPAT) D:'$D(AUPNTALK)&('$D(ZTQUEUED)) EN^DDIOL(" <No direct entry allowed>") K X Q
  1.  S:$E(X,6,7)="00" X=$E(X,1,5)_"01" S:$E(X,4,5)="00" X=$E(X,1,3)_"01"_$E(X,6,7)
  1.  I $D(AUPNDOB),$D(AUPNDOD),AUPNDOB,$D(DT),DT D VSIT01B Q
  1.  I '$D(AUPNTALK),'$D(ZTQUEUED) D EN^DDIOL("  <Required variables do not exist>")
  1.  K X
  1.  Q
  1. VSIT01B ;
  1.  I '$D(BDMEFVOK),DT_".9999"<X D:'$D(AUPNTALK)&('$D(ZTQUEUED)) EN^DDIOL("  <Future dates not allowed>") K X Q
  1.  I DUZ("AG")="I",AUPNDOD,$P(X,".",1)>AUPNDOD D:'$D(AUPNTALK)&('$D(ZTQUEUED)) EN^DDIOL("  <Patient died before this date>") K X Q
  1.  I $P(X,".",1)<AUPNDOB D:'$D(AUPNTALK)&('$D(ZTQUEUED)) EN^DDIOL("  <Patient born after this date>") K X Q
  1.  Q
  1.  ;
  1. ID ;
  1.  S:$E(BDMEDMDT,6,7)="00" BDMEDMDT=$E(BDMEDMDT,1,5)_"01" S:$E(BDMEDMDT,4,5)="00" BDMEDMDT=$E(BDMEDMDT,1,3)_"01"_$E(BDMEDMDT,6,7)
  1.  Q
  1. PROBN ;EP
  1.  NEW BDMEPLOC,BDMEPPL,BDMEPN,BDMEPI
  1.  S X=$$UP^XLFSTR(X)
  1.  S:X["#" X=$P(X,"#")_$P(X,"#",2)
  1.  S BDMEPPL="" F BDMEPI=1:1:$L(X) Q:$E(X,BDMEPI)?1N  S BDMEPPL=BDMEPPL_$E(X,BDMEPI)
  1.  I BDMEPPL="" D EN^DDIOL("No facility code has been entered.") K X Q
  1.  S BDMEPLOC="",BDMEPLOC=$O(^AUTTLOC("D",BDMEPPL,BDMEPLOC)) I BDMEPLOC="" D EN^DDIOL("NO Location Abbreviation - PLEASE NOTIFY YOUR SUPERVISOR") K X Q
  1.  S BDMEPN=$P(X,BDMEPPL,2) I BDMEPN=""!(BDMEPN<0)!(BDMEPN>999.99) D EN^DDIOL("Invalid problem number") K X Q
  1.  S BDMEPN=" "_$E("000",1,(3-$L($P(BDMEPN,"."))))_$P(BDMEPN,".")_"."_$P(BDMEPN,".",2)_$E("00",1,(2-$L($P(BDMEPN,".",2))))
  1.  I '$D(^AUPNPROB("AA",AUPNPAT,BDMEPLOC,BDMEPN)) D EN^DDIOL("No Problem Number "_BDMEPN_" on file for this patient for location "_$P(^AUTTLOC(BDMEPLOC,0),U,2)_".") K X Q
  1.  Q
  1. PROBNUM(X) ;EP - get problem ien given problem number
  1.  I $G(X)="" Q ""
  1.  NEW BDMEPLOC,BDMEPPL,BDMEPN,BDMEPI,P
  1.  S X=$$UP^XLFSTR(X)
  1.  S:X["#" X=$P(X,"#")_$P(X,"#",2)
  1.  S BDMEPPL="" F BDMEPI=1:1:$L(X) Q:$E(X,BDMEPI)?1N  S BDMEPPL=BDMEPPL_$E(X,BDMEPI)
  1.  I BDMEPPL="" Q ""
  1.  S BDMEPLOC="",BDMEPLOC=$O(^AUTTLOC("D",BDMEPPL,BDMEPLOC)) I BDMEPLOC="" Q ""
  1.  S BDMEPN=$P(X,BDMEPPL,2) I BDMEPN=""!(BDMEPN<0)!(BDMEPN>999.99) Q ""
  1.  S BDMEPN=" "_$E("000",1,(3-$L($P(BDMEPN,"."))))_$P(BDMEPN,".")_"."_$P(BDMEPN,".",2)_$E("00",1,(2-$L($P(BDMEPN,".",2))))
  1.  S P=$O(^AUPNPROB("AA",AUPNPAT,BDMEPLOC,BDMEPN,0))
  1.  Q P
  1.  N DIC,DA,D,DZ S DIC="^AUTTLOC(",DIC(0)="E",D="D",DZ="??" D DQ^DICQ K Y,DIC,D
  1.  Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------