AUT98P25 ; IHS/OIT/FBD - AUT V98.1 PATCH 25 ENVIRONMENT CHECKS ;
;;98.1;IHS DICTIONARIES (POINTERS);**25**;FEB 9,2011;Build 6
;
;
; 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
F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
;KERNEL
I +$$VERSION^XPDUTL("XU")<8 D MES^XPDUTL($$CJ^XLFSTR("Version 8.0 of KERNEL is required. Not installed",80)) D SORRY(2) I 1
E D MES^XPDUTL($$CJ^XLFSTR("Requires Kernel Version 8.0....Present.",80))
;FILEMAN
I +$$VERSION^XPDUTL("DI")<22 D MES^XPDUTL($$CJ^XLFSTR("Version 22.0 of FILEMAN is required. Not installed.",80)) D SORRY(2) I 1
E D MES^XPDUTL($$CJ^XLFSTR("Requires Fileman v22....Present.",80))
;AUT
I $$VERSION^XPDUTL("AUT")'="98.1" D MES^XPDUTL($$CJ^XLFSTR("Version 98.1 of the IHS DICTIONARIES (POINTERS) is required. Not installed",80)) D SORRY(2) I 1
E D MES^XPDUTL($$CJ^XLFSTR("Requires IHS DICTIONARIES (POINTERS) Version 98.1....Present.",80))
;AUT 98.1 PATCH 24
I '$$INSTALLD("AUT*98.1*24") D SORRY(2)
;
Q
;
POST ;PATCH 25 POST-INIT PROCESS
;
LANG ;PERFORM LANGUAGE FILE UPDATE(S)
D MES^XPDUTL("Updating LANGUAGES file...")
I '$D(^AUTTLANG("B","SIGN LANGUAGES")) D
.S DIC="^AUTTLANG(",DIC(0)="L",DIADD=1,DLAYGO=9999999.99,X="SIGN LANGUAGES",DIC("DR")="3///sgn" D FILE^DICN K DIADD,DLAYGO,DIC,X
.I Y=-1 D MES^XPDUTL("Adding LANGUAGES file entry SIGN LANGUAGES failed.") Q
D MES^XPDUTL("LANGUAGES file update complete.")
;
HF ;
;UPDATE HEALTH FACTOR TABLE AND V HEALTH FACTOR DATA
;inactivate category TOBACCO as it has been broken into 3 categories
S DA=$O(^AUTTHF("B","TOBACCO",0))
I DA,$P(^AUTTHF(DA,0),U,15)="" S DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
;add 3 new categories
;TOBACCO (SMOKING)
I '$O(^AUTTHF("B","TOBACCO (SMOKING)",0)) D
.S X="TOBACCO (SMOKING)",DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///C;.03///TOBACCO (SMOKING)" D FILE^DICN K DIADD,DLAYGO,DIC,X
.I Y=-1 D MES^XPDUTL("Adding Health Factor Category TOBACCO (SMOKING) failed") Q
;TOBACCO (SMOKLESS - CHEWING DIP)
I '$O(^AUTTHF("B","TOBACCO (SMOKELESS - CHEWING/DIP)",0)) D
.S X="TOBACCO (SMOKELESS - CHEWING/DIP)",DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///C;.03///TOBACCO (SMOKELESS - CHEWING/DIP)" D FILE^DICN K DIADD,DLAYGO,DIC,X
.I Y=-1 D MES^XPDUTL("Adding Health Factor Category TOBACCO (SMOKELESS - CHEWING/DIP) failed") Q
;TOBACCO (EXPOSURE)
I '$O(^AUTTHF("B","TOBACCO (EXPOSURE)",0)) D
.S X="TOBACCO (EXPOSURE)",DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///C;.03///TOBACCO (EXPOSURE)" D FILE^DICN K DIADD,DLAYGO,DIC,X
.I Y=-1 D MES^XPDUTL("Adding Health Factor Category TOBACCO (EXPOSURE) failed") Q
;change names of 3 health factors
;CURRENT SMOKER - CURRENT SMOKER, STATUS UNKNOWN
S DA=$O(^AUTTHF("B","CURRENT SMOKER",0))
I DA S DIE="^AUTTHF(",DR=".01///CURRENT SMOKER, STATUS UNKNOWN" D ^DIE K DA,DIE,DR
;PREVIOUS SMOKER - PREVIOUS (FORMER) SMOKER
S DA=$O(^AUTTHF("B","PREVIOUS SMOKER",0))
I DA S DIE="^AUTTHF(",DR=".01///PREVIOUS (FORMER) SMOKER" D ^DIE K DA,DIE,DR
;PREVIOUS SMOKELESS - PREVIOUS (FORMER) SMOKELESS
S DA=$O(^AUTTHF("B","PREVIOUS SMOKELESS",0))
I DA S DIE="^AUTTHF(",DR=".01///PREVIOUS (FORMER) SMOKELESS" D ^DIE K DA,DIE,DR
;INACTIVATE 2 HEALTH FACTORS
;CURRENT SMOKER AND SMOKELESS
S DA=$O(^AUTTHF("B","CURRENT SMOKER & SMOKELESS",0))
I DA,$P(^AUTTHF(DA,0),U,15)="" S DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
;NEVER USED TOBACCO
S DA=$O(^AUTTHF("B","NEVER USED TOBACCO",0))
I DA,$P(^AUTTHF(DA,0),U,15)="" S DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
;ADD 6 NEW HEALTH FACTORS
F AUTPCX="CURRENT SMOKER, EVERY DAY","CURRENT SMOKER, SOME DAY","NEVER SMOKED","SMOKING STATUS UNKNOWN","SMOKELESS TOBACCO, STATUS UNKNOWN","NEVER USED SMOKELESS TOBACCO" D
.Q:$D(^AUTTHF("B",AUTPCX))
.S X=AUTPCX,DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///F" D FILE^DICN K DIC,X,DIADD,DLAYGO
.I Y=-1 D MES^XPDUTL("Adding Health Factor "_AUTPCX_" failed")
;UPDATE CATEGORY ON ALL NEW HEALTH FACTORS
F AUTPCX="NON-TOBACCO USER","CURRENT SMOKER, EVERY DAY","CURRENT SMOKER, SOME DAY","CURRENT SMOKER, STATUS UNKNOWN","CESSATION-SMOKER","PREVIOUS (FORMER) SMOKER","CEREMONIAL USE ONLY","NEVER SMOKED","SMOKING STATUS UNKNOWN" D
.S DA=$O(^AUTTHF("B",AUTPCX,0))
.I 'DA D MES^XPDUTL("updating category for "_AUTPCX_" failed.") Q
.S DIE="^AUTTHF(",DR=".03///TOBACCO (SMOKING)" D ^DIE K DA,DR,DIE
.I $D(Y) D MES^XPDUTL("Updating category for "_AUTPCX_" failed.")
F AUTPCX="CURRENT SMOKELESS","CESSATION-SMOKELESS","PREVIOUS (FORMER) SMOKELESS","NEVER USED SMOKELESS TOBACCO","SMOKELESS TOBACCO, STATUS UNKNOWN" D
.S DA=$O(^AUTTHF("B",AUTPCX,0))
.I 'DA D MES^XPDUTL("updating category for "_AUTPCX_" failed.") Q
.S DIE="^AUTTHF(",DR=".03///TOBACCO (SMOKELESS - CHEWING/DIP)" D ^DIE K DA,DR,DIE
.I $D(Y) D MES^XPDUTL("Updating category for "_AUTPCX_" failed.")
F AUTPCX="SMOKER IN HOME","SMOKE FREE HOME","EXPOSURE TO ENVIRONMENTAL TOBACCO SMOKE" D
.S DA=$O(^AUTTHF("B",AUTPCX,0))
.I 'DA D MES^XPDUTL("updating category for "_AUTPCX_" failed.") Q
.S DIE="^AUTTHF(",DR=".03///TOBACCO (EXPOSURE)" D ^DIE K DA,DR,DIE
.I $D(Y) D MES^XPDUTL("Updating category for "_AUTPCX_" failed.")
;
ECOG ;POPULATE ECOG CATEGORY & HEALTH FACTORS
I '$O(^AUTTHF("B","ECOG PERFORMANCE STATUS",0)) D
.S X="ECOG PERFORMANCE STATUS",DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///C;.02///C018;.03///ECOG PERFORMANCE STATUS" D FILE^DICN K DIADD,DLAYGO,DIC,X
.I Y=-1 D MES^XPDUTL("Adding Health Factor Category ECOG PERFORMANCE STATUS failed") Q
.F AUTPCX="ECOG 0 - ACTIVE","ECOG 1 - SOME RESTRICTION","ECOG 2 - UNABLE TO WORK","ECOG 3 - LIMITED SELF CARE","ECOG 4 - COMPLETELY DISABLED" D
..S X=AUTPCX,DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///F;.03///ECOG PERFORMANCE STATUS" D FILE^DICN K DIADD,DLAYGO,DIC,X
..I Y=-1 D MES^XPDUTL("Adding Health Factor "_AUTPCX_" failed")
;
INSTYP ;UPDATE INSURER TYPE FILE
I '$O(^AUTTINTY("B","VETERANS ADMINISTRATION",0)) D
.S X="VETERANS ADMINISTRATION",DIC="^AUTTINTY(",DIC(0)="L",DIADD=1,DLAYGO=9999999.181,DIC("DR")="1///VA" D FILE^DICN K DIADD,DLAYGO,DIC,X
.I Y=-1 D MES^XPDUTL("Adding Insurer Type VETERANS ADMINISTRATION failed") Q
;
HFDATA ;
;UPDATE V HEALTH FACTORS
;IF PATIENT HAS CURRENT SMOKER AND SMOKELESS THEN ADD CURRENT SMOKER, STATUS UNKNOWN AND CURRENT SMOKELESS
;IF PATIENT HAS NEVER USED TOBACCO THEN ADD NEVER SMOKED AND NEVER USED SMOKELESS TOBACCO
;IF PATIENT HAS NON-TOBACCO USER THEN ADD NEVER SMOKED AND NEVER USED SMOKELESS TOBACCO
S AUTDA=0 F S AUTDA=$O(^AUPNVHF(AUTDA)) Q:AUTDA'=+AUTDA D
.I $$VAL^XBDIQ1(9000010.23,AUTDA,.01)="CURRENT SMOKER & SMOKELESS" D Q
..;add 2 new v health factors
..S AUTNEW="CURRENT SMOKER, STATUS UNKNOWN"
..I '$$GOTHF($P(^AUPNVHF(AUTDA,0),U,3),AUTNEW) D ADDHF($P(^AUPNVHF(AUTDA,0),U,3),AUTNEW,AUTDA)
..S AUTNEW="CURRENT SMOKELESS"
..I '$$GOTHF($P(^AUPNVHF(AUTDA,0),U,3),AUTNEW) D ADDHF($P(^AUPNVHF(AUTDA,0),U,3),AUTNEW,AUTDA)
.I $$VAL^XBDIQ1(9000010.23,AUTDA,.01)="NON-TOBACCO USER" D Q
..;add 2 new v health factors
..S AUTNEW="NEVER SMOKED"
..I '$$GOTHF($P(^AUPNVHF(AUTDA,0),U,3),AUTNEW) D ADDHF($P(^AUPNVHF(AUTDA,0),U,3),AUTNEW,AUTDA)
..S AUTNEW="NEVER USED SMOKELESS TOBACCO"
..I '$$GOTHF($P(^AUPNVHF(AUTDA,0),U,3),AUTNEW) D ADDHF($P(^AUPNVHF(AUTDA,0),U,3),AUTNEW,AUTDA)
.I $$VAL^XBDIQ1(9000010.23,AUTDA,.01)="NEVER USED TOBACCO" D Q
..;add 2 new v health factors
..S AUTNEW="NEVER SMOKED"
..I '$$GOTHF($P(^AUPNVHF(AUTDA,0),U,3),AUTNEW) D ADDHF($P(^AUPNVHF(AUTDA,0),U,3),AUTNEW,AUTDA)
..S AUTNEW="NEVER USED SMOKELESS TOBACCO"
..I '$$GOTHF($P(^AUPNVHF(AUTDA,0),U,3),AUTNEW) D ADDHF($P(^AUPNVHF(AUTDA,0),U,3),AUTNEW,AUTDA)
;
CODE ;now update all HF Codes per Floyd's spreadsheet
S AUTPCX=0 F S AUTPCX=$O(^AUTTXHF(AUTPCX)) Q:AUTPCX'=+AUTPCX D
.S AUTHF=$P(^AUTTXHF(AUTPCX,0),U,1) ;FACTOR
.S AUTHFC=$P(^AUTTXHF(AUTPCX,0),U,2) ;FACTOR CODE
.S AUTHFN=$P($G(^AUTTXHF(AUTPCX,88)),U,1) ;MNEMONIC
.S DA=$O(^AUTTHF("B",AUTHF,0))
.Q:'DA
.I DA S DIE="^AUTTHF(",DR=".02///"_AUTHFC_";8801///"_AUTHFN
.D ^DIE
.K DA,DIE,DR
;now add LOW HEALTH LITERACY READINESS TO LEARN PER Floyd
I '$D(^AUTTHF("B","LOW HEALTH LITERACY")) D ;
.S AUTC=$O(^AUTTHF("B","BARRIERS TO LEARNING",0))
.S X="LOW HEALTH LITERACY",DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///F;.03////"_AUTC_";.02////F112" D FILE^DICN K DIC,X,DIADD,DLAYGO
.I Y=-1 D MES^XPDUTL("Adding Health Factor "_AUTPCX_" failed")
Q
;
GOTHF(VISIT,HF) ;is this hf already attached to this visit?
NEW X,G
S G=0
S X=0 F S X=$O(^AUPNVHF("AD",VISIT,X)) Q:X'=+X!(G) I $D(^AUPNVHF(X,0)),$$VAL^XBDIQ1(9000010.23,X,.01)=AUTNEW S G=1
Q G
ADDHF(VISIT,HF,HFDA) ;add this v health factor to visit
I '$G(VISIT) Q
I '$D(^AUPNVSIT(VISIT,0)) Q
;SET UP ARRAY WITH SAME VALUES AS THE OTHER ENTRY
N AUTFDA,AUTIENS,AUTERRR,AUTPIEN,DITC
S DITC=1
S AUTIENS="+1,"
S AUTFDA(9000010.23,AUTIENS,.01)=$O(^AUTTHF("B",HF,0))
S AUTFDA(9000010.23,AUTIENS,.02)=$P(^AUPNVHF(HFDA,0),U,2)
S AUTFDA(9000010.23,AUTIENS,.03)=VISIT
I $P(^AUPNVHF(HFDA,0),U,4)]"" S AUTFDA(9000010.23,AUTIENS,.04)=$P(^AUPNVHF(HFDA,0),U,4)
I $P(^AUPNVHF(HFDA,0),U,5)]"" S AUTFDA(9000010.23,AUTIENS,.05)=$P(^AUPNVHF(HFDA,0),U,5)
I $P(^AUPNVHF(HFDA,0),U,6)]"" S AUTFDA(9000010.23,AUTIENS,.06)=$P(^AUPNVHF(HFDA,0),U,6)
I $P($G(^AUPNVHF(HFDA,12)),U,1)]"" S AUTFDA(9000010.23,AUTIENS,1201)=$P($G(^AUPNVHF(HFDA,12)),U,1)
I $P($G(^AUPNVHF(HFDA,12)),U,2)]"" S AUTFDA(9000010.23,AUTIENS,1202)=$P($G(^AUPNVHF(HFDA,12)),U,2)
I $P($G(^AUPNVHF(HFDA,12)),U,3)]"" S AUTFDA(9000010.23,AUTIENS,1203)=$P($G(^AUPNVHF(HFDA,12)),U,3)
I $P($G(^AUPNVHF(HFDA,12)),U,4)]"" S AUTFDA(9000010.23,AUTIENS,1204)=$P($G(^AUPNVHF(HFDA,12)),U,4)
I $P($G(^AUPNVHF(HFDA,12)),U,8)]"" S AUTFDA(9000010.23,AUTIENS,1208)=$P($G(^AUPNVHF(HFDA,12)),U,8)
I $P($G(^AUPNVHF(HFDA,12)),U,9)]"" S AUTFDA(9000010.23,AUTIENS,1209)=$P($G(^AUPNVHF(HFDA,12)),U,9)
I $P($G(^AUPNVHF(HFDA,12)),U,10)]"" S AUTFDA(9000010.23,AUTIENS,1210)=$P($G(^AUPNVHF(HFDA,12)),U,10)
I $P($G(^AUPNVHF(HFDA,12)),U,15)]"" S AUTFDA(9000010.23,AUTIENS,1215)=$P($G(^AUPNVHF(HFDA,12)),U,15)
I $P($G(^AUPNVHF(HFDA,801)),U,1)]"" S AUTFDA(9000010.23,AUTIENS,80101)=$P($G(^AUPNVHF(HFDA,801)),U,1)
I $P($G(^AUPNVHF(HFDA,801)),U,2)]"" S AUTFDA(9000010.23,AUTIENS,80102)=$P($G(^AUPNVHF(HFDA,801)),U,2)
I $P($G(^AUPNVHF(HFDA,811)),U,1)]"" S AUTFDA(9000010.23,AUTIENS,81101)=$P($G(^AUPNVHF(HFDA,811)),U,1)
I $P($G(^AUPNVHF(HFDA,812)),U,1)]"" S AUTFDA(9000010.23,AUTIENS,81201)=$P($G(^AUPNVHF(HFDA,812)),U,1)
I $P($G(^AUPNVHF(HFDA,812)),U,2)]"" S AUTFDA(9000010.23,AUTIENS,81202)=$P($G(^AUPNVHF(HFDA,812)),U,2)
I $P($G(^AUPNVHF(HFDA,812)),U,3)]"" S AUTFDA(9000010.23,AUTIENS,81203)=$P($G(^AUPNVHF(HFDA,812)),U,1)
D UPDATE^DIE("","AUTFDA","AUTIENS","AUTERRR(1)")
I $D(AUTERRR) D MES^XPDUTL("Error creating V Health Factor "_HF_" for visit ien "_VISIT_".") Q
W "."
Q
INSTALLD(AUTSTAL) ;EP - Determine if patch AUTSTAL was installed, where
; AUTSTAL is the name of the INSTALL. E.g "AG*6.0*11".
;
NEW AUTY,DIC,X,Y
S X=$P(AUTSTAL,"*",1)
S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
D IX^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",22,",X=$P(AUTSTAL,"*",2)
D ^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",""PAH"",",X=$P(AUTSTAL,"*",3)
D ^DIC
S AUTY=Y
D IMES
Q $S(AUTY<1:0,1:1)
IMES ;
D MES^XPDUTL($$CJ^XLFSTR("Patch """_AUTSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
Q
SORRY(X) ;
KILL DIFQ
I X=3 S XPDQUIT=2 Q
S XPDQUIT=X
W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
Q
AUT98P25 ; IHS/OIT/FBD - AUT V98.1 PATCH 25 ENVIRONMENT CHECKS ;
+1 ;;98.1;IHS DICTIONARIES (POINTERS);**25**;FEB 9,2011;Build 6
+2 ;
+3 ;
+4 ; The following line prevents the "Disable Options..." and "Move Routines..." questions from being asked during the install.
+5 IF $GET(XPDENV)=1
SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+6 FOR X="XPO1","XPZ1","XPZ2","XPI1"
SET XPDDIQ(X)=0
+7 ;KERNEL
+8 IF +$$VERSION^XPDUTL("XU")<8
DO MES^XPDUTL($$CJ^XLFSTR("Version 8.0 of KERNEL is required. Not installed",80))
DO SORRY(2)
IF 1
+9 IF '$TEST
DO MES^XPDUTL($$CJ^XLFSTR("Requires Kernel Version 8.0....Present.",80))
+10 ;FILEMAN
+11 IF +$$VERSION^XPDUTL("DI")<22
DO MES^XPDUTL($$CJ^XLFSTR("Version 22.0 of FILEMAN is required. Not installed.",80))
DO SORRY(2)
IF 1
+12 IF '$TEST
DO MES^XPDUTL($$CJ^XLFSTR("Requires Fileman v22....Present.",80))
+13 ;AUT
+14 IF $$VERSION^XPDUTL("AUT")'="98.1"
DO MES^XPDUTL($$CJ^XLFSTR("Version 98.1 of the IHS DICTIONARIES (POINTERS) is required. Not installed",80))
DO SORRY(2)
IF 1
+15 IF '$TEST
DO MES^XPDUTL($$CJ^XLFSTR("Requires IHS DICTIONARIES (POINTERS) Version 98.1....Present.",80))
+16 ;AUT 98.1 PATCH 24
+17 IF '$$INSTALLD("AUT*98.1*24")
DO SORRY(2)
+18 ;
+19 QUIT
+20 ;
POST ;PATCH 25 POST-INIT PROCESS
+1 ;
LANG ;PERFORM LANGUAGE FILE UPDATE(S)
+1 DO MES^XPDUTL("Updating LANGUAGES file...")
+2 IF '$DATA(^AUTTLANG("B","SIGN LANGUAGES"))
Begin DoDot:1
+3 SET DIC="^AUTTLANG("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9999999.99
SET X="SIGN LANGUAGES"
SET DIC("DR")="3///sgn"
DO FILE^DICN
KILL DIADD,DLAYGO,DIC,X
+4 IF Y=-1
DO MES^XPDUTL("Adding LANGUAGES file entry SIGN LANGUAGES failed.")
QUIT
End DoDot:1
+5 DO MES^XPDUTL("LANGUAGES file update complete.")
+6 ;
HF ;
+1 ;UPDATE HEALTH FACTOR TABLE AND V HEALTH FACTOR DATA
+2 ;inactivate category TOBACCO as it has been broken into 3 categories
+3 SET DA=$ORDER(^AUTTHF("B","TOBACCO",0))
+4 IF DA
IF $PIECE(^AUTTHF(DA,0),U,15)=""
SET DIE="^AUTTHF("
SET DR=".13///1;.15////"_DT
DO ^DIE
KILL DA,DIE,DR
+5 ;add 3 new categories
+6 ;TOBACCO (SMOKING)
+7 IF '$ORDER(^AUTTHF("B","TOBACCO (SMOKING)",0))
Begin DoDot:1
+8 SET X="TOBACCO (SMOKING)"
SET DIC="^AUTTHF("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9999999.64
SET DIC("DR")=".1///C;.03///TOBACCO (SMOKING)"
DO FILE^DICN
KILL DIADD,DLAYGO,DIC,X
+9 IF Y=-1
DO MES^XPDUTL("Adding Health Factor Category TOBACCO (SMOKING) failed")
QUIT
End DoDot:1
+10 ;TOBACCO (SMOKLESS - CHEWING DIP)
+11 IF '$ORDER(^AUTTHF("B","TOBACCO (SMOKELESS - CHEWING/DIP)",0))
Begin DoDot:1
+12 SET X="TOBACCO (SMOKELESS - CHEWING/DIP)"
SET DIC="^AUTTHF("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9999999.64
SET DIC("DR")=".1///C;.03///TOBACCO (SMOKELESS - CHEWING/DIP)"
DO FILE^DICN
KILL DIADD,DLAYGO,DIC,X
+13 IF Y=-1
DO MES^XPDUTL("Adding Health Factor Category TOBACCO (SMOKELESS - CHEWING/DIP) failed")
QUIT
End DoDot:1
+14 ;TOBACCO (EXPOSURE)
+15 IF '$ORDER(^AUTTHF("B","TOBACCO (EXPOSURE)",0))
Begin DoDot:1
+16 SET X="TOBACCO (EXPOSURE)"
SET DIC="^AUTTHF("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9999999.64
SET DIC("DR")=".1///C;.03///TOBACCO (EXPOSURE)"
DO FILE^DICN
KILL DIADD,DLAYGO,DIC,X
+17 IF Y=-1
DO MES^XPDUTL("Adding Health Factor Category TOBACCO (EXPOSURE) failed")
QUIT
End DoDot:1
+18 ;change names of 3 health factors
+19 ;CURRENT SMOKER - CURRENT SMOKER, STATUS UNKNOWN
+20 SET DA=$ORDER(^AUTTHF("B","CURRENT SMOKER",0))
+21 IF DA
SET DIE="^AUTTHF("
SET DR=".01///CURRENT SMOKER, STATUS UNKNOWN"
DO ^DIE
KILL DA,DIE,DR
+22 ;PREVIOUS SMOKER - PREVIOUS (FORMER) SMOKER
+23 SET DA=$ORDER(^AUTTHF("B","PREVIOUS SMOKER",0))
+24 IF DA
SET DIE="^AUTTHF("
SET DR=".01///PREVIOUS (FORMER) SMOKER"
DO ^DIE
KILL DA,DIE,DR
+25 ;PREVIOUS SMOKELESS - PREVIOUS (FORMER) SMOKELESS
+26 SET DA=$ORDER(^AUTTHF("B","PREVIOUS SMOKELESS",0))
+27 IF DA
SET DIE="^AUTTHF("
SET DR=".01///PREVIOUS (FORMER) SMOKELESS"
DO ^DIE
KILL DA,DIE,DR
+28 ;INACTIVATE 2 HEALTH FACTORS
+29 ;CURRENT SMOKER AND SMOKELESS
+30 SET DA=$ORDER(^AUTTHF("B","CURRENT SMOKER & SMOKELESS",0))
+31 IF DA
IF $PIECE(^AUTTHF(DA,0),U,15)=""
SET DIE="^AUTTHF("
SET DR=".13///1;.15////"_DT
DO ^DIE
KILL DA,DIE,DR
+32 ;NEVER USED TOBACCO
+33 SET DA=$ORDER(^AUTTHF("B","NEVER USED TOBACCO",0))
+34 IF DA
IF $PIECE(^AUTTHF(DA,0),U,15)=""
SET DIE="^AUTTHF("
SET DR=".13///1;.15////"_DT
DO ^DIE
KILL DA,DIE,DR
+35 ;ADD 6 NEW HEALTH FACTORS
+36 FOR AUTPCX="CURRENT SMOKER, EVERY DAY","CURRENT SMOKER, SOME DAY","NEVER SMOKED","SMOKING STATUS UNKNOWN","SMOKELESS TOBACCO, STATUS UNKNOWN","NEVER USED SMOKELESS TOBACCO"
Begin DoDot:1
+37 IF $DATA(^AUTTHF("B",AUTPCX))
QUIT
+38 SET X=AUTPCX
SET DIC="^AUTTHF("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9999999.64
SET DIC("DR")=".1///F"
DO FILE^DICN
KILL DIC,X,DIADD,DLAYGO
+39 IF Y=-1
DO MES^XPDUTL("Adding Health Factor "_AUTPCX_" failed")
End DoDot:1
+40 ;UPDATE CATEGORY ON ALL NEW HEALTH FACTORS
+41 FOR AUTPCX="NON-TOBACCO USER","CURRENT SMOKER, EVERY DAY","CURRENT SMOKER, SOME DAY","CURRENT SMOKER, STATUS UNKNOWN","CESSATION-SMOKER","PREVIOUS (FORMER) SMOKER","CEREMONIAL USE ONLY","NEVER SMOKED","SMOKING STATUS UNKNOWN"
Begin DoDot:1
+42 SET DA=$ORDER(^AUTTHF("B",AUTPCX,0))
+43 IF 'DA
DO MES^XPDUTL("updating category for "_AUTPCX_" failed.")
QUIT
+44 SET DIE="^AUTTHF("
SET DR=".03///TOBACCO (SMOKING)"
DO ^DIE
KILL DA,DR,DIE
+45 IF $DATA(Y)
DO MES^XPDUTL("Updating category for "_AUTPCX_" failed.")
End DoDot:1
+46 FOR AUTPCX="CURRENT SMOKELESS","CESSATION-SMOKELESS","PREVIOUS (FORMER) SMOKELESS","NEVER USED SMOKELESS TOBACCO","SMOKELESS TOBACCO, STATUS UNKNOWN"
Begin DoDot:1
+47 SET DA=$ORDER(^AUTTHF("B",AUTPCX,0))
+48 IF 'DA
DO MES^XPDUTL("updating category for "_AUTPCX_" failed.")
QUIT
+49 SET DIE="^AUTTHF("
SET DR=".03///TOBACCO (SMOKELESS - CHEWING/DIP)"
DO ^DIE
KILL DA,DR,DIE
+50 IF $DATA(Y)
DO MES^XPDUTL("Updating category for "_AUTPCX_" failed.")
End DoDot:1
+51 FOR AUTPCX="SMOKER IN HOME","SMOKE FREE HOME","EXPOSURE TO ENVIRONMENTAL TOBACCO SMOKE"
Begin DoDot:1
+52 SET DA=$ORDER(^AUTTHF("B",AUTPCX,0))
+53 IF 'DA
DO MES^XPDUTL("updating category for "_AUTPCX_" failed.")
QUIT
+54 SET DIE="^AUTTHF("
SET DR=".03///TOBACCO (EXPOSURE)"
DO ^DIE
KILL DA,DR,DIE
+55 IF $DATA(Y)
DO MES^XPDUTL("Updating category for "_AUTPCX_" failed.")
End DoDot:1
+56 ;
ECOG ;POPULATE ECOG CATEGORY & HEALTH FACTORS
+1 IF '$ORDER(^AUTTHF("B","ECOG PERFORMANCE STATUS",0))
Begin DoDot:1
+2 SET X="ECOG PERFORMANCE STATUS"
SET DIC="^AUTTHF("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9999999.64
SET DIC("DR")=".1///C;.02///C018;.03///ECOG PERFORMANCE STATUS"
DO FILE^DICN
KILL DIADD,DLAYGO,DIC,X
+3 IF Y=-1
DO MES^XPDUTL("Adding Health Factor Category ECOG PERFORMANCE STATUS failed")
QUIT
+4 FOR AUTPCX="ECOG 0 - ACTIVE","ECOG 1 - SOME RESTRICTION","ECOG 2 - UNABLE TO WORK","ECOG 3 - LIMITED SELF CARE","ECOG 4 - COMPLETELY DISABLED"
Begin DoDot:2
+5 SET X=AUTPCX
SET DIC="^AUTTHF("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9999999.64
SET DIC("DR")=".1///F;.03///ECOG PERFORMANCE STATUS"
DO FILE^DICN
KILL DIADD,DLAYGO,DIC,X
+6 IF Y=-1
DO MES^XPDUTL("Adding Health Factor "_AUTPCX_" failed")
End DoDot:2
End DoDot:1
+7 ;
INSTYP ;UPDATE INSURER TYPE FILE
+1 IF '$ORDER(^AUTTINTY("B","VETERANS ADMINISTRATION",0))
Begin DoDot:1
+2 SET X="VETERANS ADMINISTRATION"
SET DIC="^AUTTINTY("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9999999.181
SET DIC("DR")="1///VA"
DO FILE^DICN
KILL DIADD,DLAYGO,DIC,X
+3 IF Y=-1
DO MES^XPDUTL("Adding Insurer Type VETERANS ADMINISTRATION failed")
QUIT
End DoDot:1
+4 ;
HFDATA ;
+1 ;UPDATE V HEALTH FACTORS
+2 ;IF PATIENT HAS CURRENT SMOKER AND SMOKELESS THEN ADD CURRENT SMOKER, STATUS UNKNOWN AND CURRENT SMOKELESS
+3 ;IF PATIENT HAS NEVER USED TOBACCO THEN ADD NEVER SMOKED AND NEVER USED SMOKELESS TOBACCO
+4 ;IF PATIENT HAS NON-TOBACCO USER THEN ADD NEVER SMOKED AND NEVER USED SMOKELESS TOBACCO
+5 SET AUTDA=0
FOR
SET AUTDA=$ORDER(^AUPNVHF(AUTDA))
IF AUTDA'=+AUTDA
QUIT
Begin DoDot:1
+6 IF $$VAL^XBDIQ1(9000010.23,AUTDA,.01)="CURRENT SMOKER & SMOKELESS"
Begin DoDot:2
+7 ;add 2 new v health factors
+8 SET AUTNEW="CURRENT SMOKER, STATUS UNKNOWN"
+9 IF '$$GOTHF($PIECE(^AUPNVHF(AUTDA,0),U,3),AUTNEW)
DO ADDHF($PIECE(^AUPNVHF(AUTDA,0),U,3),AUTNEW,AUTDA)
+10 SET AUTNEW="CURRENT SMOKELESS"
+11 IF '$$GOTHF($PIECE(^AUPNVHF(AUTDA,0),U,3),AUTNEW)
DO ADDHF($PIECE(^AUPNVHF(AUTDA,0),U,3),AUTNEW,AUTDA)
End DoDot:2
QUIT
+12 IF $$VAL^XBDIQ1(9000010.23,AUTDA,.01)="NON-TOBACCO USER"
Begin DoDot:2
+13 ;add 2 new v health factors
+14 SET AUTNEW="NEVER SMOKED"
+15 IF '$$GOTHF($PIECE(^AUPNVHF(AUTDA,0),U,3),AUTNEW)
DO ADDHF($PIECE(^AUPNVHF(AUTDA,0),U,3),AUTNEW,AUTDA)
+16 SET AUTNEW="NEVER USED SMOKELESS TOBACCO"
+17 IF '$$GOTHF($PIECE(^AUPNVHF(AUTDA,0),U,3),AUTNEW)
DO ADDHF($PIECE(^AUPNVHF(AUTDA,0),U,3),AUTNEW,AUTDA)
End DoDot:2
QUIT
+18 IF $$VAL^XBDIQ1(9000010.23,AUTDA,.01)="NEVER USED TOBACCO"
Begin DoDot:2
+19 ;add 2 new v health factors
+20 SET AUTNEW="NEVER SMOKED"
+21 IF '$$GOTHF($PIECE(^AUPNVHF(AUTDA,0),U,3),AUTNEW)
DO ADDHF($PIECE(^AUPNVHF(AUTDA,0),U,3),AUTNEW,AUTDA)
+22 SET AUTNEW="NEVER USED SMOKELESS TOBACCO"
+23 IF '$$GOTHF($PIECE(^AUPNVHF(AUTDA,0),U,3),AUTNEW)
DO ADDHF($PIECE(^AUPNVHF(AUTDA,0),U,3),AUTNEW,AUTDA)
End DoDot:2
QUIT
End DoDot:1
+24 ;
CODE ;now update all HF Codes per Floyd's spreadsheet
+1 SET AUTPCX=0
FOR
SET AUTPCX=$ORDER(^AUTTXHF(AUTPCX))
IF AUTPCX'=+AUTPCX
QUIT
Begin DoDot:1
+2 ;FACTOR
SET AUTHF=$PIECE(^AUTTXHF(AUTPCX,0),U,1)
+3 ;FACTOR CODE
SET AUTHFC=$PIECE(^AUTTXHF(AUTPCX,0),U,2)
+4 ;MNEMONIC
SET AUTHFN=$PIECE($GET(^AUTTXHF(AUTPCX,88)),U,1)
+5 SET DA=$ORDER(^AUTTHF("B",AUTHF,0))
+6 IF 'DA
QUIT
+7 IF DA
SET DIE="^AUTTHF("
SET DR=".02///"_AUTHFC_";8801///"_AUTHFN
+8 DO ^DIE
+9 KILL DA,DIE,DR
End DoDot:1
+10 ;now add LOW HEALTH LITERACY READINESS TO LEARN PER Floyd
+11 ;
IF '$DATA(^AUTTHF("B","LOW HEALTH LITERACY"))
Begin DoDot:1
+12 SET AUTC=$ORDER(^AUTTHF("B","BARRIERS TO LEARNING",0))
+13 SET X="LOW HEALTH LITERACY"
SET DIC="^AUTTHF("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9999999.64
SET DIC("DR")=".1///F;.03////"_AUTC_";.02////F112"
DO FILE^DICN
KILL DIC,X,DIADD,DLAYGO
+14 IF Y=-1
DO MES^XPDUTL("Adding Health Factor "_AUTPCX_" failed")
End DoDot:1
+15 QUIT
+16 ;
GOTHF(VISIT,HF) ;is this hf already attached to this visit?
+1 NEW X,G
+2 SET G=0
+3 SET X=0
FOR
SET X=$ORDER(^AUPNVHF("AD",VISIT,X))
IF X'=+X!(G)
QUIT
IF $DATA(^AUPNVHF(X,0))
IF $$VAL^XBDIQ1(9000010.23,X,.01)=AUTNEW
SET G=1
+4 QUIT G
ADDHF(VISIT,HF,HFDA) ;add this v health factor to visit
+1 IF '$GET(VISIT)
QUIT
+2 IF '$DATA(^AUPNVSIT(VISIT,0))
QUIT
+3 ;SET UP ARRAY WITH SAME VALUES AS THE OTHER ENTRY
+4 NEW AUTFDA,AUTIENS,AUTERRR,AUTPIEN,DITC
+5 SET DITC=1
+6 SET AUTIENS="+1,"
+7 SET AUTFDA(9000010.23,AUTIENS,.01)=$ORDER(^AUTTHF("B",HF,0))
+8 SET AUTFDA(9000010.23,AUTIENS,.02)=$PIECE(^AUPNVHF(HFDA,0),U,2)
+9 SET AUTFDA(9000010.23,AUTIENS,.03)=VISIT
+10 IF $PIECE(^AUPNVHF(HFDA,0),U,4)]""
SET AUTFDA(9000010.23,AUTIENS,.04)=$PIECE(^AUPNVHF(HFDA,0),U,4)
+11 IF $PIECE(^AUPNVHF(HFDA,0),U,5)]""
SET AUTFDA(9000010.23,AUTIENS,.05)=$PIECE(^AUPNVHF(HFDA,0),U,5)
+12 IF $PIECE(^AUPNVHF(HFDA,0),U,6)]""
SET AUTFDA(9000010.23,AUTIENS,.06)=$PIECE(^AUPNVHF(HFDA,0),U,6)
+13 IF $PIECE($GET(^AUPNVHF(HFDA,12)),U,1)]""
SET AUTFDA(9000010.23,AUTIENS,1201)=$PIECE($GET(^AUPNVHF(HFDA,12)),U,1)
+14 IF $PIECE($GET(^AUPNVHF(HFDA,12)),U,2)]""
SET AUTFDA(9000010.23,AUTIENS,1202)=$PIECE($GET(^AUPNVHF(HFDA,12)),U,2)
+15 IF $PIECE($GET(^AUPNVHF(HFDA,12)),U,3)]""
SET AUTFDA(9000010.23,AUTIENS,1203)=$PIECE($GET(^AUPNVHF(HFDA,12)),U,3)
+16 IF $PIECE($GET(^AUPNVHF(HFDA,12)),U,4)]""
SET AUTFDA(9000010.23,AUTIENS,1204)=$PIECE($GET(^AUPNVHF(HFDA,12)),U,4)
+17 IF $PIECE($GET(^AUPNVHF(HFDA,12)),U,8)]""
SET AUTFDA(9000010.23,AUTIENS,1208)=$PIECE($GET(^AUPNVHF(HFDA,12)),U,8)
+18 IF $PIECE($GET(^AUPNVHF(HFDA,12)),U,9)]""
SET AUTFDA(9000010.23,AUTIENS,1209)=$PIECE($GET(^AUPNVHF(HFDA,12)),U,9)
+19 IF $PIECE($GET(^AUPNVHF(HFDA,12)),U,10)]""
SET AUTFDA(9000010.23,AUTIENS,1210)=$PIECE($GET(^AUPNVHF(HFDA,12)),U,10)
+20 IF $PIECE($GET(^AUPNVHF(HFDA,12)),U,15)]""
SET AUTFDA(9000010.23,AUTIENS,1215)=$PIECE($GET(^AUPNVHF(HFDA,12)),U,15)
+21 IF $PIECE($GET(^AUPNVHF(HFDA,801)),U,1)]""
SET AUTFDA(9000010.23,AUTIENS,80101)=$PIECE($GET(^AUPNVHF(HFDA,801)),U,1)
+22 IF $PIECE($GET(^AUPNVHF(HFDA,801)),U,2)]""
SET AUTFDA(9000010.23,AUTIENS,80102)=$PIECE($GET(^AUPNVHF(HFDA,801)),U,2)
+23 IF $PIECE($GET(^AUPNVHF(HFDA,811)),U,1)]""
SET AUTFDA(9000010.23,AUTIENS,81101)=$PIECE($GET(^AUPNVHF(HFDA,811)),U,1)
+24 IF $PIECE($GET(^AUPNVHF(HFDA,812)),U,1)]""
SET AUTFDA(9000010.23,AUTIENS,81201)=$PIECE($GET(^AUPNVHF(HFDA,812)),U,1)
+25 IF $PIECE($GET(^AUPNVHF(HFDA,812)),U,2)]""
SET AUTFDA(9000010.23,AUTIENS,81202)=$PIECE($GET(^AUPNVHF(HFDA,812)),U,2)
+26 IF $PIECE($GET(^AUPNVHF(HFDA,812)),U,3)]""
SET AUTFDA(9000010.23,AUTIENS,81203)=$PIECE($GET(^AUPNVHF(HFDA,812)),U,1)
+27 DO UPDATE^DIE("","AUTFDA","AUTIENS","AUTERRR(1)")
+28 IF $DATA(AUTERRR)
DO MES^XPDUTL("Error creating V Health Factor "_HF_" for visit ien "_VISIT_".")
QUIT
+29 WRITE "."
+30 QUIT
INSTALLD(AUTSTAL) ;EP - Determine if patch AUTSTAL was installed, where
+1 ; AUTSTAL is the name of the INSTALL. E.g "AG*6.0*11".
+2 ;
+3 NEW AUTY,DIC,X,Y
+4 SET X=$PIECE(AUTSTAL,"*",1)
+5 SET DIC="^DIC(9.4,"
SET DIC(0)="FM"
SET D="C"
+6 DO IX^DIC
+7 IF Y<1
DO IMES
QUIT 0
+8 SET DIC=DIC_+Y_",22,"
SET X=$PIECE(AUTSTAL,"*",2)
+9 DO ^DIC
+10 IF Y<1
DO IMES
QUIT 0
+11 SET DIC=DIC_+Y_",""PAH"","
SET X=$PIECE(AUTSTAL,"*",3)
+12 DO ^DIC
+13 SET AUTY=Y
+14 DO IMES
+15 QUIT $SELECT(AUTY<1:0,1:1)
IMES ;
+1 DO MES^XPDUTL($$CJ^XLFSTR("Patch """_AUTSTAL_""" is"_$SELECT(Y<1:" *NOT*",1:"")_" installed.",IOM))
+2 QUIT
SORRY(X) ;
+1 KILL DIFQ
+2 IF X=3
SET XPDQUIT=2
QUIT
+3 SET XPDQUIT=X
+4 WRITE *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
+5 QUIT
