BDMEDMU2 ; IHS/CMI/LAB - EDITS FOR AUPNVSIT (VISIT:9000010) 24-MAY-1993 ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**7,10**;JUN 14, 2007;Build 12
;
PPD ;EP
K BDMEVSIT
I $P($G(^BDMEDMUP(BDMEDA,11)),U,1)="" Q
;I $P($G(^BDMEDMUP(BDMEDA,11)),U,2)="" Q
S BDMEDMDT=$P($G(^BDMEDMUP(BDMEDA,11)),U,1)
S BDMEMTYP=$O(^AUTTSK("B","PPD",0))
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update PPD." D ERR^BDMEDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVSK("AD",BDMEVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVSK(X,0),U)=BDMEMTYP S G=1
I G S T="Already have a PPD on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(BDMEVSIT,0),U)) D ERR^BDMEDMUP(T) Q
K APCDALVR
S APCDALVR("APCDPAT")=BDMEDMPT
S APCDALVR("APCDVSIT")=BDMEVSIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010.12 (ADD)]"
S APCDALVR("APCDTSK")="`"_BDMEMTYP
S APCDALVR("APCDTREA")=$P($G(^BDMEDMUP(BDMEDA,11)),U,2)
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Skin Test Entry for PPD. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
Q
EKG ;EP
K BDMEVSIT
I $P($G(^BDMEDMUP(BDMEDA,11)),U,3)="" Q
S BDMEDMDT=$P($G(^BDMEDMUP(BDMEDA,11)),U,3)
S BDMEMTYP=$O(^AUTTDXPR("B","ECG SUMMARY",0))
S BDMEDMRE=$P(^BDMEDMUP(BDMEDA,0),U,23)
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update EKG." D ERR^BDMEDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVDXP("AD",BDMEVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVDXP(X,0),U)=BDMEMTYP S G=1
I G S T="Already have a EKG on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(BDMEVSIT,0),U)) D ERR^BDMEDMUP(T) Q
K APCDALVR
S APCDALVR("APCDPAT")=BDMEDMPT
S APCDALVR("APCDVSIT")=BDMEVSIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010.21 (ADD)]"
S APCDALVR("APCDTDXR")="`"_BDMEMTYP
S APCDALVR("APCDTRQ")=BDMEDMRE
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Diagnostic Procedure Entry for EKG. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
Q
LAB ;EP
I '$D(^BDMEDMUP(BDMEDA,13)) Q ;no educ entered
S BDMEEDU=0 F S BDMEEDU=$O(^BDMEDMUP(BDMEDA,13,BDMEEDU)) Q:BDMEEDU'=+BDMEEDU D LAB1
D ^XBFMK
K APCDALVR
Q
LAB1 ;
I $P(^BDMEDMUP(BDMEDA,13,BDMEEDU,0),U)="" Q
I $P(^BDMEDMUP(BDMEDA,13,BDMEEDU,0),U,2)="" Q
S BDMEDMDT=$P(^BDMEDMUP(BDMEDA,13,BDMEEDU,0),U,2)
S BDMEMTYP=$P(^BDMEDMUP(BDMEDA,13,BDMEEDU,0),U)
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update lab ." D ERR^BDMEDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVLAB("AD",BDMEVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVLAB(X,0),U)=BDMEMTYP S G=1
I G S T="Already have a "_$P(^LAB(60,BDMEMTYP,0),U)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(BDMEVSIT,0),U)) D ERR^BDMEDMUP(T) Q
K APCDALVR
S APCDALVR("APCDPAT")=BDMEDMPT
S APCDALVR("APCDVSIT")=BDMEVSIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010.09 (ADD)]"
S APCDALVR("APCDTLAB")="`"_BDMEMTYP
S APCDALVR("APCDTRES")=$P($G(^BDMEDMUP(BDMEDA,13,BDMEEDU,0)),U,3)
S APCDALVR("APCDTUNI")=$P($G(^BDMEDMUP(BDMEDA,13,BDMEEDU,0)),U,4)
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Lab Entry for lab test. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
Q
EDUC ;EP - add v educ to pcc
I '$D(^BDMEDMUP(BDMEDA,12)) Q ;no educ entered
S BDMEEDU=0 F S BDMEEDU=$O(^BDMEDMUP(BDMEDA,12,BDMEEDU)) Q:BDMEEDU'=+BDMEEDU D EDUC1
D ^XBFMK
K APCDALVR
Q
EDUC1 ;
I $P(^BDMEDMUP(BDMEDA,12,BDMEEDU,0),U)="" Q
I $P(^BDMEDMUP(BDMEDA,12,BDMEEDU,0),U,2)="" Q
S BDMEDMDT=$P(^BDMEDMUP(BDMEDA,12,BDMEEDU,0),U,2)
S BDMEMTYP=$P(^BDMEDMUP(BDMEDA,12,BDMEEDU,0),U)
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update pt education topic." D ERR^BDMEDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVPED("AD",BDMEVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVPED(X,0),U)=BDMEMTYP S G=1
I G S T="Already have a "_$P(^AUTTEDT(BDMEMTYP,0),U)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(BDMEVSIT,0),U)) D ERR^BDMEDMUP(T) Q
K APCDALVR
S APCDALVR("APCDPAT")=BDMEDMPT
S APCDALVR("APCDVSIT")=BDMEVSIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010.16 (ADD)]"
S APCDALVR("APCDTTOP")="`"_BDMEMTYP
S APCDALVR("APCDTLOU")=$P($G(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,3)
I $P(^DD(9000010.16,.05,0),U,2)[200 S APCDALVR("APCDTPRO")=$S($P($G(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,4):"`"_$P(^BDMEDMUP(BDMEDA,12,BDMEEDU,0),U,4),1:"")
I $P(^DD(9000010.16,.05,0),U,2)[6 D
.I $P($G(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,4)="" S APCDALVR("APCDTPRO")="" Q
.S X=$P($G(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,4)
.S X=$P($G(^VA(200,X,0)),U,16)
.I X S APCDALVR("APCDTPRO")="`"_X
S APCDALVR("APCDTIG")=$P($G(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,6)
S APCDALVR("APCDTMIN")=$P($G(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,7)
S APCDALVR("APCDTOBJ")=$P($G(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,5)
S APCDALVR("APCDTBC")=$P($G(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,8)
S APCDALVR("APCDTRTL")=$P($G(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,9)
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Patient Ed Entry for Education topic. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
Q
MED ;EP
I '$D(^BDMEDMUP(BDMEDA,14)) Q ;no med entered
S BDMEEDU=0 F S BDMEEDU=$O(^BDMEDMUP(BDMEDA,14,BDMEEDU)) Q:BDMEEDU'=+BDMEEDU D MED1
D ^XBFMK
K APCDALVR
Q
MED1 ;
I $P(^BDMEDMUP(BDMEDA,14,BDMEEDU,0),U)="" Q
I $P(^BDMEDMUP(BDMEDA,14,BDMEEDU,0),U,2)="" Q
S BDMEDMDT=$P(^BDMEDMUP(BDMEDA,14,BDMEEDU,0),U,2)
S BDMEMTYP=$P(^BDMEDMUP(BDMEDA,14,BDMEEDU,0),U)
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update lab ." D ERR^BDMEDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVMED("AD",BDMEVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVMED(X,0),U)=BDMEMTYP S G=1
I G S T="Already have a "_$P(^PSDRUG(BDMEMTYP,0),U)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(BDMEVSIT,0),U)) D ERR^BDMEDMUP(T) Q
K APCDALVR
S APCDALVR("APCDPAT")=BDMEDMPT
S APCDALVR("APCDVSIT")=BDMEVSIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010.14 (ADD)]"
S APCDALVR("APCDTRX")="`"_BDMEMTYP
S APCDALVR("APCDTQTY")=$P($G(^BDMEDMUP(BDMEDA,14,BDMEEDU,0)),U,3)
S APCDALVR("APCDTSIQ")=$P($G(^BDMEDMUP(BDMEDA,14,BDMEEDU,0)),U,4)
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Medication Entry for lab test. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
Q
BP ;EP
K BDMEVSIT
I $P(BDMEREC,U,19)="" Q
I $P(BDMEREC,U,20)="" Q
S BDMEDMDT=$P(BDMEREC,U,19)
S BDMEMTYP=$O(^AUTTMSR("B","BP",0))
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update height." D ERR^BDMEDMUP(T) Q
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,20) S G=1
I G S T="Already have a height of "_$P(BDMEREC,U,20)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(BDMEVSIT,0),U)) D ERR^BDMEDMUP(T) Q
K APCDALVR
S APCDALVR("APCDPAT")=BDMEDMPT
S APCDALVR("APCDVSIT")=BDMEVSIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010.01 (ADD)]"
S APCDALVR("APCDTTYP")="`"_BDMEMTYP
S APCDALVR("APCDTVAL")=$P(BDMEREC,U,20)
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Measurement Entry for BP. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
Q
BI() ;EP- check to see if using new imm package or not 1/5/1999 IHS/CMI/LAB
Q $S($O(^AUTTIMM(0))<100:0,1:1)
;end new subrotuine CMI/TUCSON/LAB
EVSIT ;get/create event visit
K BDMEVSIT
K APCDALVR
S APCDALVR("APCDAUTO")=""
S APCDALVR("APCDPAT")=BDMEDMPT
S APCDALVR("APCDCAT")="E"
S APCDALVR("APCDLOC")=DUZ(2)
S APCDALVR("APCDTYPE")=$S($P($G(^APCCCTRL(DUZ(2),0)),U,4)]"":$P(^APCCCTRL(DUZ(2),0),U,4),1:"O")
S APCDALVR("APCDDATE")=BDMEDMDT_".12"
D ^APCDALV
S BDMEVSIT=$G(APCDALVR("APCDVSIT"))
K APCDALVR
Q
TBF(A) ;EP - called from screen
I '$D(^AUTTHF(A,0)) Q 0
I $P(^AUTTHF(A,0),U,10)'="F" Q 0
I $P(^AUTTHF(A,0),U,13) Q 0
NEW B S B=$O(^AUTTHF("B","TB STATUS",0)) I 'B Q 0
I $P(^AUTTHF(A,0),U,3)'=B Q 0
Q 1
ENDS(A) ;EP - called from screen
I '$D(^AUTTHF(A,0)) Q 0
I $P(^AUTTHF(A,0),U,10)'="F" Q 0
I $P(^AUTTHF(A,0),U,13) Q 0
NEW B S B=$O(^AUTTHF("B","ELECTRONIC NICOTINE DELIV SYSTEM (ENDS)",0)) I 'B Q 0
I $P(^AUTTHF(A,0),U,3)'=B Q 0
Q 1
SMK(A) ;EP - called from screen on TOBACCO USE
I '$D(^AUTTHF(A,0)) Q 0
I $P(^AUTTHF(A,0),U,10)'="F" Q 0
I $P(^AUTTHF(A,0),U,13) Q 0
NEW B,C,D
S B=$O(^AUTTHF("B","TOBACCO",0))
S C=$O(^AUTTHF("B","TOBACCO (SMOKING)",0))
S D=$O(^AUTTHF("B","TOBACCO (SMOKELESS - CHEWING/DIP)",0))
S E=$O(^AUTTHF("B","TOBACCO (EXPOSURE)",0))
I $P(^AUTTHF(A,0),U,3)=B Q 1
I $P(^AUTTHF(A,0),U,3)=C Q 1
I $P(^AUTTHF(A,0),U,3)=D Q 1
I $P(^AUTTHF(A,0),U,3)=E Q 1
Q 0
;
SG(A) ;EP - called from dd
I '$D(^AUTTHF(A,0)) Q 0
I $P(^AUTTHF(A,0),U,10)'="F" Q 0
I $P(^AUTTHF(A,0),U,13) Q 0
NEW B S B=$O(^AUTTHF("B","DIABETES SELF MONITORING",0)) I 'B Q 0
I $P(^AUTTHF(A,0),U,3)'=B Q 0
Q 1
;
SGHF ;EP
K BDMEVSIT
I $P($G(^BDMEDMUP(BDMEDA,11)),U,7)="" Q
S BDMEDMDT=$S($P(BDMEREC1,U,16)]"":$P(BDMEREC1,U,16),1:DT)
S BDMEMTYP=$P(^BDMEDMUP(BDMEDA,11),U,7)
S BDMEMCAT=$P(^AUTTHF(BDMEMTYP,0),U,3)
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update self monitoring health factor." D ERR^BDMEDMUP(T) Q
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
I G S T="Already have a health factor of "_$P(^AUTTHF($P(^BDMEDMUP(BDMEDA,11),U,7),0),U)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(BDMEVSIT,0),U)) D ERR^BDMEDMUP(T) Q
K APCDALVR
S APCDALVR("APCDPAT")=BDMEDMPT
S APCDALVR("APCDVSIT")=BDMEVSIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"
S APCDALVR("APCDTHF")="`"_BDMEMTYP
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Health Factor Entry for Self Monitoring of Blood Glucose. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
;update health status
;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
;I BDMEHSE D Q
;.D ^XBFMK K DIADD
;.S DA=BDMEHSE,DIE="^AUPNHF(",DR=".01///`"_BDMEMTYP_";.03////"_DT D ^DIE
;.I $D(Y) S T="Error updating Health Status entry for Tobacco." D ERR^BDMEDMUP(T)
;.D ^XBFMK
;D ^XBFMK
;S X=BDMEMTYP,DIC("DR")=".02////"_BDMEDMPT_";.03////"_DT,DIC(0)="L",DIADD=1,DLAYGO=9000019,DIC="^AUPNHF(" D FILE^DICN
;I Y=-1 S T="Error adding health status entry for Tobacco." D ERR^BDMEDMUP(T)
D ^XBFMK K DIADD
Q
TBHF ;EP
K BDMEVSIT
I $P(BDMEREC,U,10)="" Q
S BDMEDMDT=$S($P(BDMEREC1,U,15)]"":$P(BDMEREC1,U,15),1:DT)
S BDMEMTYP=$P(BDMEREC,U,10)
S BDMEMCAT=$P(^AUTTHF(BDMEMTYP,0),U,3)
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update tb health factor." D ERR^BDMEDMUP(T) Q
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
I G S T="Already have a health factor of "_$P(^AUTTHF($P(BDMEREC,U,10),0),U)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(BDMEVSIT,0),U)) D ERR^BDMEDMUP(T) Q
K APCDALVR
S APCDALVR("APCDPAT")=BDMEDMPT
S APCDALVR("APCDVSIT")=BDMEVSIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"
S APCDALVR("APCDTHF")="`"_BDMEMTYP
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Health Factor Entry for TB. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
;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
;I BDMEHSE D Q
;.D ^XBFMK K DIADD
;.S DA=BDMEHSE,DIE="^AUPNHF(",DR=".01///`"_BDMEMTYP_";.03////"_DT D ^DIE
;.I $D(Y) S T="Error updating Health Status entry for TB." D ERR^BDMEDMUP(T)
;.D ^XBFMK
;D ^XBFMK
;S X=BDMEMTYP,DIC("DR")=".02////"_BDMEDMPT_";.03////"_DT,DIC(0)="L",DIADD=1,DLAYGO=9000019,DIC="^AUPNHF(" D FILE^DICN
;I Y=-1 S T="Error adding health status entry for TB." D ERR^BDMEDMUP(T)
D ^XBFMK K DIADD,DLAYGO
Q
ENDSHF ;EP
K BDMEVSIT
I $P(BDMEREC1,U,22)="" Q
S BDMEDMDT=$S($P(BDMEREC1,U,23)]"":$P(BDMEREC1,U,23),1:DT)
S BDMEMTYP=$P(BDMEREC1,U,22)
S BDMEMCAT=$P(^AUTTHF(BDMEMTYP,0),U,3)
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update ENDS health factor." D ERR^BDMEDMUP(T) Q
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
I G S T="Already have a health factor of "_$P(^AUTTHF($P(BDMEREC1,U,22),0),U)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(BDMEVSIT,0),U)) D ERR^BDMEDMUP(T) Q
K APCDALVR
S APCDALVR("APCDPAT")=BDMEDMPT
S APCDALVR("APCDVSIT")=BDMEVSIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"
S APCDALVR("APCDTHF")="`"_BDMEMTYP
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Health Factor Entry for ENDS. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
D ^XBFMK K DIADD,DLAYGO
Q
BDMEDMU2 ; IHS/CMI/LAB - EDITS FOR AUPNVSIT (VISIT:9000010) 24-MAY-1993 ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**7,10**;JUN 14, 2007;Build 12
+2 ;
PPD ;EP
+1 KILL BDMEVSIT
+2 IF $PIECE($GET(^BDMEDMUP(BDMEDA,11)),U,1)=""
QUIT
+3 ;I $P($G(^BDMEDMUP(BDMEDA,11)),U,2)="" Q
+4 SET BDMEDMDT=$PIECE($GET(^BDMEDMUP(BDMEDA,11)),U,1)
+5 SET BDMEMTYP=$ORDER(^AUTTSK("B","PPD",0))
+6 ;get event visit
DO EVSIT^BDMEDMUP
+7 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update PPD."
DO ERR^BDMEDMUP(T)
QUIT
+8 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVSK("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVSK(X,0),U)=BDMEMTYP
SET G=1
+9 IF G
SET T="Already have a PPD on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(BDMEVSIT,0),U))
DO ERR^BDMEDMUP(T)
QUIT
+10 KILL APCDALVR
+11 SET APCDALVR("APCDPAT")=BDMEDMPT
+12 SET APCDALVR("APCDVSIT")=BDMEVSIT
+13 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.12 (ADD)]"
+14 SET APCDALVR("APCDTSK")="`"_BDMEMTYP
+15 SET APCDALVR("APCDTREA")=$PIECE($GET(^BDMEDMUP(BDMEDA,11)),U,2)
+16 DO ^APCDALVR
+17 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Skin Test Entry for PPD. PCC not updated."
DO ERR^BDMEDMUP(T)
+18 KILL APCDALVR
+19 QUIT
EKG ;EP
+1 KILL BDMEVSIT
+2 IF $PIECE($GET(^BDMEDMUP(BDMEDA,11)),U,3)=""
QUIT
+3 SET BDMEDMDT=$PIECE($GET(^BDMEDMUP(BDMEDA,11)),U,3)
+4 SET BDMEMTYP=$ORDER(^AUTTDXPR("B","ECG SUMMARY",0))
+5 SET BDMEDMRE=$PIECE(^BDMEDMUP(BDMEDA,0),U,23)
+6 ;get event visit
DO EVSIT^BDMEDMUP
+7 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update EKG."
DO ERR^BDMEDMUP(T)
QUIT
+8 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVDXP("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVDXP(X,0),U)=BDMEMTYP
SET G=1
+9 IF G
SET T="Already have a EKG on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(BDMEVSIT,0),U))
DO ERR^BDMEDMUP(T)
QUIT
+10 KILL APCDALVR
+11 SET APCDALVR("APCDPAT")=BDMEDMPT
+12 SET APCDALVR("APCDVSIT")=BDMEVSIT
+13 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.21 (ADD)]"
+14 SET APCDALVR("APCDTDXR")="`"_BDMEMTYP
+15 SET APCDALVR("APCDTRQ")=BDMEDMRE
+16 DO ^APCDALVR
+17 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Diagnostic Procedure Entry for EKG. PCC not updated."
DO ERR^BDMEDMUP(T)
+18 KILL APCDALVR
+19 QUIT
LAB ;EP
+1 ;no educ entered
IF '$DATA(^BDMEDMUP(BDMEDA,13))
QUIT
+2 SET BDMEEDU=0
FOR
SET BDMEEDU=$ORDER(^BDMEDMUP(BDMEDA,13,BDMEEDU))
IF BDMEEDU'=+BDMEEDU
QUIT
DO LAB1
+3 DO ^XBFMK
+4 KILL APCDALVR
+5 QUIT
LAB1 ;
+1 IF $PIECE(^BDMEDMUP(BDMEDA,13,BDMEEDU,0),U)=""
QUIT
+2 IF $PIECE(^BDMEDMUP(BDMEDA,13,BDMEEDU,0),U,2)=""
QUIT
+3 SET BDMEDMDT=$PIECE(^BDMEDMUP(BDMEDA,13,BDMEEDU,0),U,2)
+4 SET BDMEMTYP=$PIECE(^BDMEDMUP(BDMEDA,13,BDMEEDU,0),U)
+5 ;get event visit
DO EVSIT^BDMEDMUP
+6 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update lab ."
DO ERR^BDMEDMUP(T)
QUIT
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVLAB("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVLAB(X,0),U)=BDMEMTYP
SET G=1
+8 IF G
SET T="Already have a "_$PIECE(^LAB(60,BDMEMTYP,0),U)_" on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(BDMEVSIT,0),U))
DO ERR^BDMEDMUP(T)
QUIT
+9 KILL APCDALVR
+10 SET APCDALVR("APCDPAT")=BDMEDMPT
+11 SET APCDALVR("APCDVSIT")=BDMEVSIT
+12 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.09 (ADD)]"
+13 SET APCDALVR("APCDTLAB")="`"_BDMEMTYP
+14 SET APCDALVR("APCDTRES")=$PIECE($GET(^BDMEDMUP(BDMEDA,13,BDMEEDU,0)),U,3)
+15 SET APCDALVR("APCDTUNI")=$PIECE($GET(^BDMEDMUP(BDMEDA,13,BDMEEDU,0)),U,4)
+16 DO ^APCDALVR
+17 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Lab Entry for lab test. PCC not updated."
DO ERR^BDMEDMUP(T)
+18 KILL APCDALVR
+19 QUIT
EDUC ;EP - add v educ to pcc
+1 ;no educ entered
IF '$DATA(^BDMEDMUP(BDMEDA,12))
QUIT
+2 SET BDMEEDU=0
FOR
SET BDMEEDU=$ORDER(^BDMEDMUP(BDMEDA,12,BDMEEDU))
IF BDMEEDU'=+BDMEEDU
QUIT
DO EDUC1
+3 DO ^XBFMK
+4 KILL APCDALVR
+5 QUIT
EDUC1 ;
+1 IF $PIECE(^BDMEDMUP(BDMEDA,12,BDMEEDU,0),U)=""
QUIT
+2 IF $PIECE(^BDMEDMUP(BDMEDA,12,BDMEEDU,0),U,2)=""
QUIT
+3 SET BDMEDMDT=$PIECE(^BDMEDMUP(BDMEDA,12,BDMEEDU,0),U,2)
+4 SET BDMEMTYP=$PIECE(^BDMEDMUP(BDMEDA,12,BDMEEDU,0),U)
+5 ;get event visit
DO EVSIT^BDMEDMUP
+6 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update pt education topic."
DO ERR^BDMEDMUP(T)
QUIT
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVPED("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVPED(X,0),U)=BDMEMTYP
SET G=1
+8 IF G
SET T="Already have a "_$PIECE(^AUTTEDT(BDMEMTYP,0),U)_" on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(BDMEVSIT,0),U))
DO ERR^BDMEDMUP(T)
QUIT
+9 KILL APCDALVR
+10 SET APCDALVR("APCDPAT")=BDMEDMPT
+11 SET APCDALVR("APCDVSIT")=BDMEVSIT
+12 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.16 (ADD)]"
+13 SET APCDALVR("APCDTTOP")="`"_BDMEMTYP
+14 SET APCDALVR("APCDTLOU")=$PIECE($GET(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,3)
+15 IF $PIECE(^DD(9000010.16,.05,0),U,2)[200
SET APCDALVR("APCDTPRO")=$SELECT($PIECE($GET(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,4):"`"_$PIECE(^BDMEDMUP(BDMEDA,12,BDMEEDU,0),U,4),1:"")
+16 IF $PIECE(^DD(9000010.16,.05,0),U,2)[6
Begin DoDot:1
+17 IF $PIECE($GET(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,4)=""
SET APCDALVR("APCDTPRO")=""
QUIT
+18 SET X=$PIECE($GET(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,4)
+19 SET X=$PIECE($GET(^VA(200,X,0)),U,16)
+20 IF X
SET APCDALVR("APCDTPRO")="`"_X
End DoDot:1
+21 SET APCDALVR("APCDTIG")=$PIECE($GET(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,6)
+22 SET APCDALVR("APCDTMIN")=$PIECE($GET(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,7)
+23 SET APCDALVR("APCDTOBJ")=$PIECE($GET(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,5)
+24 SET APCDALVR("APCDTBC")=$PIECE($GET(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,8)
+25 SET APCDALVR("APCDTRTL")=$PIECE($GET(^BDMEDMUP(BDMEDA,12,BDMEEDU,0)),U,9)
+26 DO ^APCDALVR
+27 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Patient Ed Entry for Education topic. PCC not updated."
DO ERR^BDMEDMUP(T)
+28 KILL APCDALVR
+29 QUIT
MED ;EP
+1 ;no med entered
IF '$DATA(^BDMEDMUP(BDMEDA,14))
QUIT
+2 SET BDMEEDU=0
FOR
SET BDMEEDU=$ORDER(^BDMEDMUP(BDMEDA,14,BDMEEDU))
IF BDMEEDU'=+BDMEEDU
QUIT
DO MED1
+3 DO ^XBFMK
+4 KILL APCDALVR
+5 QUIT
MED1 ;
+1 IF $PIECE(^BDMEDMUP(BDMEDA,14,BDMEEDU,0),U)=""
QUIT
+2 IF $PIECE(^BDMEDMUP(BDMEDA,14,BDMEEDU,0),U,2)=""
QUIT
+3 SET BDMEDMDT=$PIECE(^BDMEDMUP(BDMEDA,14,BDMEEDU,0),U,2)
+4 SET BDMEMTYP=$PIECE(^BDMEDMUP(BDMEDA,14,BDMEEDU,0),U)
+5 ;get event visit
DO EVSIT^BDMEDMUP
+6 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update lab ."
DO ERR^BDMEDMUP(T)
QUIT
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVMED("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVMED(X,0),U)=BDMEMTYP
SET G=1
+8 IF G
SET T="Already have a "_$PIECE(^PSDRUG(BDMEMTYP,0),U)_" on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(BDMEVSIT,0),U))
DO ERR^BDMEDMUP(T)
QUIT
+9 KILL APCDALVR
+10 SET APCDALVR("APCDPAT")=BDMEDMPT
+11 SET APCDALVR("APCDVSIT")=BDMEVSIT
+12 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.14 (ADD)]"
+13 SET APCDALVR("APCDTRX")="`"_BDMEMTYP
+14 SET APCDALVR("APCDTQTY")=$PIECE($GET(^BDMEDMUP(BDMEDA,14,BDMEEDU,0)),U,3)
+15 SET APCDALVR("APCDTSIQ")=$PIECE($GET(^BDMEDMUP(BDMEDA,14,BDMEEDU,0)),U,4)
+16 DO ^APCDALVR
+17 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Medication Entry for lab test. PCC not updated."
DO ERR^BDMEDMUP(T)
+18 KILL APCDALVR
+19 QUIT
BP ;EP
+1 KILL BDMEVSIT
+2 IF $PIECE(BDMEREC,U,19)=""
QUIT
+3 IF $PIECE(BDMEREC,U,20)=""
QUIT
+4 SET BDMEDMDT=$PIECE(BDMEREC,U,19)
+5 SET BDMEMTYP=$ORDER(^AUTTMSR("B","BP",0))
+6 ;get event visit
DO EVSIT^BDMEDMUP
+7 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update height."
DO ERR^BDMEDMUP(T)
QUIT
+8 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVMSR("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVMSR(X,0),U)=BDMEMTYP
IF $PIECE(^AUPNVMSR(X,0),U,4)=$PIECE(BDMEREC,U,20)
SET G=1
+9 IF G
SET T="Already have a height of "_$PIECE(BDMEREC,U,20)_" on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(BDMEVSIT,0),U))
DO ERR^BDMEDMUP(T)
QUIT
+10 KILL APCDALVR
+11 SET APCDALVR("APCDPAT")=BDMEDMPT
+12 SET APCDALVR("APCDVSIT")=BDMEVSIT
+13 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.01 (ADD)]"
+14 SET APCDALVR("APCDTTYP")="`"_BDMEMTYP
+15 SET APCDALVR("APCDTVAL")=$PIECE(BDMEREC,U,20)
+16 DO ^APCDALVR
+17 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Measurement Entry for BP. PCC not updated."
DO ERR^BDMEDMUP(T)
+18 KILL APCDALVR
+19 QUIT
BI() ;EP- check to see if using new imm package or not 1/5/1999 IHS/CMI/LAB
+1 QUIT $SELECT($ORDER(^AUTTIMM(0))<100:0,1:1)
+2 ;end new subrotuine CMI/TUCSON/LAB
EVSIT ;get/create event visit
+1 KILL BDMEVSIT
+2 KILL APCDALVR
+3 SET APCDALVR("APCDAUTO")=""
+4 SET APCDALVR("APCDPAT")=BDMEDMPT
+5 SET APCDALVR("APCDCAT")="E"
+6 SET APCDALVR("APCDLOC")=DUZ(2)
+7 SET APCDALVR("APCDTYPE")=$SELECT($PIECE($GET(^APCCCTRL(DUZ(2),0)),U,4)]"":$PIECE(^APCCCTRL(DUZ(2),0),U,4),1:"O")
+8 SET APCDALVR("APCDDATE")=BDMEDMDT_".12"
+9 DO ^APCDALV
+10 SET BDMEVSIT=$GET(APCDALVR("APCDVSIT"))
+11 KILL APCDALVR
+12 QUIT
TBF(A) ;EP - called from screen
+1 IF '$DATA(^AUTTHF(A,0))
QUIT 0
+2 IF $PIECE(^AUTTHF(A,0),U,10)'="F"
QUIT 0
+3 IF $PIECE(^AUTTHF(A,0),U,13)
QUIT 0
+4 NEW B
SET B=$ORDER(^AUTTHF("B","TB STATUS",0))
IF 'B
QUIT 0
+5 IF $PIECE(^AUTTHF(A,0),U,3)'=B
QUIT 0
+6 QUIT 1
ENDS(A) ;EP - called from screen
+1 IF '$DATA(^AUTTHF(A,0))
QUIT 0
+2 IF $PIECE(^AUTTHF(A,0),U,10)'="F"
QUIT 0
+3 IF $PIECE(^AUTTHF(A,0),U,13)
QUIT 0
+4 NEW B
SET B=$ORDER(^AUTTHF("B","ELECTRONIC NICOTINE DELIV SYSTEM (ENDS)",0))
IF 'B
QUIT 0
+5 IF $PIECE(^AUTTHF(A,0),U,3)'=B
QUIT 0
+6 QUIT 1
SMK(A) ;EP - called from screen on TOBACCO USE
+1 IF '$DATA(^AUTTHF(A,0))
QUIT 0
+2 IF $PIECE(^AUTTHF(A,0),U,10)'="F"
QUIT 0
+3 IF $PIECE(^AUTTHF(A,0),U,13)
QUIT 0
+4 NEW B,C,D
+5 SET B=$ORDER(^AUTTHF("B","TOBACCO",0))
+6 SET C=$ORDER(^AUTTHF("B","TOBACCO (SMOKING)",0))
+7 SET D=$ORDER(^AUTTHF("B","TOBACCO (SMOKELESS - CHEWING/DIP)",0))
+8 SET E=$ORDER(^AUTTHF("B","TOBACCO (EXPOSURE)",0))
+9 IF $PIECE(^AUTTHF(A,0),U,3)=B
QUIT 1
+10 IF $PIECE(^AUTTHF(A,0),U,3)=C
QUIT 1
+11 IF $PIECE(^AUTTHF(A,0),U,3)=D
QUIT 1
+12 IF $PIECE(^AUTTHF(A,0),U,3)=E
QUIT 1
+13 QUIT 0
+14 ;
SG(A) ;EP - called from dd
+1 IF '$DATA(^AUTTHF(A,0))
QUIT 0
+2 IF $PIECE(^AUTTHF(A,0),U,10)'="F"
QUIT 0
+3 IF $PIECE(^AUTTHF(A,0),U,13)
QUIT 0
+4 NEW B
SET B=$ORDER(^AUTTHF("B","DIABETES SELF MONITORING",0))
IF 'B
QUIT 0
+5 IF $PIECE(^AUTTHF(A,0),U,3)'=B
QUIT 0
+6 QUIT 1
+7 ;
SGHF ;EP
+1 KILL BDMEVSIT
+2 IF $PIECE($GET(^BDMEDMUP(BDMEDA,11)),U,7)=""
QUIT
+3 SET BDMEDMDT=$SELECT($PIECE(BDMEREC1,U,16)]"":$PIECE(BDMEREC1,U,16),1:DT)
+4 SET BDMEMTYP=$PIECE(^BDMEDMUP(BDMEDA,11),U,7)
+5 SET BDMEMCAT=$PIECE(^AUTTHF(BDMEMTYP,0),U,3)
+6 ;get event visit
DO EVSIT^BDMEDMUP
+7 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update self monitoring health factor."
DO ERR^BDMEDMUP(T)
QUIT
+8 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVHF("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVHF(X,0),U)=BDMEMTYP
SET G=1
+9 IF G
SET T="Already have a health factor of "_$PIECE(^AUTTHF($PIECE(^BDMEDMUP(BDMEDA,11),U,7),0),U)_" on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(BDMEVSIT,0),U))
DO ERR^BDMEDMUP(T)
QUIT
+10 KILL APCDALVR
+11 SET APCDALVR("APCDPAT")=BDMEDMPT
+12 SET APCDALVR("APCDVSIT")=BDMEVSIT
+13 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"
+14 SET APCDALVR("APCDTHF")="`"_BDMEMTYP
+15 DO ^APCDALVR
+16 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Health Factor Entry for Self Monitoring of Blood Glucose. PCC not updated."
DO ERR^BDMEDMUP(T)
+17 KILL APCDALVR
+18 ;update health status
+19 ;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
+20 ;I BDMEHSE D Q
+21 ;.D ^XBFMK K DIADD
+22 ;.S DA=BDMEHSE,DIE="^AUPNHF(",DR=".01///`"_BDMEMTYP_";.03////"_DT D ^DIE
+23 ;.I $D(Y) S T="Error updating Health Status entry for Tobacco." D ERR^BDMEDMUP(T)
+24 ;.D ^XBFMK
+25 ;D ^XBFMK
+26 ;S X=BDMEMTYP,DIC("DR")=".02////"_BDMEDMPT_";.03////"_DT,DIC(0)="L",DIADD=1,DLAYGO=9000019,DIC="^AUPNHF(" D FILE^DICN
+27 ;I Y=-1 S T="Error adding health status entry for Tobacco." D ERR^BDMEDMUP(T)
+28 DO ^XBFMK
KILL DIADD
+29 QUIT
TBHF ;EP
+1 KILL BDMEVSIT
+2 IF $PIECE(BDMEREC,U,10)=""
QUIT
+3 SET BDMEDMDT=$SELECT($PIECE(BDMEREC1,U,15)]"":$PIECE(BDMEREC1,U,15),1:DT)
+4 SET BDMEMTYP=$PIECE(BDMEREC,U,10)
+5 SET BDMEMCAT=$PIECE(^AUTTHF(BDMEMTYP,0),U,3)
+6 ;get event visit
DO EVSIT^BDMEDMUP
+7 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update tb health factor."
DO ERR^BDMEDMUP(T)
QUIT
+8 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVHF("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVHF(X,0),U)=BDMEMTYP
SET G=1
+9 IF G
SET T="Already have a health factor of "_$PIECE(^AUTTHF($PIECE(BDMEREC,U,10),0),U)_" on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(BDMEVSIT,0),U))
DO ERR^BDMEDMUP(T)
QUIT
+10 KILL APCDALVR
+11 SET APCDALVR("APCDPAT")=BDMEDMPT
+12 SET APCDALVR("APCDVSIT")=BDMEVSIT
+13 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"
+14 SET APCDALVR("APCDTHF")="`"_BDMEMTYP
+15 DO ^APCDALVR
+16 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Health Factor Entry for TB. PCC not updated."
DO ERR^BDMEDMUP(T)
+17 KILL APCDALVR
+18 ;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
+19 ;I BDMEHSE D Q
+20 ;.D ^XBFMK K DIADD
+21 ;.S DA=BDMEHSE,DIE="^AUPNHF(",DR=".01///`"_BDMEMTYP_";.03////"_DT D ^DIE
+22 ;.I $D(Y) S T="Error updating Health Status entry for TB." D ERR^BDMEDMUP(T)
+23 ;.D ^XBFMK
+24 ;D ^XBFMK
+25 ;S X=BDMEMTYP,DIC("DR")=".02////"_BDMEDMPT_";.03////"_DT,DIC(0)="L",DIADD=1,DLAYGO=9000019,DIC="^AUPNHF(" D FILE^DICN
+26 ;I Y=-1 S T="Error adding health status entry for TB." D ERR^BDMEDMUP(T)
+27 DO ^XBFMK
KILL DIADD,DLAYGO
+28 QUIT
ENDSHF ;EP
+1 KILL BDMEVSIT
+2 IF $PIECE(BDMEREC1,U,22)=""
QUIT
+3 SET BDMEDMDT=$SELECT($PIECE(BDMEREC1,U,23)]"":$PIECE(BDMEREC1,U,23),1:DT)
+4 SET BDMEMTYP=$PIECE(BDMEREC1,U,22)
+5 SET BDMEMCAT=$PIECE(^AUTTHF(BDMEMTYP,0),U,3)
+6 ;get event visit
DO EVSIT^BDMEDMUP
+7 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update ENDS health factor."
DO ERR^BDMEDMUP(T)
QUIT
+8 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVHF("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVHF(X,0),U)=BDMEMTYP
SET G=1
+9 IF G
SET T="Already have a health factor of "_$PIECE(^AUTTHF($PIECE(BDMEREC1,U,22),0),U)_" on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(BDMEVSIT,0),U))
DO ERR^BDMEDMUP(T)
QUIT
+10 KILL APCDALVR
+11 SET APCDALVR("APCDPAT")=BDMEDMPT
+12 SET APCDALVR("APCDVSIT")=BDMEVSIT
+13 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"
+14 SET APCDALVR("APCDTHF")="`"_BDMEMTYP
+15 DO ^APCDALVR
+16 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Health Factor Entry for ENDS. PCC not updated."
DO ERR^BDMEDMUP(T)
+17 KILL APCDALVR
+18 DO ^XBFMK
KILL DIADD,DLAYGO
+19 QUIT
