APCH2P11 ; IHS/TUCSON/LAB - PCC HEALTH SUMMARY POST INIT PATCH 11 ; [ 04/14/04 3:14 PM ]
;;2.0;IHS RPMS/PCC Health Summary;**11**;JUN 24, 1997
;
;
; The following line prevents the "Disable Options..." and "Move
; Routines..." questions from being asked during the install.
I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
;
Q
PRE ;EP
S DA=$O(^APCHSCMP("B","MENTAL HEALTH/SOCIAL SERVICES",0))
I DA S DIE="^APCHSCMP(",DR=".01///BEHAVIORAL HEALTH" D ^DIE K DIE,DA,DR
Q
POST ;EP
NEW X
S X=$$ADD^XPDMENU("APCHSBLD","APCHSTED FM","FMMT")
I 'X W "Attempt to add modify health summary option option failed." H 3
S X=$$ADD^XPDMENU("APCHSMAINT","APCHSTED FM","FMMT")
I 'X W "Attempt to add modify health summary option option failed." H 3
I '$O(^APCHSCMP("B","MEDS - CHRONIC & ACUTE W/ ISSU",0)) D
.D ^XBFMK S DIC="^APCHSCMP(",X="MEDS - CHRONIC & ACUTE W/ ISSUE HISTORY",DIC("DR")="2////Y",DIC(0)="L" K DD,DO,D0 D FILE^DICN
.I Y=-1 W !!,"adding health summary component MEDS - CHRONIC & ACUTE W/ ISSUE HISTORY failed." D ^XBFMK Q
.S $P(^APCHSCMP(+Y,0),U,2)="MEDSNDUP;APCHS78"
I '$O(^APCHSCMP("B","MEDS - CHRONIC BY NAME",0)) D
.D ^XBFMK S DIC="^APCHSCMP(",X="MEDS - CHRONIC BY NAME",DIC("DR")="2////Y;3////CHRONIC MEDICATIONS - SORTED BY DRUG NAME",DIC(0)="L" K DD,DO,D0 D FILE^DICN
.I Y=-1 W !!,"adding health summary component MEDS - CHRONIC BY NAME failed." D ^XBFMK Q
.S $P(^APCHSCMP(+Y,0),U,2)="MEDSCHRN;APCHS77"
I '$O(^APCHSCMP("B","MEDS - CURRENT BY NAME",0)) D
.D ^XBFMK S DIC="^APCHSCMP(",X="MEDS - CURRENT BY NAME",DIC("DR")="2////Y;3////CURRENT MEDICATIONS - SORTED BY DRUG NAME",DIC(0)="L" K DD,DO,D0 D FILE^DICN
.I Y=-1 W !!,"adding health summary component MEDS - CURRENT BY NAME failed." D ^XBFMK Q
.S $P(^APCHSCMP(+Y,0),U,2)="MEDSCURR;APCHS77"
S DIK="^APCHSCTL(" D IXALL^DIK
S DIK="^APCHSURV(" D IXALL^DIK
DUPE ;
K APCHY,APCHZ S APCHX=0,APCHC=0 F S APCHX=$O(^APCHSCMP(APCHX)) Q:APCHX'=+APCHX D
.I $P(^APCHSCMP(APCHX,0),U)'="MEDS - CHRONIC EXCLUDING D/C'ED MEDS" Q
.S APCHC=APCHC+1,APCHY(APCHC)=APCHX,APCHZ(APCHX)=""
I APCHC>1 D
.;loop through types and change to first one
.S APCHUSE=APCHY(1)
.K APCHZ(APCHY(1)),APCHY(1)
.S APCHT=0 F S APCHT=$O(^APCHSCTL(APCHT)) Q:APCHT'=+APCHT D
..S APCH1=0 F S APCH1=$O(^APCHSCTL(APCHT,1,APCH1)) Q:APCH1'=+APCH1 D
...S APCH2=$P(^APCHSCTL(APCHT,1,APCH1,0),U,2)
...Q:'$D(APCHZ(APCH2))
...S DIE="^APCHSCTL("_APCHT_",1,",DA=APCH1,DA(1)=APCHT,DR="1////"_APCHUSE D ^DIE
.S DA=0 F S DA=$O(APCHZ(DA)) Q:DA'=+DA S DIK="^APCHSCMP(" D ^DIK
K APCHY,APCHZ S APCHX=0,APCHC=0 F S APCHX=$O(^APCHSCMP(APCHX)) Q:APCHX'=+APCHX D
.I $P(^APCHSCMP(APCHX,0),U)'="PATIENT ED - MOST RECENT BY TOPIC" Q
.S APCHC=APCHC+1,APCHY(APCHC)=APCHX,APCHZ(APCHX)=""
I APCHC>1 D
.;loop through types and change to first one
.S APCHUSE=APCHY(1)
.K APCHZ(APCHY(1)),APCHY(1)
.S APCHT=0 F S APCHT=$O(^APCHSCTL(APCHT)) Q:APCHT'=+APCHT D
..S APCH1=0 F S APCH1=$O(^APCHSCTL(APCHT,1,APCH1)) Q:APCH1'=+APCH1 D
...S APCH2=$P(^APCHSCTL(APCHT,1,APCH1,0),U,2)
...Q:'$D(APCHZ(APCH2))
...S DIE="^APCHSCTL("_APCHT_",1,",DA=APCH1,DA(1)=APCHT,DR="1////"_APCHUSE D ^DIE
.S DA=0 F S DA=$O(APCHZ(DA)) Q:DA'=+DA S DIK="^APCHSCMP(" D ^DIK
S APCHST="CAT" F APCHSX=1:1:999 S APCH1=$P($T(@APCHST+APCHSX),";;",2,99) Q:APCH1="" D
.K DIC S X=$P(APCH1,";;",1),DIC="^APCHSURV(",DIC(0)="M" D ^DIC K DIC
.I Y=-1 Q
.S DA=+Y,DR=".05///"_$P(APCH1,";;",2),DIE="^APCHSURV(" D ^DIE K DIE,DA,DR
.I $D(Y) W !,"category not updated. ",X
.Q
S DA=$O(^APCHSURV("B","IHD-Elevated LDL Prompt",0))
I DA S DR=".03///I",DIE="^APCHSURV(" D ^DIE K DIE,DA,DR
S DA=$O(^APCHSURV("B","IHD-LDL Screening",0))
I DA S DR=".03///I",DIE="^APCHSURV(" D ^DIE K DIE,DA,DR
S DA=$O(^APCHSURV("B","ADULT MMR 1-DOSE VERSION",0))
I DA S DR=".03///I",DIE="^APCHSURV(" D ^DIE K DIE,DA,DR
S DA=$O(^APCHSURV("B","ADULT MMR 2-DOSE VERSION",0))
I DA S DR=".03///I",DIE="^APCHSURV(" D ^DIE K DIE,DA,DR
S DA=$O(^APCHSURV("B","RUBELLA VACCINATION",0))
I DA S DR=".03///I",DIE="^APCHSURV(" D ^DIE K DIE,DA,DR
BUL ;
D ^APCHBU11
Q
;
CAT ;
;;BREAST EXAM;;GENERAL
;;DIABETES SCREENING;;DIABETES
;;BLOOD PRESSURE;;GENERAL
;;PAP SMEAR;;GENERAL
;;RECTAL;;GENERAL
;;TONOMETRY;;GENERAL
;;URINALYSIS;;GENERAL
;;PELVIC EXAM;;GENERAL
;;VISUAL ACUITY EXAM;;GENERAL
;;HEARING TEST;;GENERAL
;;HCT/HGB;;GENERAL
;;ENDEMIC TB;;GENERAL
;;NON-ENDEMIC TB;;GENERAL
;;HEAD CIRCUMFERENCE;;GENERAL
;;HEIGHT;;GENERAL
;;WEIGHT;;GENERAL
;;IMMUNIZATIONS;;GENERAL
;;HEARING TEST ANNUAL;;GENERAL
;;MAMMOGRAM;;GENERAL
;;PNEUMOVAX;;GENERAL
;;DM FOOT EXAM;;
;;DM EYE EXAM;;
;;SCREEN FOR ALCOHOL USE;;GENERAL
;;SCREEN FOR TOBACCO USE;;GENERAL
;;DM CHOLESTEROL;;
;;DM CREATININE;;
;;DM TRIGLYCERIDE;;
;;DM DENTAL EXAM;;
;;PHYSICAL EXAM;;GENERAL
;;TD-ADULT;;GENERAL
;;INFLUENZA;;GENERAL
;;COLORECTAL CA SCRN-FOBT;;GENERAL
;;CHOLESTEROL;;GENERAL
;;DM URINE PROTEIN;;
;;COLORECTAL CA-SCOPE/XRAY;;GENERAL
;;ALASKA DOMESTIC VIOLENCE;;GENERAL
;;HEARING INQUIRY;;GENERAL
;;STRABISMUS/AMBLYOPIA SCREEN;;GENERAL
;;PPD - TUBERCULOSIS;;GENERAL
;;ANMC DEPRESSION SCREEN SCORE;;GENERAL
;;REHAB/FUNCTIONAL SCREEN;;GENERAL
;;ANMC COLORECTAL;;GENERAL
;;ASTHMA - ADD/INCREASE INHALED STERIODS;;ASTHMA
;;ASTHMA - PRIMARY CARE PROVIDER;;ASTHMA
;;ASTHMA - SEVERITY CLASSIFICATION;;ASTHMA
;;ASTHMA - MANAGEMENT PLAN;;ASTHMA
;;ASTHMA PATIENT-FLU SHOT;;ASTHMA
;;IHD-LDL Screening;;CARDIOVASCULAR DISEASE
;;IHD-Elevated LDL Prompt;;CARDIOVASCULAR DISEASE
;;ADULT MMR 1-DOSE VERSION;;GENERAL
;;ADULT MMR 2-DOSE VERSION;;GENERAL
;;RUBELLA VACCINATION;;GENERAL
;;
APCH2P11 ; IHS/TUCSON/LAB - PCC HEALTH SUMMARY POST INIT PATCH 11 ; [ 04/14/04 3:14 PM ]
+1 ;;2.0;IHS RPMS/PCC Health Summary;**11**;JUN 24, 1997
+2 ;
+3 ;
+4 ; The following line prevents the "Disable Options..." and "Move
+5 ; Routines..." questions from being asked during the install.
+6 IF $GET(XPDENV)=1
SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+7 ;
+8 QUIT
PRE ;EP
+1 SET DA=$ORDER(^APCHSCMP("B","MENTAL HEALTH/SOCIAL SERVICES",0))
+2 IF DA
SET DIE="^APCHSCMP("
SET DR=".01///BEHAVIORAL HEALTH"
DO ^DIE
KILL DIE,DA,DR
+3 QUIT
POST ;EP
+1 NEW X
+2 SET X=$$ADD^XPDMENU("APCHSBLD","APCHSTED FM","FMMT")
+3 IF 'X
WRITE "Attempt to add modify health summary option option failed."
HANG 3
+4 SET X=$$ADD^XPDMENU("APCHSMAINT","APCHSTED FM","FMMT")
+5 IF 'X
WRITE "Attempt to add modify health summary option option failed."
HANG 3
+6 IF '$ORDER(^APCHSCMP("B","MEDS - CHRONIC & ACUTE W/ ISSU",0))
Begin DoDot:1
+7 DO ^XBFMK
SET DIC="^APCHSCMP("
SET X="MEDS - CHRONIC & ACUTE W/ ISSUE HISTORY"
SET DIC("DR")="2////Y"
SET DIC(0)="L"
KILL DD,DO,D0
DO FILE^DICN
+8 IF Y=-1
WRITE !!,"adding health summary component MEDS - CHRONIC & ACUTE W/ ISSUE HISTORY failed."
DO ^XBFMK
QUIT
+9 SET $PIECE(^APCHSCMP(+Y,0),U,2)="MEDSNDUP;APCHS78"
End DoDot:1
+10 IF '$ORDER(^APCHSCMP("B","MEDS - CHRONIC BY NAME",0))
Begin DoDot:1
+11 DO ^XBFMK
SET DIC="^APCHSCMP("
SET X="MEDS - CHRONIC BY NAME"
SET DIC("DR")="2////Y;3////CHRONIC MEDICATIONS - SORTED BY DRUG NAME"
SET DIC(0)="L"
KILL DD,DO,D0
DO FILE^DICN
+12 IF Y=-1
WRITE !!,"adding health summary component MEDS - CHRONIC BY NAME failed."
DO ^XBFMK
QUIT
+13 SET $PIECE(^APCHSCMP(+Y,0),U,2)="MEDSCHRN;APCHS77"
End DoDot:1
+14 IF '$ORDER(^APCHSCMP("B","MEDS - CURRENT BY NAME",0))
Begin DoDot:1
+15 DO ^XBFMK
SET DIC="^APCHSCMP("
SET X="MEDS - CURRENT BY NAME"
SET DIC("DR")="2////Y;3////CURRENT MEDICATIONS - SORTED BY DRUG NAME"
SET DIC(0)="L"
KILL DD,DO,D0
DO FILE^DICN
+16 IF Y=-1
WRITE !!,"adding health summary component MEDS - CURRENT BY NAME failed."
DO ^XBFMK
QUIT
+17 SET $PIECE(^APCHSCMP(+Y,0),U,2)="MEDSCURR;APCHS77"
End DoDot:1
+18 SET DIK="^APCHSCTL("
DO IXALL^DIK
+19 SET DIK="^APCHSURV("
DO IXALL^DIK
DUPE ;
+1 KILL APCHY,APCHZ
SET APCHX=0
SET APCHC=0
FOR
SET APCHX=$ORDER(^APCHSCMP(APCHX))
IF APCHX'=+APCHX
QUIT
Begin DoDot:1
+2 IF $PIECE(^APCHSCMP(APCHX,0),U)'="MEDS - CHRONIC EXCLUDING D/C'ED MEDS"
QUIT
+3 SET APCHC=APCHC+1
SET APCHY(APCHC)=APCHX
SET APCHZ(APCHX)=""
End DoDot:1
+4 IF APCHC>1
Begin DoDot:1
+5 ;loop through types and change to first one
+6 SET APCHUSE=APCHY(1)
+7 KILL APCHZ(APCHY(1)),APCHY(1)
+8 SET APCHT=0
FOR
SET APCHT=$ORDER(^APCHSCTL(APCHT))
IF APCHT'=+APCHT
QUIT
Begin DoDot:2
+9 SET APCH1=0
FOR
SET APCH1=$ORDER(^APCHSCTL(APCHT,1,APCH1))
IF APCH1'=+APCH1
QUIT
Begin DoDot:3
+10 SET APCH2=$PIECE(^APCHSCTL(APCHT,1,APCH1,0),U,2)
+11 IF '$DATA(APCHZ(APCH2))
QUIT
+12 SET DIE="^APCHSCTL("_APCHT_",1,"
SET DA=APCH1
SET DA(1)=APCHT
SET DR="1////"_APCHUSE
DO ^DIE
End DoDot:3
End DoDot:2
+13 SET DA=0
FOR
SET DA=$ORDER(APCHZ(DA))
IF DA'=+DA
QUIT
SET DIK="^APCHSCMP("
DO ^DIK
End DoDot:1
+14 KILL APCHY,APCHZ
SET APCHX=0
SET APCHC=0
FOR
SET APCHX=$ORDER(^APCHSCMP(APCHX))
IF APCHX'=+APCHX
QUIT
Begin DoDot:1
+15 IF $PIECE(^APCHSCMP(APCHX,0),U)'="PATIENT ED - MOST RECENT BY TOPIC"
QUIT
+16 SET APCHC=APCHC+1
SET APCHY(APCHC)=APCHX
SET APCHZ(APCHX)=""
End DoDot:1
+17 IF APCHC>1
Begin DoDot:1
+18 ;loop through types and change to first one
+19 SET APCHUSE=APCHY(1)
+20 KILL APCHZ(APCHY(1)),APCHY(1)
+21 SET APCHT=0
FOR
SET APCHT=$ORDER(^APCHSCTL(APCHT))
IF APCHT'=+APCHT
QUIT
Begin DoDot:2
+22 SET APCH1=0
FOR
SET APCH1=$ORDER(^APCHSCTL(APCHT,1,APCH1))
IF APCH1'=+APCH1
QUIT
Begin DoDot:3
+23 SET APCH2=$PIECE(^APCHSCTL(APCHT,1,APCH1,0),U,2)
+24 IF '$DATA(APCHZ(APCH2))
QUIT
+25 SET DIE="^APCHSCTL("_APCHT_",1,"
SET DA=APCH1
SET DA(1)=APCHT
SET DR="1////"_APCHUSE
DO ^DIE
End DoDot:3
End DoDot:2
+26 SET DA=0
FOR
SET DA=$ORDER(APCHZ(DA))
IF DA'=+DA
QUIT
SET DIK="^APCHSCMP("
DO ^DIK
End DoDot:1
+27 SET APCHST="CAT"
FOR APCHSX=1:1:999
SET APCH1=$PIECE($TEXT(@APCHST+APCHSX),";;",2,99)
IF APCH1=""
QUIT
Begin DoDot:1
+28 KILL DIC
SET X=$PIECE(APCH1,";;",1)
SET DIC="^APCHSURV("
SET DIC(0)="M"
DO ^DIC
KILL DIC
+29 IF Y=-1
QUIT
+30 SET DA=+Y
SET DR=".05///"_$PIECE(APCH1,";;",2)
SET DIE="^APCHSURV("
DO ^DIE
KILL DIE,DA,DR
+31 IF $DATA(Y)
WRITE !,"category not updated. ",X
+32 QUIT
End DoDot:1
+33 SET DA=$ORDER(^APCHSURV("B","IHD-Elevated LDL Prompt",0))
+34 IF DA
SET DR=".03///I"
SET DIE="^APCHSURV("
DO ^DIE
KILL DIE,DA,DR
+35 SET DA=$ORDER(^APCHSURV("B","IHD-LDL Screening",0))
+36 IF DA
SET DR=".03///I"
SET DIE="^APCHSURV("
DO ^DIE
KILL DIE,DA,DR
+37 SET DA=$ORDER(^APCHSURV("B","ADULT MMR 1-DOSE VERSION",0))
+38 IF DA
SET DR=".03///I"
SET DIE="^APCHSURV("
DO ^DIE
KILL DIE,DA,DR
+39 SET DA=$ORDER(^APCHSURV("B","ADULT MMR 2-DOSE VERSION",0))
+40 IF DA
SET DR=".03///I"
SET DIE="^APCHSURV("
DO ^DIE
KILL DIE,DA,DR
+41 SET DA=$ORDER(^APCHSURV("B","RUBELLA VACCINATION",0))
+42 IF DA
SET DR=".03///I"
SET DIE="^APCHSURV("
DO ^DIE
KILL DIE,DA,DR
BUL ;
+1 DO ^APCHBU11
+2 QUIT
+3 ;
CAT ;
+1 ;;BREAST EXAM;;GENERAL
+2 ;;DIABETES SCREENING;;DIABETES
+3 ;;BLOOD PRESSURE;;GENERAL
+4 ;;PAP SMEAR;;GENERAL
+5 ;;RECTAL;;GENERAL
+6 ;;TONOMETRY;;GENERAL
+7 ;;URINALYSIS;;GENERAL
+8 ;;PELVIC EXAM;;GENERAL
+9 ;;VISUAL ACUITY EXAM;;GENERAL
+10 ;;HEARING TEST;;GENERAL
+11 ;;HCT/HGB;;GENERAL
+12 ;;ENDEMIC TB;;GENERAL
+13 ;;NON-ENDEMIC TB;;GENERAL
+14 ;;HEAD CIRCUMFERENCE;;GENERAL
+15 ;;HEIGHT;;GENERAL
+16 ;;WEIGHT;;GENERAL
+17 ;;IMMUNIZATIONS;;GENERAL
+18 ;;HEARING TEST ANNUAL;;GENERAL
+19 ;;MAMMOGRAM;;GENERAL
+20 ;;PNEUMOVAX;;GENERAL
+21 ;;DM FOOT EXAM;;
+22 ;;DM EYE EXAM;;
+23 ;;SCREEN FOR ALCOHOL USE;;GENERAL
+24 ;;SCREEN FOR TOBACCO USE;;GENERAL
+25 ;;DM CHOLESTEROL;;
+26 ;;DM CREATININE;;
+27 ;;DM TRIGLYCERIDE;;
+28 ;;DM DENTAL EXAM;;
+29 ;;PHYSICAL EXAM;;GENERAL
+30 ;;TD-ADULT;;GENERAL
+31 ;;INFLUENZA;;GENERAL
+32 ;;COLORECTAL CA SCRN-FOBT;;GENERAL
+33 ;;CHOLESTEROL;;GENERAL
+34 ;;DM URINE PROTEIN;;
+35 ;;COLORECTAL CA-SCOPE/XRAY;;GENERAL
+36 ;;ALASKA DOMESTIC VIOLENCE;;GENERAL
+37 ;;HEARING INQUIRY;;GENERAL
+38 ;;STRABISMUS/AMBLYOPIA SCREEN;;GENERAL
+39 ;;PPD - TUBERCULOSIS;;GENERAL
+40 ;;ANMC DEPRESSION SCREEN SCORE;;GENERAL
+41 ;;REHAB/FUNCTIONAL SCREEN;;GENERAL
+42 ;;ANMC COLORECTAL;;GENERAL
+43 ;;ASTHMA - ADD/INCREASE INHALED STERIODS;;ASTHMA
+44 ;;ASTHMA - PRIMARY CARE PROVIDER;;ASTHMA
+45 ;;ASTHMA - SEVERITY CLASSIFICATION;;ASTHMA
+46 ;;ASTHMA - MANAGEMENT PLAN;;ASTHMA
+47 ;;ASTHMA PATIENT-FLU SHOT;;ASTHMA
+48 ;;IHD-LDL Screening;;CARDIOVASCULAR DISEASE
+49 ;;IHD-Elevated LDL Prompt;;CARDIOVASCULAR DISEASE
+50 ;;ADULT MMR 1-DOSE VERSION;;GENERAL
+51 ;;ADULT MMR 2-DOSE VERSION;;GENERAL
+52 ;;RUBELLA VACCINATION;;GENERAL
+53 ;;
