APCDDMU2.m

APCDDMU2 ; IHS/CMI/LAB - EDITS FOR AUPNVSIT (VISIT:9000010) 24-MAY-1993 ;

 ;;2.0;IHS PCC SUITE;**4,5**;MAY 14, 2009

 ;

PPD ;EP

 K APCDVSIT

 I $P($G(^APCDDMUP(APCDDA,11)),U,1)="" Q

 ;I $P($G(^APCDDMUP(APCDDA,11)),U,2)="" Q

 S APCDDMDT=$P($G(^APCDDMUP(APCDDA,11)),U,1)

 S APCDMTYP=$O(^AUTTSK("B","PPD",0))

 D EVSIT^APCDDMUP ;get event visit

 I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update PPD." D ERR^APCDDMUP(T) Q

 S (X,G)=0 F  S X=$O(^AUPNVSK("AD",APCDVSIT,X)) Q:X'=+X!(G)  I $P(^AUPNVSK(X,0),U)=APCDMTYP S G=1

 I G S T="Already have a PPD  on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(APCDVSIT,0),U)) D ERR^APCDDMUP(T) Q

 K APCDALVR

 S APCDALVR("APCDPAT")=APCDDMPT

 S APCDALVR("APCDVSIT")=APCDVSIT

 S APCDALVR("APCDATMP")="[APCDALVR 9000010.12 (ADD)]"

 S APCDALVR("APCDTSK")="`"_APCDMTYP

 S APCDALVR("APCDTREA")=$P($G(^APCDDMUP(APCDDA,11)),U,2)

 D ^APCDALVR

 I $D(APCDALVR("APCDAFLG")) S T="Error creating V Skin Test Entry for PPD.  PCC not updated." D ERR^APCDDMUP(T)

 K APCDALVR

 Q

EKG ;EP

 K APCDVSIT

 I $P($G(^APCDDMUP(APCDDA,11)),U,3)="" Q

 S APCDDMDT=$P($G(^APCDDMUP(APCDDA,11)),U,3)

 S APCDMTYP=$O(^AUTTDXPR("B","ECG SUMMARY",0))

 S APCDDMRE=$P(^APCDDMUP(APCDDA,0),U,23)

 D EVSIT^APCDDMUP ;get event visit

 I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update EKG." D ERR^APCDDMUP(T) Q

 S (X,G)=0 F  S X=$O(^AUPNVDXP("AD",APCDVSIT,X)) Q:X'=+X!(G)  I $P(^AUPNVDXP(X,0),U)=APCDMTYP S G=1

 I G S T="Already have a EKG on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(APCDVSIT,0),U)) D ERR^APCDDMUP(T) Q

 K APCDALVR

 S APCDALVR("APCDPAT")=APCDDMPT

 S APCDALVR("APCDVSIT")=APCDVSIT

 S APCDALVR("APCDATMP")="[APCDALVR 9000010.21 (ADD)]"

 S APCDALVR("APCDTDXR")="`"_APCDMTYP

 S APCDALVR("APCDTRQ")=APCDDMRE

 D ^APCDALVR

 I $D(APCDALVR("APCDAFLG")) S T="Error creating V Diagnostic Procedure Entry for EKG.  PCC not updated." D ERR^APCDDMUP(T)

 K APCDALVR

 Q

LAB ;EP

 I '$D(^APCDDMUP(APCDDA,13)) Q  ;no educ entered

 S APCDEDU=0 F  S APCDEDU=$O(^APCDDMUP(APCDDA,13,APCDEDU)) Q:APCDEDU'=+APCDEDU  D LAB1

 D ^XBFMK

 K APCDALVR

 Q

LAB1 ;

 I $P(^APCDDMUP(APCDDA,13,APCDEDU,0),U)="" Q

 I $P(^APCDDMUP(APCDDA,13,APCDEDU,0),U,2)="" Q

 S APCDDMDT=$P(^APCDDMUP(APCDDA,13,APCDEDU,0),U,2)

 S APCDMTYP=$P(^APCDDMUP(APCDDA,13,APCDEDU,0),U)

 D EVSIT^APCDDMUP ;get event visit

 I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update lab ." D ERR^APCDDMUP(T) Q

 S (X,G)=0 F  S X=$O(^AUPNVLAB("AD",APCDVSIT,X)) Q:X'=+X!(G)  I $P(^AUPNVLAB(X,0),U)=APCDMTYP S G=1

 I G S T="Already have a  "_$P(^LAB(60,APCDMTYP,0),U)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(APCDVSIT,0),U)) D ERR^APCDDMUP(T) Q

 K APCDALVR

 S APCDALVR("APCDPAT")=APCDDMPT

 S APCDALVR("APCDVSIT")=APCDVSIT

 S APCDALVR("APCDATMP")="[APCDALVR 9000010.09 (ADD)]"

 S APCDALVR("APCDTLAB")="`"_APCDMTYP

 S APCDALVR("APCDTRES")=$P($G(^APCDDMUP(APCDDA,13,APCDEDU,0)),U,3)

 D ^APCDALVR

 I $D(APCDALVR("APCDAFLG")) S T="Error creating V Lab Entry for lab test.  PCC not updated." D ERR^APCDDMUP(T)

 K APCDALVR

 Q

EDUC ;EP - add v educ to pcc

 I '$D(^APCDDMUP(APCDDA,12)) Q  ;no educ entered

 S APCDEDU=0 F  S APCDEDU=$O(^APCDDMUP(APCDDA,12,APCDEDU)) Q:APCDEDU'=+APCDEDU  D EDUC1

 D ^XBFMK

 K APCDALVR

 Q

EDUC1 ;

 I $P(^APCDDMUP(APCDDA,12,APCDEDU,0),U)="" Q

 I $P(^APCDDMUP(APCDDA,12,APCDEDU,0),U,2)="" Q

 S APCDDMDT=$P(^APCDDMUP(APCDDA,12,APCDEDU,0),U,2)

 S APCDMTYP=$P(^APCDDMUP(APCDDA,12,APCDEDU,0),U)

 D EVSIT^APCDDMUP ;get event visit

 I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update pt education topic." D ERR^APCDDMUP(T) Q

 S (X,G)=0 F  S X=$O(^AUPNVPED("AD",APCDVSIT,X)) Q:X'=+X!(G)  I $P(^AUPNVPED(X,0),U)=APCDMTYP S G=1

 I G S T="Already have a  "_$P(^AUTTEDT(APCDMTYP,0),U)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(APCDVSIT,0),U)) D ERR^APCDDMUP(T) Q

 K APCDALVR

 S APCDALVR("APCDPAT")=APCDDMPT

 S APCDALVR("APCDVSIT")=APCDVSIT

 S APCDALVR("APCDATMP")="[APCDALVR 9000010.16 (ADD)]"

 S APCDALVR("APCDTTOP")="`"_APCDMTYP

 S APCDALVR("APCDTLOU")=$P($G(^APCDDMUP(APCDDA,12,APCDEDU,0)),U,3)

 I $P(^DD(9000010.16,.05,0),U,2)[200 S APCDALVR("APCDTPRO")=$S($P($G(^APCDDMUP(APCDDA,12,APCDEDU,0)),U,4):"`"_$P(^APCDDMUP(APCDDA,12,APCDEDU,0),U,4),1:"")

 I $P(^DD(9000010.16,.05,0),U,2)[6 D

 .I $P($G(^APCDDMUP(APCDDA,12,APCDEDU,0)),U,4)="" S APCDALVR("APCDTPRO")="" Q

 .S X=$P($G(^APCDDMUP(APCDDA,12,APCDEDU,0)),U,4)

 .S X=$P($G(^VA(200,X,0)),U,16)

 .I X S APCDALVR("APCDTPRO")="`"_X

 S APCDALVR("APCDTIG")=$P($G(^APCDDMUP(APCDDA,12,APCDEDU,0)),U,6)

 S APCDALVR("APCDTMIN")=$P($G(^APCDDMUP(APCDDA,12,APCDEDU,0)),U,7)

 S APCDALVR("APCDTOBJ")=$P($G(^APCDDMUP(APCDDA,12,APCDEDU,0)),U,5)

 S APCDALVR("APCDTBC")=$P($G(^APCDDMUP(APCDDA,12,APCDEDU,0)),U,8)

 S APCDALVR("APCDTRTL")=$P($G(^APCDDMUP(APCDDA,12,APCDEDU,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^APCDDMUP(T)

 K APCDALVR

 Q

MED ;EP

 I '$D(^APCDDMUP(APCDDA,14)) Q  ;no med entered

 S APCDEDU=0 F  S APCDEDU=$O(^APCDDMUP(APCDDA,14,APCDEDU)) Q:APCDEDU'=+APCDEDU  D MED1

 D ^XBFMK

 K APCDALVR

 Q

MED1 ;

 I $P(^APCDDMUP(APCDDA,14,APCDEDU,0),U)="" Q

 I $P(^APCDDMUP(APCDDA,14,APCDEDU,0),U,2)="" Q

 S APCDDMDT=$P(^APCDDMUP(APCDDA,14,APCDEDU,0),U,2)

 S APCDMTYP=$P(^APCDDMUP(APCDDA,14,APCDEDU,0),U)

 D EVSIT^APCDDMUP ;get event visit

 I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update lab ." D ERR^APCDDMUP(T) Q

 S (X,G)=0 F  S X=$O(^AUPNVMED("AD",APCDVSIT,X)) Q:X'=+X!(G)  I $P(^AUPNVMED(X,0),U)=APCDMTYP S G=1

 I G S T="Already have a  "_$P(^PSDRUG(APCDMTYP,0),U)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(APCDVSIT,0),U)) D ERR^APCDDMUP(T) Q

 K APCDALVR

 S APCDALVR("APCDPAT")=APCDDMPT

 S APCDALVR("APCDVSIT")=APCDVSIT

 S APCDALVR("APCDATMP")="[APCDALVR 9000010.14 (ADD)]"

 S APCDALVR("APCDTRX")="`"_APCDMTYP

 S APCDALVR("APCDTQTY")=$P($G(^APCDDMUP(APCDDA,14,APCDEDU,0)),U,3)

 S APCDALVR("APCDTSIQ")=$P($G(^APCDDMUP(APCDDA,14,APCDEDU,0)),U,4)

 D ^APCDALVR

 I $D(APCDALVR("APCDAFLG")) S T="Error creating V Medication Entry for lab test.  PCC not updated." D ERR^APCDDMUP(T)

 K APCDALVR

 Q

BP ;EP

 K APCDVSIT

 I $P(APCDREC,U,19)="" Q

 I $P(APCDREC,U,20)="" Q

 S APCDDMDT=$P(APCDREC,U,19)

 S APCDMTYP=$O(^AUTTMSR("B","BP",0))

 D EVSIT^APCDDMUP ;get event visit

 I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update height." D ERR^APCDDMUP(T) Q

 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,20) S G=1

 I G S T="Already have a height of "_$P(APCDREC,U,20)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(APCDVSIT,0),U)) D ERR^APCDDMUP(T) Q

 K APCDALVR

 S APCDALVR("APCDPAT")=APCDDMPT

 S APCDALVR("APCDVSIT")=APCDVSIT

 S APCDALVR("APCDATMP")="[APCDALVR 9000010.01 (ADD)]"

 S APCDALVR("APCDTTYP")="`"_APCDMTYP

 S APCDALVR("APCDTVAL")=$P(APCDREC,U,20)

 D ^APCDALVR

 I $D(APCDALVR("APCDAFLG")) S T="Error creating V Measurement Entry for BP.  PCC not updated." D ERR^APCDDMUP(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 APCDVSIT

 K APCDALVR

 S APCDALVR("APCDAUTO")=""

 S APCDALVR("APCDPAT")=APCDDMPT

 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")=APCDDMDT_".12"

 D ^APCDALV

 S APCDVSIT=$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

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 APCDVSIT

 I $P($G(^APCDDMUP(APCDDA,11)),U,7)="" Q

 S APCDDMDT=$S($P(APCDREC1,U,16)]"":$P(APCDREC1,U,16),1:DT)

 S APCDMTYP=$P(^APCDDMUP(APCDDA,11),U,7)

 S APCDMCAT=$P(^AUTTHF(APCDMTYP,0),U,3)

 D EVSIT^APCDDMUP ;get event visit

 I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update self monitoring health factor." D ERR^APCDDMUP(T) Q

 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

 I G S T="Already have a health factor of "_$P(^AUTTHF($P(^APCDDMUP(APCDDA,11),U,7),0),U)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(APCDVSIT,0),U)) D ERR^APCDDMUP(T) Q

 K APCDALVR

 S APCDALVR("APCDPAT")=APCDDMPT

 S APCDALVR("APCDVSIT")=APCDVSIT

 S APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"

 S APCDALVR("APCDTHF")="`"_APCDMTYP

 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^APCDDMUP(T)

 K APCDALVR

 ;update health status

 ;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

 ;I APCDHSE D  Q

 ;.D ^XBFMK K DIADD

 ;.S DA=APCDHSE,DIE="^AUPNHF(",DR=".01///`"_APCDMTYP_";.03////"_DT D ^DIE

 ;.I $D(Y) S T="Error updating Health Status entry for Tobacco." D ERR^APCDDMUP(T)

 ;.D ^XBFMK

 ;D ^XBFMK

 ;S X=APCDMTYP,DIC("DR")=".02////"_APCDDMPT_";.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^APCDDMUP(T)

 D ^XBFMK K DIADD

 Q

TBHF ;EP

 K APCDVSIT

 I $P(APCDREC,U,10)="" Q

 S APCDDMDT=$S($P(APCDREC1,U,15)]"":$P(APCDREC1,U,15),1:DT)

 S APCDMTYP=$P(APCDREC,U,10)

 S APCDMCAT=$P(^AUTTHF(APCDMTYP,0),U,3)

 D EVSIT^APCDDMUP ;get event visit

 I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update tb health factor." D ERR^APCDDMUP(T) Q

 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

 I G S T="Already have a health factor of "_$P(^AUTTHF($P(APCDREC,U,10),0),U)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(APCDVSIT,0),U)) D ERR^APCDDMUP(T) Q

 K APCDALVR

 S APCDALVR("APCDPAT")=APCDDMPT

 S APCDALVR("APCDVSIT")=APCDVSIT

 S APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"

 S APCDALVR("APCDTHF")="`"_APCDMTYP

 D ^APCDALVR

 I $D(APCDALVR("APCDAFLG")) S T="Error creating V Health Factor Entry for TB.  PCC not updated." D ERR^APCDDMUP(T)

 K APCDALVR

 ;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

 ;I APCDHSE D  Q

 ;.D ^XBFMK K DIADD

 ;.S DA=APCDHSE,DIE="^AUPNHF(",DR=".01///`"_APCDMTYP_";.03////"_DT D ^DIE

 ;.I $D(Y) S T="Error updating Health Status entry for TB." D ERR^APCDDMUP(T)

 ;.D ^XBFMK

 ;D ^XBFMK

 ;S X=APCDMTYP,DIC("DR")=".02////"_APCDDMPT_";.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^APCDDMUP(T)

 D ^XBFMK K DIADD,DLAYGO

 Q

APCDDMU2  ; IHS/CMI/LAB - EDITS FOR AUPNVSIT (VISIT:9000010) 24-MAY-1993 ;

 +1       ;;2.0;IHS PCC SUITE;**4,5**;MAY 14, 2009

 +2       ;

PPD       ;EP

 +1        KILL APCDVSIT

 +2        IF $PIECE($GET(^APCDDMUP(APCDDA,11)),U,1)=""

               QUIT 

 +3       ;I $P($G(^APCDDMUP(APCDDA,11)),U,2)="" Q

 +4        SET APCDDMDT=$PIECE($GET(^APCDDMUP(APCDDA,11)),U,1)

 +5        SET APCDMTYP=$ORDER(^AUTTSK("B","PPD",0))

 +6       ;get event visit

           DO EVSIT^APCDDMUP

 +7        IF '$GET(APCDVSIT)

               SET T="Could not Create PCC Visit when attempting to update PPD."

               DO ERR^APCDDMUP(T)

               QUIT 

 +8        SET (X,G)=0

           FOR 

               SET X=$ORDER(^AUPNVSK("AD",APCDVSIT,X))

               IF X'=+X!(G)

                   QUIT 

               IF $PIECE(^AUPNVSK(X,0),U)=APCDMTYP

                   SET G=1

 +9        IF G

               SET T="Already have a PPD  on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(APCDVSIT,0),U))

               DO ERR^APCDDMUP(T)

               QUIT 

 +10       KILL APCDALVR

 +11       SET APCDALVR("APCDPAT")=APCDDMPT

 +12       SET APCDALVR("APCDVSIT")=APCDVSIT

 +13       SET APCDALVR("APCDATMP")="[APCDALVR 9000010.12 (ADD)]"

 +14       SET APCDALVR("APCDTSK")="`"_APCDMTYP

 +15       SET APCDALVR("APCDTREA")=$PIECE($GET(^APCDDMUP(APCDDA,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^APCDDMUP(T)

 +18       KILL APCDALVR

 +19       QUIT 

EKG       ;EP

 +1        KILL APCDVSIT

 +2        IF $PIECE($GET(^APCDDMUP(APCDDA,11)),U,3)=""

               QUIT 

 +3        SET APCDDMDT=$PIECE($GET(^APCDDMUP(APCDDA,11)),U,3)

 +4        SET APCDMTYP=$ORDER(^AUTTDXPR("B","ECG SUMMARY",0))

 +5        SET APCDDMRE=$PIECE(^APCDDMUP(APCDDA,0),U,23)

 +6       ;get event visit

           DO EVSIT^APCDDMUP

 +7        IF '$GET(APCDVSIT)

               SET T="Could not Create PCC Visit when attempting to update EKG."

               DO ERR^APCDDMUP(T)

               QUIT 

 +8        SET (X,G)=0

           FOR 

               SET X=$ORDER(^AUPNVDXP("AD",APCDVSIT,X))

               IF X'=+X!(G)

                   QUIT 

               IF $PIECE(^AUPNVDXP(X,0),U)=APCDMTYP

                   SET G=1

 +9        IF G

               SET T="Already have a EKG on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(APCDVSIT,0),U))

               DO ERR^APCDDMUP(T)

               QUIT 

 +10       KILL APCDALVR

 +11       SET APCDALVR("APCDPAT")=APCDDMPT

 +12       SET APCDALVR("APCDVSIT")=APCDVSIT

 +13       SET APCDALVR("APCDATMP")="[APCDALVR 9000010.21 (ADD)]"

 +14       SET APCDALVR("APCDTDXR")="`"_APCDMTYP

 +15       SET APCDALVR("APCDTRQ")=APCDDMRE

 +16       DO ^APCDALVR

 +17       IF $DATA(APCDALVR("APCDAFLG"))

               SET T="Error creating V Diagnostic Procedure Entry for EKG.  PCC not updated."

               DO ERR^APCDDMUP(T)

 +18       KILL APCDALVR

 +19       QUIT 

LAB       ;EP

 +1       ;no educ entered

           IF '$DATA(^APCDDMUP(APCDDA,13))

               QUIT 

 +2        SET APCDEDU=0

           FOR 

               SET APCDEDU=$ORDER(^APCDDMUP(APCDDA,13,APCDEDU))

               IF APCDEDU'=+APCDEDU

                   QUIT 

               DO LAB1

 +3        DO ^XBFMK

 +4        KILL APCDALVR

 +5        QUIT 

LAB1      ;

 +1        IF $PIECE(^APCDDMUP(APCDDA,13,APCDEDU,0),U)=""

               QUIT 

 +2        IF $PIECE(^APCDDMUP(APCDDA,13,APCDEDU,0),U,2)=""

               QUIT 

 +3        SET APCDDMDT=$PIECE(^APCDDMUP(APCDDA,13,APCDEDU,0),U,2)

 +4        SET APCDMTYP=$PIECE(^APCDDMUP(APCDDA,13,APCDEDU,0),U)

 +5       ;get event visit

           DO EVSIT^APCDDMUP

 +6        IF '$GET(APCDVSIT)

               SET T="Could not Create PCC Visit when attempting to update lab ."

               DO ERR^APCDDMUP(T)

               QUIT 

 +7        SET (X,G)=0

           FOR 

               SET X=$ORDER(^AUPNVLAB("AD",APCDVSIT,X))

               IF X'=+X!(G)

                   QUIT 

               IF $PIECE(^AUPNVLAB(X,0),U)=APCDMTYP

                   SET G=1

 +8        IF G

               SET T="Already have a  "_$PIECE(^LAB(60,APCDMTYP,0),U)_" on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(APCDVSIT,0),U))

               DO ERR^APCDDMUP(T)

               QUIT 

 +9        KILL APCDALVR

 +10       SET APCDALVR("APCDPAT")=APCDDMPT

 +11       SET APCDALVR("APCDVSIT")=APCDVSIT

 +12       SET APCDALVR("APCDATMP")="[APCDALVR 9000010.09 (ADD)]"

 +13       SET APCDALVR("APCDTLAB")="`"_APCDMTYP

 +14       SET APCDALVR("APCDTRES")=$PIECE($GET(^APCDDMUP(APCDDA,13,APCDEDU,0)),U,3)

 +15       DO ^APCDALVR

 +16       IF $DATA(APCDALVR("APCDAFLG"))

               SET T="Error creating V Lab Entry for lab test.  PCC not updated."

               DO ERR^APCDDMUP(T)

 +17       KILL APCDALVR

 +18       QUIT 

EDUC      ;EP - add v educ to pcc

 +1       ;no educ entered

           IF '$DATA(^APCDDMUP(APCDDA,12))

               QUIT 

 +2        SET APCDEDU=0

           FOR 

               SET APCDEDU=$ORDER(^APCDDMUP(APCDDA,12,APCDEDU))

               IF APCDEDU'=+APCDEDU

                   QUIT 

               DO EDUC1

 +3        DO ^XBFMK

 +4        KILL APCDALVR

 +5        QUIT 

EDUC1     ;

 +1        IF $PIECE(^APCDDMUP(APCDDA,12,APCDEDU,0),U)=""

               QUIT 

 +2        IF $PIECE(^APCDDMUP(APCDDA,12,APCDEDU,0),U,2)=""

               QUIT 

 +3        SET APCDDMDT=$PIECE(^APCDDMUP(APCDDA,12,APCDEDU,0),U,2)

 +4        SET APCDMTYP=$PIECE(^APCDDMUP(APCDDA,12,APCDEDU,0),U)

 +5       ;get event visit

           DO EVSIT^APCDDMUP

 +6        IF '$GET(APCDVSIT)

               SET T="Could not Create PCC Visit when attempting to update pt education topic."

               DO ERR^APCDDMUP(T)

               QUIT 

 +7        SET (X,G)=0

           FOR 

               SET X=$ORDER(^AUPNVPED("AD",APCDVSIT,X))

               IF X'=+X!(G)

                   QUIT 

               IF $PIECE(^AUPNVPED(X,0),U)=APCDMTYP

                   SET G=1

 +8        IF G

               SET T="Already have a  "_$PIECE(^AUTTEDT(APCDMTYP,0),U)_" on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(APCDVSIT,0),U))

               DO ERR^APCDDMUP(T)

               QUIT 

 +9        KILL APCDALVR

 +10       SET APCDALVR("APCDPAT")=APCDDMPT

 +11       SET APCDALVR("APCDVSIT")=APCDVSIT

 +12       SET APCDALVR("APCDATMP")="[APCDALVR 9000010.16 (ADD)]"

 +13       SET APCDALVR("APCDTTOP")="`"_APCDMTYP

 +14       SET APCDALVR("APCDTLOU")=$PIECE($GET(^APCDDMUP(APCDDA,12,APCDEDU,0)),U,3)

 +15       IF $PIECE(^DD(9000010.16,.05,0),U,2)[200

               SET APCDALVR("APCDTPRO")=$SELECT($PIECE($GET(^APCDDMUP(APCDDA,12,APCDEDU,0)),U,4):"`"_$PIECE(^APCDDMUP(APCDDA,12,APCDEDU,0),U,4),1:"")

 +16       IF $PIECE(^DD(9000010.16,.05,0),U,2)[6

               Begin DoDot:1

 +17               IF $PIECE($GET(^APCDDMUP(APCDDA,12,APCDEDU,0)),U,4)=""

                       SET APCDALVR("APCDTPRO")=""

                       QUIT 

 +18               SET X=$PIECE($GET(^APCDDMUP(APCDDA,12,APCDEDU,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(^APCDDMUP(APCDDA,12,APCDEDU,0)),U,6)

 +22       SET APCDALVR("APCDTMIN")=$PIECE($GET(^APCDDMUP(APCDDA,12,APCDEDU,0)),U,7)

 +23       SET APCDALVR("APCDTOBJ")=$PIECE($GET(^APCDDMUP(APCDDA,12,APCDEDU,0)),U,5)

 +24       SET APCDALVR("APCDTBC")=$PIECE($GET(^APCDDMUP(APCDDA,12,APCDEDU,0)),U,8)

 +25       SET APCDALVR("APCDTRTL")=$PIECE($GET(^APCDDMUP(APCDDA,12,APCDEDU,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^APCDDMUP(T)

 +28       KILL APCDALVR

 +29       QUIT 

MED       ;EP

 +1       ;no med entered

           IF '$DATA(^APCDDMUP(APCDDA,14))

               QUIT 

 +2        SET APCDEDU=0

           FOR 

               SET APCDEDU=$ORDER(^APCDDMUP(APCDDA,14,APCDEDU))

               IF APCDEDU'=+APCDEDU

                   QUIT 

               DO MED1

 +3        DO ^XBFMK

 +4        KILL APCDALVR

 +5        QUIT 

MED1      ;

 +1        IF $PIECE(^APCDDMUP(APCDDA,14,APCDEDU,0),U)=""

               QUIT 

 +2        IF $PIECE(^APCDDMUP(APCDDA,14,APCDEDU,0),U,2)=""

               QUIT 

 +3        SET APCDDMDT=$PIECE(^APCDDMUP(APCDDA,14,APCDEDU,0),U,2)

 +4        SET APCDMTYP=$PIECE(^APCDDMUP(APCDDA,14,APCDEDU,0),U)

 +5       ;get event visit

           DO EVSIT^APCDDMUP

 +6        IF '$GET(APCDVSIT)

               SET T="Could not Create PCC Visit when attempting to update lab ."

               DO ERR^APCDDMUP(T)

               QUIT 

 +7        SET (X,G)=0

           FOR 

               SET X=$ORDER(^AUPNVMED("AD",APCDVSIT,X))

               IF X'=+X!(G)

                   QUIT 

               IF $PIECE(^AUPNVMED(X,0),U)=APCDMTYP

                   SET G=1

 +8        IF G

               SET T="Already have a  "_$PIECE(^PSDRUG(APCDMTYP,0),U)_" on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(APCDVSIT,0),U))

               DO ERR^APCDDMUP(T)

               QUIT 

 +9        KILL APCDALVR

 +10       SET APCDALVR("APCDPAT")=APCDDMPT

 +11       SET APCDALVR("APCDVSIT")=APCDVSIT

 +12       SET APCDALVR("APCDATMP")="[APCDALVR 9000010.14 (ADD)]"

 +13       SET APCDALVR("APCDTRX")="`"_APCDMTYP

 +14       SET APCDALVR("APCDTQTY")=$PIECE($GET(^APCDDMUP(APCDDA,14,APCDEDU,0)),U,3)

 +15       SET APCDALVR("APCDTSIQ")=$PIECE($GET(^APCDDMUP(APCDDA,14,APCDEDU,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^APCDDMUP(T)

 +18       KILL APCDALVR

 +19       QUIT 

BP        ;EP

 +1        KILL APCDVSIT

 +2        IF $PIECE(APCDREC,U,19)=""

               QUIT 

 +3        IF $PIECE(APCDREC,U,20)=""

               QUIT 

 +4        SET APCDDMDT=$PIECE(APCDREC,U,19)

 +5        SET APCDMTYP=$ORDER(^AUTTMSR("B","BP",0))

 +6       ;get event visit

           DO EVSIT^APCDDMUP

 +7        IF '$GET(APCDVSIT)

               SET T="Could not Create PCC Visit when attempting to update height."

               DO ERR^APCDDMUP(T)

               QUIT 

 +8        SET (X,G)=0

           FOR 

               SET X=$ORDER(^AUPNVMSR("AD",APCDVSIT,X))

               IF X'=+X!(G)

                   QUIT 

               IF $PIECE(^AUPNVMSR(X,0),U)=APCDMTYP

                   IF $PIECE(^AUPNVMSR(X,0),U,4)=$PIECE(APCDREC,U,20)

                       SET G=1

 +9        IF G

               SET T="Already have a height of "_$PIECE(APCDREC,U,20)_" on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(APCDVSIT,0),U))

               DO ERR^APCDDMUP(T)

               QUIT 

 +10       KILL APCDALVR

 +11       SET APCDALVR("APCDPAT")=APCDDMPT

 +12       SET APCDALVR("APCDVSIT")=APCDVSIT

 +13       SET APCDALVR("APCDATMP")="[APCDALVR 9000010.01 (ADD)]"

 +14       SET APCDALVR("APCDTTYP")="`"_APCDMTYP

 +15       SET APCDALVR("APCDTVAL")=$PIECE(APCDREC,U,20)

 +16       DO ^APCDALVR

 +17       IF $DATA(APCDALVR("APCDAFLG"))

               SET T="Error creating V Measurement Entry for BP.  PCC not updated."

               DO ERR^APCDDMUP(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 APCDVSIT

 +2        KILL APCDALVR

 +3        SET APCDALVR("APCDAUTO")=""

 +4        SET APCDALVR("APCDPAT")=APCDDMPT

 +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")=APCDDMDT_".12"

 +9        DO ^APCDALV

 +10       SET APCDVSIT=$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