BDMEDMU2.m

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))