APCDDMU1.m

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

 ;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009

 ;

FOOT ;EP

 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       ;

FOOT      ;EP

 +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       ;