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
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 APCDVSIT
+2 IF $PIECE($GET(^APCDDMUP(APCDDA,11)),U,7)=""
QUIT
+3 SET APCDDMDT=$SELECT($PIECE(APCDREC1,U,16)]"":$PIECE(APCDREC1,U,16),1:DT)
+4 SET APCDMTYP=$PIECE(^APCDDMUP(APCDDA,11),U,7)
+5 SET APCDMCAT=$PIECE(^AUTTHF(APCDMTYP,0),U,3)
+6 ;get event visit
DO EVSIT^APCDDMUP
+7 IF '$GET(APCDVSIT)
SET T="Could not Create PCC Visit when attempting to update self monitoring health factor."
DO ERR^APCDDMUP(T)
QUIT
+8 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVHF("AD",APCDVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVHF(X,0),U)=APCDMTYP
SET G=1
+9 IF G
SET T="Already have a health factor of "_$PIECE(^AUTTHF($PIECE(^APCDDMUP(APCDDA,11),U,7),0),U)_" 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.23 (ADD)]"
+14 SET APCDALVR("APCDTHF")="`"_APCDMTYP
+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^APCDDMUP(T)
+17 KILL APCDALVR
+18 ;update health status
+19 ;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
+20 ;I APCDHSE D Q
+21 ;.D ^XBFMK K DIADD
+22 ;.S DA=APCDHSE,DIE="^AUPNHF(",DR=".01///`"_APCDMTYP_";.03////"_DT D ^DIE
+23 ;.I $D(Y) S T="Error updating Health Status entry for Tobacco." D ERR^APCDDMUP(T)
+24 ;.D ^XBFMK
+25 ;D ^XBFMK
+26 ;S X=APCDMTYP,DIC("DR")=".02////"_APCDDMPT_";.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^APCDDMUP(T)
+28 DO ^XBFMK
KILL DIADD
+29 QUIT
TBHF ;EP
+1 KILL APCDVSIT
+2 IF $PIECE(APCDREC,U,10)=""
QUIT
+3 SET APCDDMDT=$SELECT($PIECE(APCDREC1,U,15)]"":$PIECE(APCDREC1,U,15),1:DT)
+4 SET APCDMTYP=$PIECE(APCDREC,U,10)
+5 SET APCDMCAT=$PIECE(^AUTTHF(APCDMTYP,0),U,3)
+6 ;get event visit
DO EVSIT^APCDDMUP
+7 IF '$GET(APCDVSIT)
SET T="Could not Create PCC Visit when attempting to update tb health factor."
DO ERR^APCDDMUP(T)
QUIT
+8 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVHF("AD",APCDVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVHF(X,0),U)=APCDMTYP
SET G=1
+9 IF G
SET T="Already have a health factor of "_$PIECE(^AUTTHF($PIECE(APCDREC,U,10),0),U)_" 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.23 (ADD)]"
+14 SET APCDALVR("APCDTHF")="`"_APCDMTYP
+15 DO ^APCDALVR
+16 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Health Factor Entry for TB. PCC not updated."
DO ERR^APCDDMUP(T)
+17 KILL APCDALVR
+18 ;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
+19 ;I APCDHSE D Q
+20 ;.D ^XBFMK K DIADD
+21 ;.S DA=APCDHSE,DIE="^AUPNHF(",DR=".01///`"_APCDMTYP_";.03////"_DT D ^DIE
+22 ;.I $D(Y) S T="Error updating Health Status entry for TB." D ERR^APCDDMUP(T)
+23 ;.D ^XBFMK
+24 ;D ^XBFMK
+25 ;S X=APCDMTYP,DIC("DR")=".02////"_APCDDMPT_";.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^APCDDMUP(T)
+27 DO ^XBFMK
KILL DIADD,DLAYGO
+28 QUIT
