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
