BJPC2ENP.m

BJPC2ENP ; IHS/CMI/LAB - PCC Suite v1.0 patch 1 environment check ;

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

 ;

 ;

 ;

PRE ;EP 

 ;DD deletion

 NEW DIU

 S DIU=9001025,DIU(0)="" D EN^DIU2

 S DIU=9001025.05,DIU(0)="" D EN^DIU2

 S DIU=9001026,DIU(0)="" D EN^DIU2

 ;

 S BJPCDA=0 F  S BJPCDA=$O(^APCDTHFD(BJPCDA)) Q:BJPCDA'=+BJPCDA  S DA=BJPCDA,DIK="^APCDTHFD(" D ^DIK

 S BJPCDA=0 F  S BJPCDA=$O(^APCDINPT(BJPCDA)) Q:BJPCDA'=+BJPCDA  S DA=BJPCDA,DIK="^APCDINPT(" D ^DIK

 S BJPCDA=0 F  S BJPCDA=$O(^APCLVSTS(BJPCDA)) Q:BJPCDA'=+BJPCDA  S DA=BJPCDA,DIK="^APCLVSTS(" D ^DIK

 S BJPCDA=0 F  S BJPCDA=$O(^APCLCNTL(BJPCDA)) Q:BJPCDA'=+BJPCDA  S DA=BJPCDA,DIK="^APCLCNTL(" D ^DIK

 S BJPCDA=0 F  S BJPCDA=$O(^APCLRECD(BJPCDA)) Q:BJPCDA'=+BJPCDA  S DA=BJPCDA,DIK="^APCLRECD(" D ^DIK

 S BJPCDA=0 F  S BJPCDA=$O(^APCLDMTX(BJPCDA)) Q:BJPCDA'=+BJPCDA  S DA=BJPCDA,DIK="^APCLDMTX(" D ^DIK

 S BJPCDA=0 F  S BJPCDA=$O(^APCLBMI(BJPCDA)) Q:BJPCDA'=+BJPCDA  S DA=BJPCDA,DIK="^APCLBMI(" D ^DIK

 S BJPCDA=0 F  S BJPCDA=$O(^APCLPDES(BJPCDA)) Q:BJPCDA'=+BJPCDA  S DA=BJPCDA,DIK="^APCLPDES(" D ^DIK

 S BJPCDA=0 F  S BJPCDA=$O(^APCCTXC(BJPCDA)) Q:BJPCDA'=+BJPCDA  S DA=BJPCDA,DIK="^APCCTXC(" D ^DIK

 S BJPCDA=0 F  S BJPCDA=$O(^APCLGENG(BJPCDA)) Q:BJPCDA'=+BJPCDA  S DA=BJPCDA,DIK="^APCLGENG(" D ^DIK

 S DIU="^APCDINPT(",DIU(0)="" D EN^DIU2

 S DA=$O(^DIC(19,"B","BDP INPUT CATEGORY",0)) I DA S DIE="^DIC(19,",DR="1///Add/Edit Provider Categories" D ^DIE K DIE,DA,DR

 ;save off hmr status value

 S DA=$O(^APCDSTGC("B","ASTHMA",0)) I DA S DIK="^APCDSTGC(" D ^DIK  ;delete asthma for pov stage

 ;

 S X="ASTHMA PATIENT-FLU SHOT",DIC="^APCHSURV(",DIC(0)="M" D ^DIC I Y'=-1 S DA=+Y I DA S DIE="^APCHSURV(",DR=".01///ASTHMA: FLU SHOT;.04///@" D ^DIE K DIE,DA,DR

 S X="ASTHMA - MANAGEMENT PLAN",DIC="^APCHSURV(",DIC(0)="M" D ^DIC I Y'=-1 S DA=+Y I DA S DIE="^APCHSURV(",DR=".01///ASTHMA: ACTION PLAN;.04///@" D ^DIE K DIE,DA,DR

 S X="ASTHMA - ADD/INCREASE INHALED STEROIDS",DIC="^APCHSURV(",DIC(0)="M" D ^DIC I Y'=-1 S DA=+Y I DA S DIE="^APCHSURV(",DR=".01///ASTHMA: ADD/INCREASE INHALED STEROIDS;.04///@" D ^DIE K DIE,DA,DR

 S X="ASTHMA - PRIMARY CARE PROVIDER",DIC="^APCHSURV(",DIC(0)="M" D ^DIC I Y'=-1 S DA=+Y I DA S DIE="^APCHSURV(",DR=".01///ASTHMA: PRIMARY CARE PROVIDER;.04///@" D ^DIE K DIE,DA,DR

 S X="ASTHMA - SEVERITY CLASSIFICATION",DIC="^APCHSURV(",DIC(0)="M" D ^DIC I Y'=-1 S DA=+Y I DA S DIE="^APCHSURV(",DR=".01///ASTHMA: SEVERITY CLASSIFICATION;.04///@" D ^DIE K DIE,DA,DR

 S X="ASTHMA ACTION PLAN",DIC="^APCHSURV(",DIC(0)="M" D ^DIC I Y'=-1 S DA=+Y I DA S DIE="^APCHSURV(",DR=".01///ASTHMA: ACTION PLAN;.04///@" D ^DIE K DIE,DA,DR

 S X="ASTHMA CONTROL CLASSIFICATION",DIC="^APCHSURV(",DIC(0)="M" D ^DIC I Y'=-1 S DA=+Y I DA S DIE="^APCHSURV(",DR=".01///ASTHMA: CONTROL CLASSIFICATION;.04///@" D ^DIE K DIE,DA,DR

 S X="ASTHMA FLU SHOT",DIC="^APCHSURV(",DIC(0)="M" D ^DIC I Y'=-1 S DA=+Y I DA S DIE="^APCHSURV(",DR=".01///ASTHMA: FLU SHOT;.04///@" D ^DIE K DIE,DA,DR

 S X="INCREASED RISK FOR ASTHMA EXACERBATION",DIC="^APCHSURV(",DIC(0)="M" D ^DIC I Y'=-1 S DA=+Y I DA S DIE="^APCHSURV(",DR=".01///ASTHMA: INCREASED RISK FOR EXACERBATION;.04///@" D ^DIE K DIE,DA,DR

 S X="RUBELLA VACCINATION",DIC="^APCHSURV(",DIC(0)="M" D ^DIC I Y'=-1 S DA=+Y I DA S DIE="^APCHSURV(",DR=".01///RUBELLA IMMUNIZATION (ADULT);.04///@" D ^DIE K DIE,DA,DR

 S X="NON-ENDEMIC TB",DIC="^APCHSURV(",DIC(0)="M" D ^DIC I Y'=-1 S DA=+Y I DA S DIE="^APCHSURV(",DR=".03///D" D ^DIE K DIE,DA,DR

 S DA=$O(^APCHSUP("B","ASTHMA",0)) I DA S DIE="^APCHSUP(",DR=".01///ASTHMA PATIENT CARE SUMMARY" D ^DIE K DIE,DA,DR

 S DA=$O(^APCHSCMP("B","FAMILY MEDICAL HISTORY",0)) I DA S DIE="^APCHSCMP(",DR=".01///FAMILY HEALTH HISTORY" D ^DIE

 S DA=$O(^APCHSCMP("B","TREATMENT PROMPTS",0)) I DA S DIE="^APCHSCMP(",DR=".01///BEST PRACTICE PROMPTS" D ^DIE

 K DIE,DA,DR

 ;SET REMINDERS TO DELETED IF THEY EXIST

 S X="REHAB/FUNCTIONAL SCREEN",DIC="^APCHSURV(",DIC(0)="M" D ^DIC I Y'=-1 S DA=+Y I DA S DIE="^APCHSURV(",DR=".03///D" D ^DIE K DIE,DA,DR

 S X="HEARING TEST ANNUAL",DIC="^APCHSURV(",DIC(0)="M" D ^DIC I Y'=-1 S DA=+Y I DA S DIE="^APCHSURV(",DR=".03///D" D ^DIE K DIE,DA,DR

 S X="ENDEMIC TB",DIC="^APCHSURV(",DIC(0)="M" D ^DIC I Y'=-1 S DA=+Y I DA S DIE="^APCHSURV(",DR=".03///D" D ^DIE K DIE,DA,DR

 K ^APCHTMP("HMR STATUS")

 S X=0 F  S X=$O(^APCHSURV(X)) Q:X'=+X  S ^APCHTMP("HMR STATUS",X)=$P(^APCHSURV(X,0),U)_U_$P(^APCHSURV(X,0),U,3)

 ;QMAN PRE

 NEW DA,DIE,DR

 S DA=$O(^APCDTKW("B","RHC",0))

 I DA S DIK="^APCDTKW(" D ^DIK

 D PRE^AMQQPOST

 D M^BJPC2EV3

 Q

BJPC2ENP  ; IHS/CMI/LAB - PCC Suite v1.0 patch 1 environment check ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

 +3       ;

 +4       ;

PRE       ;EP 

 +1       ;DD deletion

 +2        NEW DIU

 +3        SET DIU=9001025

           SET DIU(0)=""

           DO EN^DIU2

 +4        SET DIU=9001025.05

           SET DIU(0)=""

           DO EN^DIU2

 +5        SET DIU=9001026

           SET DIU(0)=""

           DO EN^DIU2

 +6       ;

 +7        SET BJPCDA=0

           FOR 

               SET BJPCDA=$ORDER(^APCDTHFD(BJPCDA))

               IF BJPCDA'=+BJPCDA

                   QUIT 

               SET DA=BJPCDA

               SET DIK="^APCDTHFD("

               DO ^DIK

 +8        SET BJPCDA=0

           FOR 

               SET BJPCDA=$ORDER(^APCDINPT(BJPCDA))

               IF BJPCDA'=+BJPCDA

                   QUIT 

               SET DA=BJPCDA

               SET DIK="^APCDINPT("

               DO ^DIK

 +9        SET BJPCDA=0

           FOR 

               SET BJPCDA=$ORDER(^APCLVSTS(BJPCDA))

               IF BJPCDA'=+BJPCDA

                   QUIT 

               SET DA=BJPCDA

               SET DIK="^APCLVSTS("

               DO ^DIK

 +10       SET BJPCDA=0

           FOR 

               SET BJPCDA=$ORDER(^APCLCNTL(BJPCDA))

               IF BJPCDA'=+BJPCDA

                   QUIT 

               SET DA=BJPCDA

               SET DIK="^APCLCNTL("

               DO ^DIK

 +11       SET BJPCDA=0

           FOR 

               SET BJPCDA=$ORDER(^APCLRECD(BJPCDA))

               IF BJPCDA'=+BJPCDA

                   QUIT 

               SET DA=BJPCDA

               SET DIK="^APCLRECD("

               DO ^DIK

 +12       SET BJPCDA=0

           FOR 

               SET BJPCDA=$ORDER(^APCLDMTX(BJPCDA))

               IF BJPCDA'=+BJPCDA

                   QUIT 

               SET DA=BJPCDA

               SET DIK="^APCLDMTX("

               DO ^DIK

 +13       SET BJPCDA=0

           FOR 

               SET BJPCDA=$ORDER(^APCLBMI(BJPCDA))

               IF BJPCDA'=+BJPCDA

                   QUIT 

               SET DA=BJPCDA

               SET DIK="^APCLBMI("

               DO ^DIK

 +14       SET BJPCDA=0

           FOR 

               SET BJPCDA=$ORDER(^APCLPDES(BJPCDA))

               IF BJPCDA'=+BJPCDA

                   QUIT 

               SET DA=BJPCDA

               SET DIK="^APCLPDES("

               DO ^DIK

 +15       SET BJPCDA=0

           FOR 

               SET BJPCDA=$ORDER(^APCCTXC(BJPCDA))

               IF BJPCDA'=+BJPCDA

                   QUIT 

               SET DA=BJPCDA

               SET DIK="^APCCTXC("

               DO ^DIK

 +16       SET BJPCDA=0

           FOR 

               SET BJPCDA=$ORDER(^APCLGENG(BJPCDA))

               IF BJPCDA'=+BJPCDA

                   QUIT 

               SET DA=BJPCDA

               SET DIK="^APCLGENG("

               DO ^DIK

 +17       SET DIU="^APCDINPT("

           SET DIU(0)=""

           DO EN^DIU2

 +18       SET DA=$ORDER(^DIC(19,"B","BDP INPUT CATEGORY",0))

           IF DA

               SET DIE="^DIC(19,"

               SET DR="1///Add/Edit Provider Categories"

               DO ^DIE

               KILL DIE,DA,DR

 +19      ;save off hmr status value

 +20      ;delete asthma for pov stage

           SET DA=$ORDER(^APCDSTGC("B","ASTHMA",0))

           IF DA

               SET DIK="^APCDSTGC("

               DO ^DIK

 +21      ;

 +22       SET X="ASTHMA PATIENT-FLU SHOT"

           SET DIC="^APCHSURV("

           SET DIC(0)="M"

           DO ^DIC

           IF Y'=-1

               SET DA=+Y

               IF DA

                   SET DIE="^APCHSURV("

                   SET DR=".01///ASTHMA: FLU SHOT;.04///@"

                   DO ^DIE

                   KILL DIE,DA,DR

 +23       SET X="ASTHMA - MANAGEMENT PLAN"

           SET DIC="^APCHSURV("

           SET DIC(0)="M"

           DO ^DIC

           IF Y'=-1

               SET DA=+Y

               IF DA

                   SET DIE="^APCHSURV("

                   SET DR=".01///ASTHMA: ACTION PLAN;.04///@"

                   DO ^DIE

                   KILL DIE,DA,DR

 +24       SET X="ASTHMA - ADD/INCREASE INHALED STEROIDS"

           SET DIC="^APCHSURV("

           SET DIC(0)="M"

           DO ^DIC

           IF Y'=-1

               SET DA=+Y

               IF DA

                   SET DIE="^APCHSURV("

                   SET DR=".01///ASTHMA: ADD/INCREASE INHALED STEROIDS;.04///@"

                   DO ^DIE

                   KILL DIE,DA,DR

 +25       SET X="ASTHMA - PRIMARY CARE PROVIDER"

           SET DIC="^APCHSURV("

           SET DIC(0)="M"

           DO ^DIC

           IF Y'=-1

               SET DA=+Y

               IF DA

                   SET DIE="^APCHSURV("

                   SET DR=".01///ASTHMA: PRIMARY CARE PROVIDER;.04///@"

                   DO ^DIE

                   KILL DIE,DA,DR

 +26       SET X="ASTHMA - SEVERITY CLASSIFICATION"

           SET DIC="^APCHSURV("

           SET DIC(0)="M"

           DO ^DIC

           IF Y'=-1

               SET DA=+Y

               IF DA

                   SET DIE="^APCHSURV("

                   SET DR=".01///ASTHMA: SEVERITY CLASSIFICATION;.04///@"

                   DO ^DIE

                   KILL DIE,DA,DR

 +27       SET X="ASTHMA ACTION PLAN"

           SET DIC="^APCHSURV("

           SET DIC(0)="M"

           DO ^DIC

           IF Y'=-1

               SET DA=+Y

               IF DA

                   SET DIE="^APCHSURV("

                   SET DR=".01///ASTHMA: ACTION PLAN;.04///@"

                   DO ^DIE

                   KILL DIE,DA,DR

 +28       SET X="ASTHMA CONTROL CLASSIFICATION"

           SET DIC="^APCHSURV("

           SET DIC(0)="M"

           DO ^DIC

           IF Y'=-1

               SET DA=+Y

               IF DA

                   SET DIE="^APCHSURV("

                   SET DR=".01///ASTHMA: CONTROL CLASSIFICATION;.04///@"

                   DO ^DIE

                   KILL DIE,DA,DR

 +29       SET X="ASTHMA FLU SHOT"

           SET DIC="^APCHSURV("

           SET DIC(0)="M"

           DO ^DIC

           IF Y'=-1

               SET DA=+Y

               IF DA

                   SET DIE="^APCHSURV("

                   SET DR=".01///ASTHMA: FLU SHOT;.04///@"

                   DO ^DIE

                   KILL DIE,DA,DR

 +30       SET X="INCREASED RISK FOR ASTHMA EXACERBATION"

           SET DIC="^APCHSURV("

           SET DIC(0)="M"

           DO ^DIC

           IF Y'=-1

               SET DA=+Y

               IF DA

                   SET DIE="^APCHSURV("

                   SET DR=".01///ASTHMA: INCREASED RISK FOR EXACERBATION;.04///@"

                   DO ^DIE

                   KILL DIE,DA,DR

 +31       SET X="RUBELLA VACCINATION"

           SET DIC="^APCHSURV("

           SET DIC(0)="M"

           DO ^DIC

           IF Y'=-1

               SET DA=+Y

               IF DA

                   SET DIE="^APCHSURV("

                   SET DR=".01///RUBELLA IMMUNIZATION (ADULT);.04///@"

                   DO ^DIE

                   KILL DIE,DA,DR

 +32       SET X="NON-ENDEMIC TB"

           SET DIC="^APCHSURV("

           SET DIC(0)="M"

           DO ^DIC

           IF Y'=-1

               SET DA=+Y

               IF DA

                   SET DIE="^APCHSURV("

                   SET DR=".03///D"

                   DO ^DIE

                   KILL DIE,DA,DR

 +33       SET DA=$ORDER(^APCHSUP("B","ASTHMA",0))

           IF DA

               SET DIE="^APCHSUP("

               SET DR=".01///ASTHMA PATIENT CARE SUMMARY"

               DO ^DIE

               KILL DIE,DA,DR

 +34       SET DA=$ORDER(^APCHSCMP("B","FAMILY MEDICAL HISTORY",0))

           IF DA

               SET DIE="^APCHSCMP("

               SET DR=".01///FAMILY HEALTH HISTORY"

               DO ^DIE

 +35       SET DA=$ORDER(^APCHSCMP("B","TREATMENT PROMPTS",0))

           IF DA

               SET DIE="^APCHSCMP("

               SET DR=".01///BEST PRACTICE PROMPTS"

               DO ^DIE

 +36       KILL DIE,DA,DR

 +37      ;SET REMINDERS TO DELETED IF THEY EXIST

 +38       SET X="REHAB/FUNCTIONAL SCREEN"

           SET DIC="^APCHSURV("

           SET DIC(0)="M"

           DO ^DIC

           IF Y'=-1

               SET DA=+Y

               IF DA

                   SET DIE="^APCHSURV("

                   SET DR=".03///D"

                   DO ^DIE

                   KILL DIE,DA,DR

 +39       SET X="HEARING TEST ANNUAL"

           SET DIC="^APCHSURV("

           SET DIC(0)="M"

           DO ^DIC

           IF Y'=-1

               SET DA=+Y

               IF DA

                   SET DIE="^APCHSURV("

                   SET DR=".03///D"

                   DO ^DIE

                   KILL DIE,DA,DR

 +40       SET X="ENDEMIC TB"

           SET DIC="^APCHSURV("

           SET DIC(0)="M"

           DO ^DIC

           IF Y'=-1

               SET DA=+Y

               IF DA

                   SET DIE="^APCHSURV("

                   SET DR=".03///D"

                   DO ^DIE

                   KILL DIE,DA,DR

 +41       KILL ^APCHTMP("HMR STATUS")

 +42       SET X=0

           FOR 

               SET X=$ORDER(^APCHSURV(X))

               IF X'=+X

                   QUIT 

               SET ^APCHTMP("HMR STATUS",X)=$PIECE(^APCHSURV(X,0),U)_U_$PIECE(^APCHSURV(X,0),U,3)

 +43      ;QMAN PRE

 +44       NEW DA,DIE,DR

 +45       SET DA=$ORDER(^APCDTKW("B","RHC",0))

 +46       IF DA

               SET DIK="^APCDTKW("

               DO ^DIK

 +47       DO PRE^AMQQPOST

 +48       DO M^BJPC2EV3

 +49       QUIT