BDMEDMU1.m

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

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**7,8**;JUN 14, 2007;Build 53

 ;

FOOT ;EP

 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       ;

FOOT      ;EP

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