Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AUT98P25

AUT98P25.m

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