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

APCDDMUP.m

Go to the documentation of this file. 
  1. APCDDMUP ; IHS/CMI/LAB - EDITS FOR AUPNVSIT (VISIT:9000010) 24-MAY-1993 ;
  1.  ;;2.0;IHS PCC SUITE;**2,7**;MAY 14, 2009
  1.  ;
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR("PCC DATA ENTRY",80)
  1.  W !!,$$CTR("Diabetes Patient Data Update",80)
  1.  W !
  1.  S APCDDMPT="" D GETPAT
  1.  I APCDDMPT="" 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 APCDDA="" D CREATE
  1.  I APCDDA="" W !!,"Exiting..." H 2 D XIT Q
  1.  ;do screenman
  1.  S DA=APCDDA,DDSFILE=9001002.2,DR="[APCD 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(APCDDMER) W !!,"the following errors occurred when updating PCC" D
  1.  .S X=0 F  S X=$O(APCDDMER(X)) Q:X'=+X  W !?5,APCDDMER(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(APCDDA,.APCDDMER)
  1.  Q
  1. EN(APCDDA,APCDDMER) ;PEP - called from DM GUI
  1.  S APCDERR=0
  1.  K APCDDMER
  1.  S APCDREC=^APCDDMUP(APCDDA,0)
  1.  S APCDREC1=$G(^APCDDMUP(APCDDA,11))
  1.  ;S APCDRE14=$G(^APCDDMUP(APCDDA,14))
  1.  I '$G(APCDDMPT) S (AUPNPAT,APCDDMPT)=$P(APCDREC,U)  ;cmi/maw added 4/20/2004 for GUI Dms
  1.  D PROB
  1.  D HT
  1.  D WT
  1.  D BP^APCDDMU2
  1.  D SMOKEHF
  1.  D TBHF^APCDDMU2
  1.  D SGHF^APCDDMU2
  1.  D FOOT^APCDDMU1
  1.  D EYE^APCDDMU1
  1.  D DEPR^APCDDMU1
  1.  D DENTAL^APCDDMU1
  1.  D PAP^APCDDMU1
  1.  D MAM^APCDDMU1
  1.  D FLU^APCDDMU1
  1.  D PNEU^APCDDMU1
  1.  D TD^APCDDMU1
  1.  D PPD^APCDDMU2
  1.  D EKG^APCDDMU2
  1.  D EDUC^APCDDMU2
  1.  D LAB^APCDDMU2
  1.  D MED^APCDDMU2
  1.  D RTLHF^APCDDMU3
  1.  D LPHF^APCDDMU3
  1.  D BTLHF^APCDDMU3
  1. DEL S DA=APCDDA,DIK="^APCDDMUP(" 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^APCDDMU3
  1.  Q
  1. ERR(T) ;EP
  1.  S APCDERR=APCDERR+1,APCDDMER(APCDERR)=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(APCDREC,U,3)="" Q
  1.  I $P(APCDREC,U,4)="" Q
  1.  S N=$P(APCDREC,U,4) ;problem number to update
  1.  S APCDN=$$PROBNUM(N)
  1.  I 'APCDN S T="<<< Could not update Problem Number "_N_" with Date of DM Onset. >>>" D ERR(T) Q
  1.  S APCDD=$P(APCDREC,U,3)
  1.  D ^XBFMK
  1.  S DA=APCDN,DIE="^AUPNPROB(",DR=".13///"_$$FMTE^XLFDT(APCDD) 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 APCDVSIT
  1.  I $P(APCDREC,U,5)="" Q
  1.  I $P(APCDREC,U,6)="" Q
  1.  S APCDDMDT=$P(APCDREC,U,5)
  1.  S APCDMTYP=$O(^AUTTMSR("B","HT",0))
  1.  D EVSIT ;get event visit
  1.  I '$G(APCDVSIT) 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",APCDVSIT,X)) Q:X'=+X!(G)  I $P(^AUPNVMSR(X,0),U)=APCDMTYP,$P(^AUPNVMSR(X,0),U,4)=$P(APCDREC,U,6) S G=1
  1.  I G S T="Already have a height of "_$P(APCDREC,U,6)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(APCDVSIT,0),U)) D ERR(T) Q
  1.  K APCDALVR
  1.  S APCDALVR("APCDPAT")=APCDDMPT
  1.  S APCDALVR("APCDVSIT")=APCDVSIT
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.01 (ADD)]"
  1.  S APCDALVR("APCDTTYP")="`"_APCDMTYP
  1.  S APCDALVR("APCDTVAL")=$P(APCDREC,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 APCDVSIT
  1.  I $P(APCDREC,U,7)="" Q
  1.  I $P(APCDREC,U,8)="" Q
  1.  S APCDDMDT=$P(APCDREC,U,7)
  1.  S APCDMTYP=$O(^AUTTMSR("B","WT",0))
  1.  D EVSIT ;get event visit
  1.  I '$G(APCDVSIT) 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",APCDVSIT,X)) Q:X'=+X!(G)  I $P(^AUPNVMSR(X,0),U)=APCDMTYP,$P(^AUPNVMSR(X,0),U,4)=$P(APCDREC,U,8) S G=1
  1.  I G S T="Already have a weight of "_$P(APCDREC,U,8)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(APCDVSIT,0),U)) D ERR(T) Q
  1.  K APCDALVR
  1.  S APCDALVR("APCDPAT")=APCDDMPT
  1.  S APCDALVR("APCDVSIT")=APCDVSIT
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.01 (ADD)]"
  1.  S APCDALVR("APCDTTYP")="`"_APCDMTYP
  1.  S APCDALVR("APCDTVAL")=$P(APCDREC,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 APCDVSIT
  1.  I $P(APCDREC,U,9)="" Q
  1.  S APCDDMDT=$S($P(APCDREC1,U,14)]"":$P(APCDREC1,U,14),1:DT)
  1.  S APCDMTYP=$P(APCDREC,U,9)
  1.  S APCDMCAT=$P(^AUTTHF(APCDMTYP,0),U,3)
  1.  D EVSIT ;get event visit
  1.  I '$G(APCDVSIT) 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",APCDVSIT,X)) Q:X'=+X!(G)  I $P(^AUPNVHF(X,0),U)=APCDMTYP S G=1
  1.  I G S T="Already have a health factor of "_$P(^AUTTHF($P(APCDREC,U,9),0),U)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(APCDVSIT,0),U)) D ERR(T) Q
  1.  K APCDALVR
  1.  S APCDALVR("APCDPAT")=APCDDMPT
  1.  S APCDALVR("APCDVSIT")=APCDVSIT
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"
  1.  S APCDALVR("APCDTHF")="`"_APCDMTYP
  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 APCDHSE="",X=0 F  S X=$O(^AUPNHF("AC",APCDDMPT,X)) Q:X'=+X!(APCDHSE)  I $P(^AUTTHF($P(^AUPNHF(X,0),U),0),U,3)=APCDMCAT S APCDHSE=X
  1.  ;I APCDHSE D  Q
  1.  ;.D ^XBFMK K DIADD
  1.  ;.S DA=APCDHSE,DIE="^AUPNHF(",DR=".01///`"_APCDMTYP_";.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=APCDMTYP,DIC("DR")=".02////"_APCDDMPT_";.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 APCDIN
  1.  S APCDIN("PAT")=APCDDMPT
  1.  S APCDIN("VISIT DATE")=APCDDMDT_".12"
  1.  S APCDIN("SITE")=DUZ(2)
  1.  S APCDIN("VISIT TYPE")=$S($P($G(^APCCCTRL(DUZ(2),0)),U,4)]"":$P(^APCCCTRL(DUZ(2),0),U,4),1:"O")
  1.  S APCDIN("SRV CAT")="E"
  1.  S APCDIN("TIME RANGE")=0
  1.  S APCDIN("USR")=DUZ
  1.  K APCDALVR
  1.  K APCDBSDV
  1.  D GETVISIT^APCDAPI4(.APCDIN,.APCDBSDV)
  1.  S T=$P(APCDBSDV(0),U,2)
  1.  I T]"" Q  ;errored
  1.  S V=$O(APCDBSDV(0)) S APCDVSIT=V
  1.  I $G(APCDBSDV(V))="ADD" D DEDT^APCDEA2(APCDVSIT)
  1.  Q
  1. EVSIT ;EP - get/create event visit
  1.  I $L($T(^BSDAPI4)) D  Q
  1.  .D BSD
  1.  K APCDVSIT
  1.  K APCDALVR
  1.  S APCDALVR("APCDAUTO")=""
  1.  S APCDALVR("APCDPAT")=APCDDMPT
  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")=APCDDMDT_".12"
  1.  D ^APCDALV
  1.  S APCDVSIT=$G(APCDALVR("APCDVSIT"))
  1.  I $G(APCDALVR("APCDVSIT","NEW")) D DEDT^APCDEA2(APCDVSIT)
  1.  K APCDALVR
  1.  Q
  1. CREATE ;create entry in fileman file
  1.  S APCDDA=""
  1.  D ^XBFMK
  1.  S X=APCDDMPT,DIC(0)="L",DIC("DR")=".02////^S X=DT",DIC="^APCDDMUP(",DIADD=1,DLAYGO=9001002.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 APCDDA=+Y
  1.  D ^XBFMK K DIADD,DLAYGO
  1.  Q
  1. GETPAT ;
  1.  S APCDDMPT=""
  1.  W !
  1.  I '$P($G(^APCDSITE(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(APCDPARM),$P(APCDPARM,U,3)="Y" W !?25,"Ok" S %=1 D YN^DICN Q:%'=1
  1.  S APCDDMPT=+Y
  1.  D INAC^APCDEA(APCDDMPT,.X) I 'X S APCDDMPT="" 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(APCDFVOK),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(APCDDMDT,6,7)="00" APCDDMDT=$E(APCDDMDT,1,5)_"01" S:$E(APCDDMDT,4,5)="00" APCDDMDT=$E(APCDDMDT,1,3)_"01"_$E(APCDDMDT,6,7)
  1.  Q
  1. PROBN ;EP
  1.  NEW APCDPLOC,APCDPPL,APCDPN,APCDPI
  1.  S X=$$UP^XLFSTR(X)
  1.  S:X["#" X=$P(X,"#")_$P(X,"#",2)
  1.  S APCDPPL="" F APCDPI=1:1:$L(X) Q:$E(X,APCDPI)?1N  S APCDPPL=APCDPPL_$E(X,APCDPI)
  1.  I APCDPPL="" D EN^DDIOL("No facility code has been entered.") K X Q
  1.  S APCDPLOC="",APCDPLOC=$O(^AUTTLOC("D",APCDPPL,APCDPLOC)) I APCDPLOC="" D EN^DDIOL("NO Location Abbreviation - PLEASE NOTIFY YOUR SUPERVISOR") K X Q
  1.  S APCDPN=$P(X,APCDPPL,2) I APCDPN=""!(APCDPN<0)!(APCDPN>999.99) D EN^DDIOL("Invalid problem number") K X Q
  1.  S APCDPN=" "_$E("000",1,(3-$L($P(APCDPN,"."))))_$P(APCDPN,".")_"."_$P(APCDPN,".",2)_$E("00",1,(2-$L($P(APCDPN,".",2))))
  1.  I '$D(^AUPNPROB("AA",AUPNPAT,APCDPLOC,APCDPN)) D EN^DDIOL("No Problem Number "_APCDPN_" on file for this patient for location "_$P(^AUTTLOC(APCDPLOC,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 APCDPLOC,APCDPPL,APCDPN,APCDPI,P
  1.  S X=$$UP^XLFSTR(X)
  1.  S:X["#" X=$P(X,"#")_$P(X,"#",2)
  1.  S APCDPPL="" F APCDPI=1:1:$L(X) Q:$E(X,APCDPI)?1N  S APCDPPL=APCDPPL_$E(X,APCDPI)
  1.  I APCDPPL="" Q ""
  1.  S APCDPLOC="",APCDPLOC=$O(^AUTTLOC("D",APCDPPL,APCDPLOC)) I APCDPLOC="" Q ""
  1.  S APCDPN=$P(X,APCDPPL,2) I APCDPN=""!(APCDPN<0)!(APCDPN>999.99) Q ""
  1.  S APCDPN=" "_$E("000",1,(3-$L($P(APCDPN,"."))))_$P(APCDPN,".")_"."_$P(APCDPN,".",2)_$E("00",1,(2-$L($P(APCDPN,".",2))))
  1.  S P=$O(^AUPNPROB("AA",AUPNPAT,APCDPLOC,APCDPN,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.  ;----------