APCDDMU1 ; IHS/CMI/LAB - EDITS FOR AUPNVSIT (VISIT:9000010) 24-MAY-1993 ;
;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
;
K APCDVSIT
I $P(APCDREC,U,11)="" Q
S APCDDMDT=$P(APCDREC,U,11)
S APCDMTYP=$O(^AUTTEXAM("B","DIABETIC FOOT EXAM, COMPLETE",0))
D EVSIT^APCDDMUP ;get event visit
I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update foot exam." D ERR^APCDDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVXAM("AD",APCDVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVXAM(X,0),U)=APCDMTYP S G=1
I G S T="Already have a foot exam 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.13 (ADD)]"
S APCDALVR("APCDTEX")="`"_APCDMTYP
S APCDALVR("APCDTRES")=$P(APCDREC,U,21)
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Exam Entry for Foot Exam. PCC not updated." D ERR^APCDDMUP(T)
K APCDALVR
Q
EYE ;EP
K APCDVSIT
I $P(APCDREC,U,12)="" Q
S APCDDMDT=$P(APCDREC,U,12)
S APCDMTYP=$O(^AUTTEXAM("B","DIABETIC EYE EXAM",0))
D EVSIT^APCDDMUP ;get event visit
I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update eye exam." D ERR^APCDDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVXAM("AD",APCDVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVXAM(X,0),U)=APCDMTYP S G=1
I G S T="Already have a eye exam 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.13 (ADD)]"
S APCDALVR("APCDTEX")="`"_APCDMTYP
S APCDALVR("APCDTRES")=$P(APCDREC,U,22)
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Exam Entry for Eye Exam. PCC not updated." D ERR^APCDDMUP(T)
K APCDALVR
Q
DEPR ;EP
K APCDVSIT
I $P(APCDREC,U,25)="" Q
S APCDDMDT=$P(APCDREC,U,25)
S APCDMTYP=$O(^AUTTEXAM("C",36,0))
D EVSIT^APCDDMUP ;get event visit
I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update Depression screening exam." D ERR^APCDDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVXAM("AD",APCDVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVXAM(X,0),U)=APCDMTYP S G=1
I G S T="Already have a depression screening exam 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.13 (ADD)]"
S APCDALVR("APCDTEX")="`"_APCDMTYP
S APCDALVR("APCDTRES")=$P(APCDREC,U,22)
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Exam Entry for Depression Screening Exam. PCC not updated." D ERR^APCDDMUP(T)
K APCDALVR
Q
DENTAL ;EP
K APCDVSIT
I $P(APCDREC,U,13)="" Q
S APCDDMDT=$P(APCDREC,U,13)
S APCDMTYP=$O(^AUTTEXAM("B","DENTAL EXAM",0))
I 'APCDMTYP S APCDMTYP=$O(^AUTTEXAM("C",30,0))
D EVSIT^APCDDMUP ;get event visit
I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update dental exam." D ERR^APCDDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVXAM("AD",APCDVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVXAM(X,0),U)=APCDMTYP S G=1
I G S T="Already have a dental exam 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.13 (ADD)]"
S APCDALVR("APCDTEX")="`"_APCDMTYP
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Exam Entry for Dental Exam. PCC not updated." D ERR^APCDDMUP(T)
K APCDALVR
Q
PAP ;EP
K APCDVSIT
I $P(APCDREC,U,14)="" Q
S APCDDMDT=$P(APCDREC,U,14)
S APCDMTYP=$P($$ICDOP^ICDCODE("91.46"),U,1)
I APCDMTYP=-1 S APCDMTYP=""
D EVSIT^APCDDMUP ;get event visit
I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update pap procedure." D ERR^APCDDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVPRC("AD",APCDVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVPRC(X,0),U)=APCDMTYP S G=1
I G S T="Already have a pap procedure 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.08 (ADD)]"
S APCDALVR("APCDTPRC")="`"_APCDMTYP
;S APCDALVR("APCDTNQ")=$P(^ICD0(APCDMTYP,0),U,4)
S APCDALVR("APCDTNQ")=$P($$ICDOP^ICDCODE(APCDMTYP,$$VD^APCLV(APCDVSIT)),U,3)
S APCDALVR("APCDTPD")=$$FMTE^XLFDT(APCDDMDT)
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Procedure Entry for PAP Procedure. PCC not updated." D ERR^APCDDMUP(T)
K APCDALVR
Q
MAM ;EP
K APCDVSIT
I $P(APCDREC,U,15)="" Q
I $P(APCDREC,U,24)="" Q
S APCDDMDT=$P(APCDREC,U,15)
S APCDMTYP=$P(APCDREC,U,24)
D EVSIT^APCDDMUP ;get event visit
I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update mammogram procedure." D ERR^APCDDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVRAD("AD",APCDVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVRAD(X,0),U)=APCDMTYP S G=1
I G S T="Already have a Mammogram 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.22 (ADD)]"
S APCDALVR("APCDTRAD")="`"_APCDMTYP
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Radiology Entry for MAMMOGRAM. PCC not updated." D ERR^APCDDMUP(T)
K APCDALVR
Q
FLU ;EP
K APCDVSIT
I $P(APCDREC,U,16)=""!($P(APCDREC1,U,11)="") Q
S APCDDMDT=$P(APCDREC,U,16)
S APCDMTYP=$P(APCDREC1,U,11)
D EVSIT^APCDDMUP ;get event visit
I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update Flu Immunization." D ERR^APCDDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVIMM("AD",APCDVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVIMM(X,0),U)=APCDMTYP S G=1
I G S T="Already have a flu immunization 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.11 (ADD)]"
S APCDALVR("APCDTIMM")="`"_APCDMTYP
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Immunization Entry for Flu Immunization. PCC not updated." D ERR^APCDDMUP(T)
K APCDALVR
Q
PNEU ;EP
K APCDVSIT
I $P(APCDREC,U,17)=""!($P(APCDREC1,U,12)="") Q
S APCDDMDT=$P(APCDREC,U,17)
S APCDMTYP=$P(APCDREC1,U,12)
D EVSIT^APCDDMUP ;get event visit
I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update Pneumovac Immunization." D ERR^APCDDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVIMM("AD",APCDVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVIMM(X,0),U)=APCDMTYP S G=1
I G S T="Already have a pneumovac immunization 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.11 (ADD)]"
S APCDALVR("APCDTIMM")="`"_APCDMTYP
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Immunization Entry for Pneumovac Immunization. PCC not updated." D ERR^APCDDMUP(T)
K APCDALVR
Q
TD ;EP
K APCDVSIT
I $P(APCDREC,U,18)=""!($P(APCDREC1,U,13)="") Q
S APCDDMDT=$P(APCDREC,U,18)
S APCDMTYP=$P(APCDREC1,U,13)
D EVSIT^APCDDMUP ;get event visit
I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update Pneumovac Immunization." D ERR^APCDDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVIMM("AD",APCDVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVIMM(X,0),U)=APCDMTYP S G=1
I G S T="Already have a TD immunization 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.11 (ADD)]"
S APCDALVR("APCDTIMM")="`"_APCDMTYP
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Immunization Entry for TD Immunization. PCC not updated." D ERR^APCDDMUP(T)
K APCDALVR
Q
ID ;
S:$E(APCDDMDT,6,7)="00" APCDDMDT=$E(APCDDMDT,1,5)_"01" S:$E(APCDDMDT,4,5)="00" APCDDMDT=$E(APCDDMDT,1,3)_"01"_$E(APCDDMDT,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)
;
APCDDMU1 ; IHS/CMI/LAB - EDITS FOR AUPNVSIT (VISIT:9000010) 24-MAY-1993 ;
+1 ;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
+2 ;
+1 KILL APCDVSIT
+2 IF $PIECE(APCDREC,U,11)=""
QUIT
+3 SET APCDDMDT=$PIECE(APCDREC,U,11)
+4 SET APCDMTYP=$ORDER(^AUTTEXAM("B","DIABETIC FOOT EXAM, COMPLETE",0))
+5 ;get event visit
DO EVSIT^APCDDMUP
+6 IF '$GET(APCDVSIT)
SET T="Could not Create PCC Visit when attempting to update foot exam."
DO ERR^APCDDMUP(T)
QUIT
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVXAM("AD",APCDVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVXAM(X,0),U)=APCDMTYP
SET G=1
+8 IF G
SET T="Already have a foot exam 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.13 (ADD)]"
+13 SET APCDALVR("APCDTEX")="`"_APCDMTYP
+14 SET APCDALVR("APCDTRES")=$PIECE(APCDREC,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^APCDDMUP(T)
+17 KILL APCDALVR
+18 QUIT
EYE ;EP
+1 KILL APCDVSIT
+2 IF $PIECE(APCDREC,U,12)=""
QUIT
+3 SET APCDDMDT=$PIECE(APCDREC,U,12)
+4 SET APCDMTYP=$ORDER(^AUTTEXAM("B","DIABETIC EYE EXAM",0))
+5 ;get event visit
DO EVSIT^APCDDMUP
+6 IF '$GET(APCDVSIT)
SET T="Could not Create PCC Visit when attempting to update eye exam."
DO ERR^APCDDMUP(T)
QUIT
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVXAM("AD",APCDVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVXAM(X,0),U)=APCDMTYP
SET G=1
+8 IF G
SET T="Already have a eye exam 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.13 (ADD)]"
+13 SET APCDALVR("APCDTEX")="`"_APCDMTYP
+14 SET APCDALVR("APCDTRES")=$PIECE(APCDREC,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^APCDDMUP(T)
+17 KILL APCDALVR
+18 QUIT
DEPR ;EP
+1 KILL APCDVSIT
+2 IF $PIECE(APCDREC,U,25)=""
QUIT
+3 SET APCDDMDT=$PIECE(APCDREC,U,25)
+4 SET APCDMTYP=$ORDER(^AUTTEXAM("C",36,0))
+5 ;get event visit
DO EVSIT^APCDDMUP
+6 IF '$GET(APCDVSIT)
SET T="Could not Create PCC Visit when attempting to update Depression screening exam."
DO ERR^APCDDMUP(T)
QUIT
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVXAM("AD",APCDVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVXAM(X,0),U)=APCDMTYP
SET G=1
+8 IF G
SET T="Already have a depression screening exam 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.13 (ADD)]"
+13 SET APCDALVR("APCDTEX")="`"_APCDMTYP
+14 SET APCDALVR("APCDTRES")=$PIECE(APCDREC,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^APCDDMUP(T)
+17 KILL APCDALVR
+18 QUIT
DENTAL ;EP
+1 KILL APCDVSIT
+2 IF $PIECE(APCDREC,U,13)=""
QUIT
+3 SET APCDDMDT=$PIECE(APCDREC,U,13)
+4 SET APCDMTYP=$ORDER(^AUTTEXAM("B","DENTAL EXAM",0))
+5 IF 'APCDMTYP
SET APCDMTYP=$ORDER(^AUTTEXAM("C",30,0))
+6 ;get event visit
DO EVSIT^APCDDMUP
+7 IF '$GET(APCDVSIT)
SET T="Could not Create PCC Visit when attempting to update dental exam."
DO ERR^APCDDMUP(T)
QUIT
+8 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVXAM("AD",APCDVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVXAM(X,0),U)=APCDMTYP
SET G=1
+9 IF G
SET T="Already have a dental exam 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.13 (ADD)]"
+14 SET APCDALVR("APCDTEX")="`"_APCDMTYP
+15 DO ^APCDALVR
+16 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Exam Entry for Dental Exam. PCC not updated."
DO ERR^APCDDMUP(T)
+17 KILL APCDALVR
+18 QUIT
PAP ;EP
+1 KILL APCDVSIT
+2 IF $PIECE(APCDREC,U,14)=""
QUIT
+3 SET APCDDMDT=$PIECE(APCDREC,U,14)
+4 SET APCDMTYP=$PIECE($$ICDOP^ICDCODE("91.46"),U,1)
+5 IF APCDMTYP=-1
SET APCDMTYP=""
+6 ;get event visit
DO EVSIT^APCDDMUP
+7 IF '$GET(APCDVSIT)
SET T="Could not Create PCC Visit when attempting to update pap procedure."
DO ERR^APCDDMUP(T)
QUIT
+8 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVPRC("AD",APCDVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVPRC(X,0),U)=APCDMTYP
SET G=1
+9 IF G
SET T="Already have a pap procedure 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.08 (ADD)]"
+14 SET APCDALVR("APCDTPRC")="`"_APCDMTYP
+15 ;S APCDALVR("APCDTNQ")=$P(^ICD0(APCDMTYP,0),U,4)
+16 SET APCDALVR("APCDTNQ")=$PIECE($$ICDOP^ICDCODE(APCDMTYP,$$VD^APCLV(APCDVSIT)),U,3)
+17 SET APCDALVR("APCDTPD")=$$FMTE^XLFDT(APCDDMDT)
+18 DO ^APCDALVR
+19 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Procedure Entry for PAP Procedure. PCC not updated."
DO ERR^APCDDMUP(T)
+20 KILL APCDALVR
+21 QUIT
MAM ;EP
+1 KILL APCDVSIT
+2 IF $PIECE(APCDREC,U,15)=""
QUIT
+3 IF $PIECE(APCDREC,U,24)=""
QUIT
+4 SET APCDDMDT=$PIECE(APCDREC,U,15)
+5 SET APCDMTYP=$PIECE(APCDREC,U,24)
+6 ;get event visit
DO EVSIT^APCDDMUP
+7 IF '$GET(APCDVSIT)
SET T="Could not Create PCC Visit when attempting to update mammogram procedure."
DO ERR^APCDDMUP(T)
QUIT
+8 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVRAD("AD",APCDVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVRAD(X,0),U)=APCDMTYP
SET G=1
+9 IF G
SET T="Already have a Mammogram 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.22 (ADD)]"
+14 SET APCDALVR("APCDTRAD")="`"_APCDMTYP
+15 DO ^APCDALVR
+16 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Radiology Entry for MAMMOGRAM. PCC not updated."
DO ERR^APCDDMUP(T)
+17 KILL APCDALVR
+18 QUIT
FLU ;EP
+1 KILL APCDVSIT
+2 IF $PIECE(APCDREC,U,16)=""!($PIECE(APCDREC1,U,11)="")
QUIT
+3 SET APCDDMDT=$PIECE(APCDREC,U,16)
+4 SET APCDMTYP=$PIECE(APCDREC1,U,11)
+5 ;get event visit
DO EVSIT^APCDDMUP
+6 IF '$GET(APCDVSIT)
SET T="Could not Create PCC Visit when attempting to update Flu Immunization."
DO ERR^APCDDMUP(T)
QUIT
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVIMM("AD",APCDVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVIMM(X,0),U)=APCDMTYP
SET G=1
+8 IF G
SET T="Already have a flu immunization 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.11 (ADD)]"
+13 SET APCDALVR("APCDTIMM")="`"_APCDMTYP
+14 DO ^APCDALVR
+15 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Immunization Entry for Flu Immunization. PCC not updated."
DO ERR^APCDDMUP(T)
+16 KILL APCDALVR
+17 QUIT
PNEU ;EP
+1 KILL APCDVSIT
+2 IF $PIECE(APCDREC,U,17)=""!($PIECE(APCDREC1,U,12)="")
QUIT
+3 SET APCDDMDT=$PIECE(APCDREC,U,17)
+4 SET APCDMTYP=$PIECE(APCDREC1,U,12)
+5 ;get event visit
DO EVSIT^APCDDMUP
+6 IF '$GET(APCDVSIT)
SET T="Could not Create PCC Visit when attempting to update Pneumovac Immunization."
DO ERR^APCDDMUP(T)
QUIT
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVIMM("AD",APCDVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVIMM(X,0),U)=APCDMTYP
SET G=1
+8 IF G
SET T="Already have a pneumovac immunization 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.11 (ADD)]"
+13 SET APCDALVR("APCDTIMM")="`"_APCDMTYP
+14 DO ^APCDALVR
+15 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Immunization Entry for Pneumovac Immunization. PCC not updated."
DO ERR^APCDDMUP(T)
+16 KILL APCDALVR
+17 QUIT
TD ;EP
+1 KILL APCDVSIT
+2 IF $PIECE(APCDREC,U,18)=""!($PIECE(APCDREC1,U,13)="")
QUIT
+3 SET APCDDMDT=$PIECE(APCDREC,U,18)
+4 SET APCDMTYP=$PIECE(APCDREC1,U,13)
+5 ;get event visit
DO EVSIT^APCDDMUP
+6 IF '$GET(APCDVSIT)
SET T="Could not Create PCC Visit when attempting to update Pneumovac Immunization."
DO ERR^APCDDMUP(T)
QUIT
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVIMM("AD",APCDVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVIMM(X,0),U)=APCDMTYP
SET G=1
+8 IF G
SET T="Already have a TD immunization 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.11 (ADD)]"
+13 SET APCDALVR("APCDTIMM")="`"_APCDMTYP
+14 DO ^APCDALVR
+15 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Immunization Entry for TD Immunization. PCC not updated."
DO ERR^APCDDMUP(T)
+16 KILL APCDALVR
+17 QUIT
ID ;
+1 IF $EXTRACT(APCDDMDT,6,7)="00"
SET APCDDMDT=$EXTRACT(APCDDMDT,1,5)_"01"
IF $EXTRACT(APCDDMDT,4,5)="00"
SET APCDDMDT=$EXTRACT(APCDDMDT,1,3)_"01"_$EXTRACT(APCDDMDT,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 ;
