BDMEDMU1 ; IHS/CMI/LAB - EDITS FOR AUPNVSIT (VISIT:9000010) 24-MAY-1993 ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**7,8**;JUN 14, 2007;Build 53
;
K BDMEVSIT
I $P(BDMEREC,U,11)="" Q
S BDMEDMDT=$P(BDMEREC,U,11)
S BDMEMTYP=$O(^AUTTEXAM("B","DIABETIC FOOT EXAM, COMPLETE",0))
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update foot exam." D ERR^BDMEDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVXAM("AD",BDMEVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVXAM(X,0),U)=BDMEMTYP S G=1
I G S T="Already have a foot exam 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.13 (ADD)]"
S APCDALVR("APCDTEX")="`"_BDMEMTYP
S APCDALVR("APCDTRES")=$P(BDMEREC,U,21)
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Exam Entry for Foot Exam. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
Q
EYE ;EP
K BDMEVSIT
I $P(BDMEREC,U,12)="" Q
S BDMEDMDT=$P(BDMEREC,U,12)
S BDMEMTYP=$O(^AUTTEXAM("B","DIABETIC EYE EXAM",0))
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update eye exam." D ERR^BDMEDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVXAM("AD",BDMEVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVXAM(X,0),U)=BDMEMTYP S G=1
I G S T="Already have a eye exam 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.13 (ADD)]"
S APCDALVR("APCDTEX")="`"_BDMEMTYP
S APCDALVR("APCDTRES")=$P(BDMEREC,U,22)
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Exam Entry for Eye Exam. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
Q
DEPR ;EP
K BDMEVSIT
I $P(BDMEREC,U,25)="" Q
S BDMEDMDT=$P(BDMEREC,U,25)
S BDMEMTYP=$O(^AUTTEXAM("C",36,0))
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update Depression screening exam." D ERR^BDMEDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVXAM("AD",BDMEVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVXAM(X,0),U)=BDMEMTYP S G=1
I G S T="Already have a depression screening exam 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.13 (ADD)]"
S APCDALVR("APCDTEX")="`"_BDMEMTYP
S APCDALVR("APCDTRES")=$P(BDMEREC,U,22)
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Exam Entry for Depression Screening Exam. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
Q
DENTAL ;EP
K BDMEVSIT
I $P(BDMEREC,U,13)="" Q
S BDMEDMDT=$P(BDMEREC,U,13)
S BDMEMTYP=$O(^AUTTEXAM("B","DENTAL EXAM",0))
I 'BDMEMTYP S BDMEMTYP=$O(^AUTTEXAM("C",30,0))
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update dental exam." D ERR^BDMEDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVXAM("AD",BDMEVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVXAM(X,0),U)=BDMEMTYP S G=1
I G S T="Already have a dental exam 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.13 (ADD)]"
S APCDALVR("APCDTEX")="`"_BDMEMTYP
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Exam Entry for Dental Exam. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
Q
PAP ;EP
K BDMEVSIT
I $P(BDMEREC,U,14)="" Q
S BDMEDMDT=$P(BDMEREC,U,14)
;S BDMEMTYP=$P($$ICDOP^BDMUTL("91.46",,2,"E"),U,1)
;PER KAREN M USE 88174 CPT CODE
S BDMEMTYP=+$$CODEN^ICPTCOD(88174)
I BDMEMTYP=-1 S BDMEMTYP=""
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update pap procedure." D ERR^BDMEDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVCPT("AD",BDMEVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVCPT(X,0),U)=BDMEMTYP S G=1
I G S T="Already have a pap CPT 88174 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.18 (ADD)]"
S APCDALVR("APCDTCPT")="`"_BDMEMTYP
S APCDALVR("APCDTUN")=1
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V CPT Entry for PAP Procedure. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
Q
MAM ;EP
K BDMEVSIT
I $P(BDMEREC,U,15)="" Q
I $P(BDMEREC,U,24)="" Q
S BDMEDMDT=$P(BDMEREC,U,15)
S BDMEMTYP=$P(BDMEREC,U,24)
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update mammogram procedure." D ERR^BDMEDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVRAD("AD",BDMEVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVRAD(X,0),U)=BDMEMTYP S G=1
I G S T="Already have a Mammogram 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.22 (ADD)]"
S APCDALVR("APCDTRAD")="`"_BDMEMTYP
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Radiology Entry for MAMMOGRAM. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
Q
FLU ;EP
K BDMEVSIT
I $P(BDMEREC,U,16)=""!($P(BDMEREC1,U,11)="") Q
S BDMEDMDT=$P(BDMEREC,U,16)
S BDMEMTYP=$P(BDMEREC1,U,11)
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update Flu Immunization." D ERR^BDMEDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVIMM("AD",BDMEVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVIMM(X,0),U)=BDMEMTYP S G=1
I G S T="Already have a flu immunization 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.11 (ADD)]"
S APCDALVR("APCDTIMM")="`"_BDMEMTYP
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Immunization Entry for Flu Immunization. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
Q
HEPB ;EP
K BDMEVSIT
I $P(BDMEREC1,U,20)=""!($P(BDMEREC1,U,21)="") Q
S BDMEDMDT=$P(BDMEREC1,U,20)
S BDMEMTYP=$P(BDMEREC1,U,21)
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update HEP B Immunization." D ERR^BDMEDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVIMM("AD",BDMEVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVIMM(X,0),U)=BDMEMTYP S G=1
I G S T="Already have a HEP B immunization 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.11 (ADD)]"
S APCDALVR("APCDTIMM")="`"_BDMEMTYP
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Immunization Entry for HEP B Immunization. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
Q
PNEU ;EP
K BDMEVSIT
I $P(BDMEREC,U,17)=""!($P(BDMEREC1,U,12)="") Q
S BDMEDMDT=$P(BDMEREC,U,17)
S BDMEMTYP=$P(BDMEREC1,U,12)
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update Pneumovac Immunization." D ERR^BDMEDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVIMM("AD",BDMEVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVIMM(X,0),U)=BDMEMTYP S G=1
I G S T="Already have a pneumovac immunization 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.11 (ADD)]"
S APCDALVR("APCDTIMM")="`"_BDMEMTYP
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Immunization Entry for Pneumovac Immunization. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
Q
TD ;EP
K BDMEVSIT
I $P(BDMEREC,U,18)=""!($P(BDMEREC1,U,13)="") Q
S BDMEDMDT=$P(BDMEREC,U,18)
S BDMEMTYP=$P(BDMEREC1,U,13)
D EVSIT^BDMEDMUP ;get event visit
I '$G(BDMEVSIT) S T="Could not Create PCC Visit when attempting to update Pneumovac Immunization." D ERR^BDMEDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVIMM("AD",BDMEVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVIMM(X,0),U)=BDMEMTYP S G=1
I G S T="Already have a TD immunization 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.11 (ADD)]"
S APCDALVR("APCDTIMM")="`"_BDMEMTYP
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Immunization Entry for TD Immunization. PCC not updated." D ERR^BDMEDMUP(T)
K APCDALVR
Q
ID ;
S:$E(BDMEDMDT,6,7)="00" BDMEDMDT=$E(BDMEDMDT,1,5)_"01" S:$E(BDMEDMDT,4,5)="00" BDMEDMDT=$E(BDMEDMDT,1,3)_"01"_$E(BDMEDMDT,6,7)
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)
;
BDMEDMU1 ; IHS/CMI/LAB - EDITS FOR AUPNVSIT (VISIT:9000010) 24-MAY-1993 ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**7,8**;JUN 14, 2007;Build 53
+2 ;
+1 KILL BDMEVSIT
+2 IF $PIECE(BDMEREC,U,11)=""
QUIT
+3 SET BDMEDMDT=$PIECE(BDMEREC,U,11)
+4 SET BDMEMTYP=$ORDER(^AUTTEXAM("B","DIABETIC FOOT EXAM, COMPLETE",0))
+5 ;get event visit
DO EVSIT^BDMEDMUP
+6 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update foot exam."
DO ERR^BDMEDMUP(T)
QUIT
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVXAM("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVXAM(X,0),U)=BDMEMTYP
SET G=1
+8 IF G
SET T="Already have a foot exam 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.13 (ADD)]"
+13 SET APCDALVR("APCDTEX")="`"_BDMEMTYP
+14 SET APCDALVR("APCDTRES")=$PIECE(BDMEREC,U,21)
+15 DO ^APCDALVR
+16 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Exam Entry for Foot Exam. PCC not updated."
DO ERR^BDMEDMUP(T)
+17 KILL APCDALVR
+18 QUIT
EYE ;EP
+1 KILL BDMEVSIT
+2 IF $PIECE(BDMEREC,U,12)=""
QUIT
+3 SET BDMEDMDT=$PIECE(BDMEREC,U,12)
+4 SET BDMEMTYP=$ORDER(^AUTTEXAM("B","DIABETIC EYE EXAM",0))
+5 ;get event visit
DO EVSIT^BDMEDMUP
+6 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update eye exam."
DO ERR^BDMEDMUP(T)
QUIT
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVXAM("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVXAM(X,0),U)=BDMEMTYP
SET G=1
+8 IF G
SET T="Already have a eye exam 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.13 (ADD)]"
+13 SET APCDALVR("APCDTEX")="`"_BDMEMTYP
+14 SET APCDALVR("APCDTRES")=$PIECE(BDMEREC,U,22)
+15 DO ^APCDALVR
+16 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Exam Entry for Eye Exam. PCC not updated."
DO ERR^BDMEDMUP(T)
+17 KILL APCDALVR
+18 QUIT
DEPR ;EP
+1 KILL BDMEVSIT
+2 IF $PIECE(BDMEREC,U,25)=""
QUIT
+3 SET BDMEDMDT=$PIECE(BDMEREC,U,25)
+4 SET BDMEMTYP=$ORDER(^AUTTEXAM("C",36,0))
+5 ;get event visit
DO EVSIT^BDMEDMUP
+6 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update Depression screening exam."
DO ERR^BDMEDMUP(T)
QUIT
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVXAM("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVXAM(X,0),U)=BDMEMTYP
SET G=1
+8 IF G
SET T="Already have a depression screening exam 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.13 (ADD)]"
+13 SET APCDALVR("APCDTEX")="`"_BDMEMTYP
+14 SET APCDALVR("APCDTRES")=$PIECE(BDMEREC,U,22)
+15 DO ^APCDALVR
+16 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Exam Entry for Depression Screening Exam. PCC not updated."
DO ERR^BDMEDMUP(T)
+17 KILL APCDALVR
+18 QUIT
DENTAL ;EP
+1 KILL BDMEVSIT
+2 IF $PIECE(BDMEREC,U,13)=""
QUIT
+3 SET BDMEDMDT=$PIECE(BDMEREC,U,13)
+4 SET BDMEMTYP=$ORDER(^AUTTEXAM("B","DENTAL EXAM",0))
+5 IF 'BDMEMTYP
SET BDMEMTYP=$ORDER(^AUTTEXAM("C",30,0))
+6 ;get event visit
DO EVSIT^BDMEDMUP
+7 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update dental exam."
DO ERR^BDMEDMUP(T)
QUIT
+8 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVXAM("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVXAM(X,0),U)=BDMEMTYP
SET G=1
+9 IF G
SET T="Already have a dental exam 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.13 (ADD)]"
+14 SET APCDALVR("APCDTEX")="`"_BDMEMTYP
+15 DO ^APCDALVR
+16 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Exam Entry for Dental Exam. PCC not updated."
DO ERR^BDMEDMUP(T)
+17 KILL APCDALVR
+18 QUIT
PAP ;EP
+1 KILL BDMEVSIT
+2 IF $PIECE(BDMEREC,U,14)=""
QUIT
+3 SET BDMEDMDT=$PIECE(BDMEREC,U,14)
+4 ;S BDMEMTYP=$P($$ICDOP^BDMUTL("91.46",,2,"E"),U,1)
+5 ;PER KAREN M USE 88174 CPT CODE
+6 SET BDMEMTYP=+$$CODEN^ICPTCOD(88174)
+7 IF BDMEMTYP=-1
SET BDMEMTYP=""
+8 ;get event visit
DO EVSIT^BDMEDMUP
+9 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update pap procedure."
DO ERR^BDMEDMUP(T)
QUIT
+10 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVCPT(X,0),U)=BDMEMTYP
SET G=1
+11 IF G
SET T="Already have a pap CPT 88174 on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(BDMEVSIT,0),U))
DO ERR^BDMEDMUP(T)
QUIT
+12 KILL APCDALVR
+13 SET APCDALVR("APCDPAT")=BDMEDMPT
+14 SET APCDALVR("APCDVSIT")=BDMEVSIT
+15 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.18 (ADD)]"
+16 SET APCDALVR("APCDTCPT")="`"_BDMEMTYP
+17 SET APCDALVR("APCDTUN")=1
+18 DO ^APCDALVR
+19 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V CPT Entry for PAP Procedure. PCC not updated."
DO ERR^BDMEDMUP(T)
+20 KILL APCDALVR
+21 QUIT
MAM ;EP
+1 KILL BDMEVSIT
+2 IF $PIECE(BDMEREC,U,15)=""
QUIT
+3 IF $PIECE(BDMEREC,U,24)=""
QUIT
+4 SET BDMEDMDT=$PIECE(BDMEREC,U,15)
+5 SET BDMEMTYP=$PIECE(BDMEREC,U,24)
+6 ;get event visit
DO EVSIT^BDMEDMUP
+7 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update mammogram procedure."
DO ERR^BDMEDMUP(T)
QUIT
+8 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVRAD("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVRAD(X,0),U)=BDMEMTYP
SET G=1
+9 IF G
SET T="Already have a Mammogram 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.22 (ADD)]"
+14 SET APCDALVR("APCDTRAD")="`"_BDMEMTYP
+15 DO ^APCDALVR
+16 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Radiology Entry for MAMMOGRAM. PCC not updated."
DO ERR^BDMEDMUP(T)
+17 KILL APCDALVR
+18 QUIT
FLU ;EP
+1 KILL BDMEVSIT
+2 IF $PIECE(BDMEREC,U,16)=""!($PIECE(BDMEREC1,U,11)="")
QUIT
+3 SET BDMEDMDT=$PIECE(BDMEREC,U,16)
+4 SET BDMEMTYP=$PIECE(BDMEREC1,U,11)
+5 ;get event visit
DO EVSIT^BDMEDMUP
+6 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update Flu Immunization."
DO ERR^BDMEDMUP(T)
QUIT
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVIMM("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVIMM(X,0),U)=BDMEMTYP
SET G=1
+8 IF G
SET T="Already have a flu immunization 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.11 (ADD)]"
+13 SET APCDALVR("APCDTIMM")="`"_BDMEMTYP
+14 DO ^APCDALVR
+15 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Immunization Entry for Flu Immunization. PCC not updated."
DO ERR^BDMEDMUP(T)
+16 KILL APCDALVR
+17 QUIT
HEPB ;EP
+1 KILL BDMEVSIT
+2 IF $PIECE(BDMEREC1,U,20)=""!($PIECE(BDMEREC1,U,21)="")
QUIT
+3 SET BDMEDMDT=$PIECE(BDMEREC1,U,20)
+4 SET BDMEMTYP=$PIECE(BDMEREC1,U,21)
+5 ;get event visit
DO EVSIT^BDMEDMUP
+6 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update HEP B Immunization."
DO ERR^BDMEDMUP(T)
QUIT
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVIMM("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVIMM(X,0),U)=BDMEMTYP
SET G=1
+8 IF G
SET T="Already have a HEP B immunization 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.11 (ADD)]"
+13 SET APCDALVR("APCDTIMM")="`"_BDMEMTYP
+14 DO ^APCDALVR
+15 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Immunization Entry for HEP B Immunization. PCC not updated."
DO ERR^BDMEDMUP(T)
+16 KILL APCDALVR
+17 QUIT
PNEU ;EP
+1 KILL BDMEVSIT
+2 IF $PIECE(BDMEREC,U,17)=""!($PIECE(BDMEREC1,U,12)="")
QUIT
+3 SET BDMEDMDT=$PIECE(BDMEREC,U,17)
+4 SET BDMEMTYP=$PIECE(BDMEREC1,U,12)
+5 ;get event visit
DO EVSIT^BDMEDMUP
+6 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update Pneumovac Immunization."
DO ERR^BDMEDMUP(T)
QUIT
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVIMM("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVIMM(X,0),U)=BDMEMTYP
SET G=1
+8 IF G
SET T="Already have a pneumovac immunization 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.11 (ADD)]"
+13 SET APCDALVR("APCDTIMM")="`"_BDMEMTYP
+14 DO ^APCDALVR
+15 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Immunization Entry for Pneumovac Immunization. PCC not updated."
DO ERR^BDMEDMUP(T)
+16 KILL APCDALVR
+17 QUIT
TD ;EP
+1 KILL BDMEVSIT
+2 IF $PIECE(BDMEREC,U,18)=""!($PIECE(BDMEREC1,U,13)="")
QUIT
+3 SET BDMEDMDT=$PIECE(BDMEREC,U,18)
+4 SET BDMEMTYP=$PIECE(BDMEREC1,U,13)
+5 ;get event visit
DO EVSIT^BDMEDMUP
+6 IF '$GET(BDMEVSIT)
SET T="Could not Create PCC Visit when attempting to update Pneumovac Immunization."
DO ERR^BDMEDMUP(T)
QUIT
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVIMM("AD",BDMEVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVIMM(X,0),U)=BDMEMTYP
SET G=1
+8 IF G
SET T="Already have a TD immunization 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.11 (ADD)]"
+13 SET APCDALVR("APCDTIMM")="`"_BDMEMTYP
+14 DO ^APCDALVR
+15 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Immunization Entry for TD Immunization. PCC not updated."
DO ERR^BDMEDMUP(T)
+16 KILL APCDALVR
+17 QUIT
ID ;
+1 IF $EXTRACT(BDMEDMDT,6,7)="00"
SET BDMEDMDT=$EXTRACT(BDMEDMDT,1,5)_"01"
IF $EXTRACT(BDMEDMDT,4,5)="00"
SET BDMEDMDT=$EXTRACT(BDMEDMDT,1,3)_"01"_$EXTRACT(BDMEDMDT,6,7)
+2 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 ;
