PXP211I ;SLC/PKR - Init routine for PX*1.0*211 ;08/27/2020
;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
;======================
ADDDS ;Add entries to PCE DATA SOURCE.
I $O(^PX(839.7,"B","PCE CODE MAPPING",0))>0 Q
N FDA,MSG,WPTMP
S WPTMP(1)="Entry of standard codes as a result of code mapping."
S FDA(839.7,"+1,",.01)="PCE CODE MAPPING"
S FDA(839.7,"+1,",101)="WPTMP"
D UPDATE^DIE("","FDA","","MSG")
Q
;
;======================
BINDEX ;Make sure the "B" index matches what is in the .01, for Education
;Topics, Exams, and Health Factors.
N BNAME,IEN,NAME
D BMES^XPDUTL("Checking B indexes.")
;
D BMES^XPDUTL("Checking Education Topics.")
S BNAME=""
F S BNAME=$O(^AUTTEDT("B",BNAME)) Q:BNAME="" D
. S IEN=$O(^AUTTEDT("B",BNAME,""))
. S NAME=$P($G(^AUTTEDT(IEN,0)),U,1)
. I BNAME=NAME Q
. D BMES^XPDUTL("Setting B index for Education Topic: "_NAME)
. K ^AUTTEDT("B",BNAME)
. S ^AUTTEDT("B",NAME,IEN)=""
;
D BMES^XPDUTL("Checking Exams.")
S BNAME=""
F S BNAME=$O(^AUTTEXAM("B",BNAME)) Q:BNAME="" D
. S IEN=$O(^AUTTEXAM("B",BNAME,""))
. S NAME=$P($G(^AUTTEXAM(IEN,0)),U,1)
. I BNAME=NAME Q
. D BMES^XPDUTL("Setting B index for Exam: "_NAME)
. K ^AUTTEXAM("B",BNAME)
. S ^AUTTEXAM("B",NAME,IEN)=""
;
D BMES^XPDUTL("Checking Health Factors.")
S BNAME=""
F S BNAME=$O(^AUTTHF("B",BNAME)) Q:BNAME="" D
. S IEN=$O(^AUTTHF("B",BNAME,""))
. S NAME=$P($G(^AUTTHF(IEN,0)),U,1)
. I BNAME=NAME Q
. D BMES^XPDUTL("Setting B index for Health Factor: "_NAME)
. K ^AUTTHF("B",BNAME)
. S ^AUTTHF("B",NAME,IEN)=""
Q
;
;======================
DSB ;Redo the PCE Data Source "B" index so it is the full length.
D BMES^XPDUTL("Creating full length 'B' index PCE Data Source.")
;Kill the old "B" index.
K ^PX(839.7,"B")
N DIK
S DIK="^PX(839.7,",DIK(1)=".01^B"
D ENALL^DIK
Q
;
;======================
GENPNAME ;For any entry missing a print names generate one.
N IEN,IENS,FDA,MSG,NAME,PNAME,REPA,TNAME
D HFREPA(.REPA)
D BMES^XPDUTL("Generating Print Names for entries that do not have one.")
;
D BMES^XPDUTL("Checking Education Topics.")
S NAME=""
F S NAME=$O(^AUTTEDT("B",NAME)) Q:NAME="" D
. S IEN=$O(^AUTTEDT("B",NAME,""))
. S PNAME=$P($G(^AUTTEDT(IEN,0)),U,4)
. I PNAME'="" Q
. K FDA,MSG
. S IENS=IEN_","
. S TNAME=$S($E(NAME,1,2)="ZZ":$E(NAME,3,99),1:NAME)
. S PNAME=$$HFPNAME(TNAME,.REPA)
. S FDA(9999999.09,IENS,.04)=PNAME
. D BMES^XPDUTL("Setting Print Name for Education Topic: "_NAME)
. D MES^XPDUTL("Print Name: "_PNAME)
. D FILE^DIE("ET","FDA","MSG")
;
D BMES^XPDUTL("Checking Exams.")
S NAME=""
F S NAME=$O(^AUTTEXAM("B",NAME)) Q:NAME="" D
. S IEN=$O(^AUTTEXAM("B",NAME,""))
. S PNAME=$P($G(^AUTTEXAM(IEN,200)),U,1)
. I PNAME'="" Q
. K FDA,MSG
. S IENS=IEN_","
. S TNAME=$S($E(NAME,1,2)="ZZ":$E(NAME,3,99),1:NAME)
. S PNAME=$$HFPNAME(TNAME,.REPA)
. S FDA(9999999.15,IENS,200)=PNAME
. D BMES^XPDUTL("Setting Print Name for Exam: "_NAME)
. D MES^XPDUTL("Print Name: "_PNAME)
. D FILE^DIE("ET","FDA","MSG")
;
D BMES^XPDUTL("Checking Health Factors.")
S NAME=""
F S NAME=$O(^AUTTHF("B",NAME)) Q:(NAME="") D
. S IEN=$O(^AUTTHF("B",NAME,""))
. S PNAME=$P($G(^AUTTHF(IEN,200)),U,1)
. I PNAME'="" Q
. K FDA,MSG
. S IENS=IEN_","
. S TNAME=$S($E(NAME,1,2)="ZZ":$E(NAME,3,99),1:NAME)
. S PNAME=$$HFPNAME(TNAME,.REPA)
. S FDA(9999999.64,IENS,200)=PNAME
. D BMES^XPDUTL("Setting Print Name for Health Factor: "_NAME)
. D MES^XPDUTL("Print Name: "_PNAME)
. D FILE^DIE("ET","FDA","MSG")
Q
;
;======================
HFCAT ;Append "[C]" to the .01 of all category factors.
N CNAME,CNAMEIEN,IEN,LEN,L3C,NAME,NRPT,REPOINT
D BMES^XPDUTL("Appending [C] to the .01 of all category health factors.")
S IEN="",NRPT=0
F S IEN=+$O(^AUTTHF("AD","C",IEN)) Q:IEN=0 D
. S NAME=$P(^AUTTHF(IEN,0),U,1)
. S LEN=$L(NAME),L3C=$E(NAME,(LEN-2),LEN)
. I L3C="[C]" Q
. S CNAME=NAME_" [C]"
.;Does CNAME already exist?
. S CNAMEIEN=+$$FIND1^DIC(9999999.64,"","BXU",CNAME)
. I CNAMEIEN>0 D Q
.. W !!,"CNAME AND NAME BOTH EXIST"
.. W !,"NAME=",NAME," IEN=",IEN
.. W !,"CNAME=",CNAME," CNAMEIEN=",CNAMEIEN
..;Keep the entry with the lowest IEN.
.. S NRPT=NRPT+1
.. I IEN<CNAMEIEN S REPOINT(NRPT)=CNAMEIEN_U_IEN
.. E S REPOINT(NRPT)=IEN_U_CNAMEIEN
. D RENAME^PXUTIL(9999999.64,NAME,CNAME)
Q
;
;======================
HFPNAME(NAME,REPA) ;Turn name into a print name for health factors.
N CF,CHAR,CP,PNAME,ONC
I $E(NAME,1,3)="VA-" S PNAME=$E(NAME,4,99)
E S PNAME=NAME
S ONC=0
I $E(NAME,1,3)="ONC" S ONC=1
I 'ONC S PNAME=$$TITLE^XLFSTR(PNAME)
S PNAME=$$REPLACE^XLFSTR(PNAME,.REPA)
;Make sure characters following those below are uppercase.
F CHAR="-","/","\" D
. S CP=0
. F S CP=$F(PNAME,CHAR,CP) Q:CP=0 D
.. S CF=$E(PNAME,CP)
.. S $E(PNAME,CP)=$$UP^XLFSTR(CF)
Q PNAME
;
;======================
HFREPA(REPA) ;Establish the replacements for health factor print names.
;AH health factors
S REPA("Abn ")="ABN ",REPA("Abg")="ABG"
S REPA("Ah-bpr")="Airborne Hazard Burn Pit Registry"
S REPA(" Cbc")=" CBC",REPA(" Cc")=" CC"
S REPA(" Ent ")=" ENT ",REPA("/onc")="/ONC"
;
;ARCH health factors
S REPA("Arch")="ARCH"
S REPA("-no")="-No",REPA("-service")="-Service"
;
;CGA health factors
S REPA("Cg ")="CG ",REPA("Cga ")="Caregiver Annual Assessment "
S REPA(" Pc")=" PC"
S REPA("W/out")="W/OUT",REPA("Zbi ")="ZBI "
;
;CGF health factors
S REPA("Cgf")="Caregiver 90 Day Monitoring Assessments"
S REPA(" Cvt")=" CVT",REPA(" Mh")=" MH"
;
;CGI health factors
S REPA("Cgi")="Caregiver Initial Assessment"
;
;CGINT health factors
S REPA("Cgint")="Caregiver Interim Assessment"
;
;Ebola health factors
S REPA("W/o")="W/O"
;
;ECOE health factors
S REPA("Aed ")="AED ",REPA("Aeds")="AEDS"
S REPA("Ecoe")="Epilepsy Center Of Excellence"
S REPA("Eeg ")="EEG ",REPA("Mh ")="MH ",REPA("Mri ")="MRI "
S REPA("Pet ")="PET ",REPA("Qolie")="QOLIE"
S REPA("Tbi")="TBI",REPA("Vid ")="VID ",REPA("Vns")="VNS"
S REPA("Wada")="WADA"
;
;Embedded Fragments
S REPA("Ef-")="Embedded Fragments-",REPA("-ied")="-IED"
S REPA("rpg")="RPG"
;
;GEC health factors
S REPA("Adl")="ADL",REPA("bipap")="BIPAP",REPA("Cpap")="CPAP"
S REPA("Dpoa ")="DPOA ",REPA("Iadl")="IADL",REPA("Iv ")="IV "
S REPA("Fx")="FX",REPA("Gec")="Geriatric Extended Care"
S REPA("Geri ")="GERI "
S REPA("-medicaid")="-Medicaid",REPA("-medicare")="-Medicare"
S REPA("Nhcu")="NHCU",REPA("Pt-")="PT-",REPA("/pt")="/PT"
S REPA("Pt/ot")="PT/OT",REPA("t+/-30d")="T+/-30D",REPA("Tx-")="TX-"
S REPA("-va")="-VA",REPA("Va ")="VA ",REPA("-yes")="-Yes"
S REPA("Wc ")="WC "
;
;Hepatitis C Virus
S REPA("-hcv")="-Hepatitis C Virus",REPA("Hcv")="Hepatitis C Virus"
S REPA("Hiv")="HIV"
;
;Miscellaneous
S REPA("Aaa")="AAA",REPA("AAa")="AAA",REPA("Abd ")="ABD "
S REPA("Acwy")="ACWY"
S REPA("Cm")="cm",REPA("Fobt")="FOBT",REPA("Hpv")="HPV"
S REPA("Ihd")="IHD",REPA("-mh")="-MH",REPA("Md ")="MD "
S REPA("Oef")="OEF",REPA("/oif")="/OIF",REPA("Oif")="OIF"
S REPA("Na ")="NA ",REPA("Tb ")="TB ",REPA("Zzmh")="ZZMH"
;
;MH health factors
S REPA("2Nd")="2nd",REPA("3Rd")="3rd"
S REPA("Act ")="ACT ",REPA("Bft ")="BFT "
S REPA("Cbt-i")="CBT-I",REPA("Cbt-d")="CBT-D",REPA("Cog ")="COG "
S REPA("Cpt ")="CPT ",REPA("Cqs")="CQS"
S REPA("Dbas ")="DBAS ",REPA("Ebp ")="EBP ",REPA("Ibct ")="IBCT "
S REPA("Ipt ")="IPT ",REPA("Isi ")="ISI ",REPA("Mh ")="MH "
S REPA("Mst")="MST",REPA("Pct ")="PCT "
S REPA("Pei ")="PEI ",REPA("Phq9")="PHQ-9",REPA("Q&a")="Q&A"
S REPA("Snq ")="SNQ ",REPA(" Ssn")=" SSN",REPA("Sst")="SST"
S REPA("Waso")="WASO"
;
;ONC health factors
S REPA("Ecog")="ECOG",REPA("ONC ")="Oncology ",REPA("(Onc) ")=""
S REPA("Onc Pca")="ONC PCA"
S REPA("Pca")="PCA",REPA("Sob")="SOB",REPA("Vsas")="VSAS"
;
;ONS health factors
S REPA("Aa ")="AA ",REPA("amb ")="AMB ",REPA("Amb ")="AMB "
S REPA("Cant")="Can't",REPA("Ca/tbi")="CA/TBI",REPA("Cv ")="CV "
S REPA("Etoh")="ETOH",REPA("Fr ")="FR ",REPA(" Gi")=" GI"
S REPA("Gi ")="GI "
S REPA("Gu ")="GU ",REPA("hn ")="HN ",REPA("Hob ")="Head of Bed "
S REPA("hob")="Head of Bed",REPA("Ic ")="IC ",REPA("Id-")="ID-"
S REPA(" Ii")=" II",REPA(" Iii")=" III",REPA("Iv ")="IV "
S REPA("Ldl")="LDL"
S REPA("Mrsa")="MRSA",REPA("Ms ")="MS ",REPA("Ntf")="NTF"
S REPA("Ons ")="ONS "
S REPA(" Oob")=" OOB",REPA("Pf ")="PF "
S REPA("Pu ")="Pressure Ulcer "
S REPA("Q2h")="Q2H",REPA("Ra ")="RA "
S REPA(" Rn")=" RN",REPA(" Tv")=" TV"
;
;PTSD health factors
S REPA("Ptsd")="PTSD"
;
;TBI health factors
S REPA(" Ii")=" II",REPA(" Iii")=" III",REPA(" Iv")=" IV"
S REPA("-pt")="-Pt"
;
;TDI health factors
S REPA("Tdi")="Telederm Imager",REPA("Tdr")="Telederm Reader"
;
;TDR health factors
S REPA("Pcc")="PCC"
;
;VANOD health factors
S REPA("Vanod")="VANOD"
;
;VC health factors
S REPA("Vc ")="Veteran's Choice "
;
;WH health factors
S REPA("F/u")="F/U",REPA(" Hf")=" HF",REPA("le<")="LE<"
S REPA("N/a")="N/A",REPA("Wh ")="Women's Health ",REPA("Zzwh")="ZZWH"
Q
;
;======================
MVTREAT ;Move Treatment from sequence 13 to 15 on PXCE ADD/EDIT MENU.
N IENM,IENT,IND
S IENM=$$FIND1^DIC(101,"","BX","PXCE ADD/EDIT MENU")
I IENM="" D Q
. D BMES^XPDUTL("The PXCE ADD/EDIT MENU does not exist.")
S IENT=$$FIND1^DIC(101,"","BX","PXCE TREATMENT ADD")
I IENT="" D Q
. D BMES^XPDUTL("PXCE TREATMENT ADD does not exist.")
S IND=$O(^ORD(101,IENM,10,"B",IENT,""))
I IND="" Q
S $P(^ORD(101,IENM,10,IND,0),U,3)=15
Q
;
;======================
PRE ;Pre-init
D BINDEX
D RMOLDDDS
D MVTREAT
Q
;
;======================
POST ;Post-init
D ADDDS^PXP211I
D SETCLASS^PXP211I
D GENPNAME^PXP211I
D UPCNAME^PXP211I
D HFCAT^PXP211I
D VSCITASK^PXP211I
D DSB^PXP211I
D PROVNARB^PXP211I
D RBLDBI^PXP211I
D RMNCTE^PXP211I
;HMP has been decomissioned so remove this protocol.
N RESULT
S RESULT=$$DELETE^XPDPROT("PXK VISIT DATA EVENT","HMP PCE EVENTS")
D SDPCE^PXP211I
D RMPNSCREEN
D TASKBOTH^PXPNARR
Q
;
;======================
PROVNARB ;Redo the Provider Narrative "B" index so it is the full
;length.
;First determine if the new full-length "B" index is already in place.
N LEN,MAXLEN,NAME
S MAXLEN=0,NAME=""
F S NAME=$O(^AUTNPOV("B",NAME)) Q:(MAXLEN>30)!(NAME="") D
. S LEN=$L(NAME)
. I LEN>MAXLEN S MAXLEN=LEN
I MAXLEN>30 Q
;
D BMES^XPDUTL("Creating new full length 'B' index for Provider Narrative.")
;Kill the old "B" index.
K ^AUTNPOV("B")
N DIK
S DIK="^AUTNPOV(",DIK(1)=".01^B"
D ENALL^DIK
Q
;
;======================
RBLDBI ;Make sure the is only one "B" index for PCE Data Source and
;Education Topics.
N DIK
K ^AUTTEDT("B")
S DIK="^AUTTEDT(",DIK(1)=".01^B"
D ENALL^DIK
K ^PX(839.7,"B")
S DIK="^PX(839.7,",DIK(1)=".01^B"
D ENALL^DIK
Q
;
;======================
RMNCTE ;Remove the national class entries that were created for testing.
D DELTLFE^PXUTIL(9999999.09,"VA-NATIONAL CLASS TEST")
D DELTLFE^PXUTIL(9999999.15,"VA-NATIONAL CLASS TEST")
D DELTLFE^PXUTIL(9999999.64,"VA-NATIONAL CLASS TEST")
Q
;
;======================
RMOLDDDS ;Remove old data dictionaries.
N DIU,TEXT
D BMES^XPDUTL("Removing old data dictionaries.")
S DIU(0)=""
F DIU=815,839.7,9000010,9000010.07,9000010.11,9000010.12,9000010.13,9000010.16,9000010.18,9000010.23,9000010.71,9999999.09,9999999.15,9999999.27,9999999.64 D
. S TEXT=" Deleting data dictionary for file # "_DIU
. D MES^XPDUTL(TEXT)
. D EN^DIU2
Q
;
;======================
RMPNSCREEN ;Remove the incorrect Provider Narrative screens.
;ICR #6256
;V CPT
K ^DD(9000010.18,.04,12)
K ^DD(9000010.18,.04,12.1)
;V POV
K ^DD(9000010.07,.04,12)
K ^DD(9000010.07,.04,12.1)
Q
;
;======================
SDPCE ;Edit the Description and Entry Action of the protocol SDAM PCE EVENT.
;ICR #7110.
N FDA,IEN,IENS,MSG,WPTMP
S IEN=+$$FIND1^DIC(101,"","","SDAM PCE EVENT","","","MSG")
I IEN=0 Q
S WPTMP(1)="This protocol is the event handler attached to the PXK VISIT DATA EVENT protocol."
S WPTMP(2)=""
S WPTMP(3)="The protocol processes scheduled appointment check out data made available by this PCE event point. PCE currently obtains this check out data from MCCR data capture pilots and also a manual entry module within the PCE package."
S WPTMP(4)=""
S WPTMP(5)="To allow processing of the other items attached to PXK VISIT DATA EVENT as a TaskMan job, the call to EN^SDPCE was moved to EVENT^PXKMAIN in patch PX*1*211."
S IENS=IEN_","
S FDA(101,IENS,3.5)="WPTMP"
S FDA(101,IENS,20)=";D EN^SDPCE"
D FILE^DIE("","FDA","MSG")
Q
;
;======================
SETCLASS ;Until a decision on national entries has been made make everything
;local.
N CLASS,FDA,IEN,IENS,IND,MSG,NAME
D BMES^XPDUTL("Setting undefined Education Topic Class fields.")
S NAME=""
F S NAME=$O(^AUTTEDT("B",NAME)) Q:NAME="" D
. I NAME="VA-NATIONAL CLASS TEST" Q
. S IEN=$O(^AUTTEDT("B",NAME,""))
. D MES^XPDUTL(" Setting the Class of Education Topic: "_NAME_" to LOCAL.")
. K FDA,MSG
. S IENS=IEN_","
.;Remove "VA-" from any non-national entries.
. ;I $E(NAME,1,3)="VA-" S FDA(9999999.09,IENS,.01)=$E(NAME,4,99)
. S FDA(9999999.09,IENS,100)="L"
. D FILE^DIE("ET","FDA","MSG")
;
;Make all Exam entries local and if the name starts with "VA-"
;remove it.
D BMES^XPDUTL("Setting all Exam Class fields to LOCAL.")
S NAME=""
F S NAME=$O(^AUTTEXAM("B",NAME)) Q:NAME="" D
. I NAME="VA-NATIONAL CLASS TEST" Q
. S IEN=$O(^AUTTEXAM("B",NAME,""))
. D MES^XPDUTL(" Setting the Class of EXAM: "_NAME_" to LOCAL.")
. K FDA,MSG
. S IENS=IEN_","
.;Remove "VA-" from any non-national entries.
. I $E(NAME,1,3)="VA-" S FDA(9999999.15,IENS,.01)=$E(NAME,4,99)
. S FDA(9999999.15,IENS,100)="L"
. D FILE^DIE("ET","FDA","MSG")
;
D BMES^XPDUTL("Setting undefined Health Factor Class fields.")
S NAME=""
F S NAME=$O(^AUTTHF("B",NAME)) Q:NAME="" D
. I NAME="VA-NATIONAL CLASS TEST" Q
. S IEN=$O(^AUTTHF("B",NAME,""))
. D MES^XPDUTL(" Setting the Class of HF: "_NAME_" to LOCAL.")
. K FDA,MSG
. S IENS=IEN_","
. S FDA(9999999.64,IENS,100)="L"
. D FILE^DIE("ET","FDA","MSG")
Q
;
;======================
UPCNAME ;Make sure all entries have upppercase .01s.
N IEN,IENS,FDA,MSG,NAME,PXNAT,UPCNAME
S PXNAT=1
D BMES^XPDUTL("Making sure all .01s are uppercase.")
;
D BMES^XPDUTL("Checking Education Topics.")
S NAME=""
F S NAME=$O(^AUTTEDT("B",NAME)) Q:NAME="" D
. S UPCNAME=$$UP^XLFSTR(NAME)
. I NAME=UPCNAME Q
. S IEN=$O(^AUTTEDT("B",NAME,""))
. K FDA,MSG
. S IENS=IEN_","
. S FDA(9999999.09,IENS,.01)=UPCNAME
. D BMES^XPDUTL("Setting Education Topic: "_NAME)
. D MES^XPDUTL("To: "_UPCNAME)
. D FILE^DIE("ET","FDA","MSG")
;
D BMES^XPDUTL("Checking Exams.")
S NAME=""
F S NAME=$O(^AUTTEXAM("B",NAME)) Q:NAME="" D
. S UPCNAME=$$UP^XLFSTR(NAME)
. I NAME=UPCNAME Q
. S IEN=$O(^AUTTEXAM("B",NAME,""))
. K FDA,MSG
. S IENS=IEN_","
. S FDA(9999999.15,IENS,.01)=UPCNAME
. D BMES^XPDUTL("Setting Exam: "_NAME)
. D MES^XPDUTL("To: "_UPCNAME)
. D FILE^DIE("ET","FDA","MSG")
;
D BMES^XPDUTL("Checking Health Factors.")
S NAME=""
F S NAME=$O(^AUTTHF("B",NAME)) Q:(NAME="") D
. S UPCNAME=$$UP^XLFSTR(NAME)
. I NAME=UPCNAME Q
. S IEN=$O(^AUTTHF("B",NAME,""))
. S IENS=IEN_","
. K FDA,MSG
. S FDA(9999999.64,IENS,.01)=UPCNAME
. D BMES^XPDUTL("Setting Health Factor: "_NAME)
. D MES^XPDUTL("To: "_UPCNAME)
. D FILE^DIE("ET","FDA","MSG")
Q
;
;======================
VSCINDEX ;Initialize or rebuild the Clinical Reminders Index for V Standard Codes.
I '$D(^PXRMINDX(9000010.71,"DATE BUILT")) D
. D BMES^XPDUTL("Initializing Clinical Reminders Index for V Standard Codes.")
. D VSC^PXPXRMI2
;Rebuild only necessary in test accounts that have entries.
I $$PROD^XUPROD(1) Q
I $P($G(^AUPNVSC(0)),U,4)=0 Q
N DIK
D BMES^XPDUTL("Rebuilding V Standard Codes indexes.")
S DIK="^AUPNVSC("
D IXALL2^DIK
D IXALL^DIK
D VSC^PXPXRMI2
S ZTREQ="@"
Q
;
;======================
VSCITASK ;Start a TaskMan job the for rebuilding the V Standard Codes
;indexes.
N TEXT
S TEXT(1)="Starting a TaskMan job to initialize/rebuild V STANDARD CODES indexes."
S ZTRTN="VSCINDEX^PXP211I"
S ZTDESC="Build V STANDARD CODES indexes"
S ZTDTH=$$NOW^XLFDT
S ZTIO=""
D ^%ZTLOAD
S TEXT(2)="The task number is: "_ZTSK
D BMES^XPDUTL(.TEXT)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXP211I 16653 printed Dec 13, 2024@02:29:47 Page 2
PXP211I ;SLC/PKR - Init routine for PX*1.0*211 ;08/27/2020
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
+2 ;======================
ADDDS ;Add entries to PCE DATA SOURCE.
+1 IF $ORDER(^PX(839.7,"B","PCE CODE MAPPING",0))>0
QUIT
+2 NEW FDA,MSG,WPTMP
+3 SET WPTMP(1)="Entry of standard codes as a result of code mapping."
+4 SET FDA(839.7,"+1,",.01)="PCE CODE MAPPING"
+5 SET FDA(839.7,"+1,",101)="WPTMP"
+6 DO UPDATE^DIE("","FDA","","MSG")
+7 QUIT
+8 ;
+9 ;======================
BINDEX ;Make sure the "B" index matches what is in the .01, for Education
+1 ;Topics, Exams, and Health Factors.
+2 NEW BNAME,IEN,NAME
+3 DO BMES^XPDUTL("Checking B indexes.")
+4 ;
+5 DO BMES^XPDUTL("Checking Education Topics.")
+6 SET BNAME=""
+7 FOR
SET BNAME=$ORDER(^AUTTEDT("B",BNAME))
if BNAME=""
QUIT
Begin DoDot:1
+8 SET IEN=$ORDER(^AUTTEDT("B",BNAME,""))
+9 SET NAME=$PIECE($GET(^AUTTEDT(IEN,0)),U,1)
+10 IF BNAME=NAME
QUIT
+11 DO BMES^XPDUTL("Setting B index for Education Topic: "_NAME)
+12 KILL ^AUTTEDT("B",BNAME)
+13 SET ^AUTTEDT("B",NAME,IEN)=""
End DoDot:1
+14 ;
+15 DO BMES^XPDUTL("Checking Exams.")
+16 SET BNAME=""
+17 FOR
SET BNAME=$ORDER(^AUTTEXAM("B",BNAME))
if BNAME=""
QUIT
Begin DoDot:1
+18 SET IEN=$ORDER(^AUTTEXAM("B",BNAME,""))
+19 SET NAME=$PIECE($GET(^AUTTEXAM(IEN,0)),U,1)
+20 IF BNAME=NAME
QUIT
+21 DO BMES^XPDUTL("Setting B index for Exam: "_NAME)
+22 KILL ^AUTTEXAM("B",BNAME)
+23 SET ^AUTTEXAM("B",NAME,IEN)=""
End DoDot:1
+24 ;
+25 DO BMES^XPDUTL("Checking Health Factors.")
+26 SET BNAME=""
+27 FOR
SET BNAME=$ORDER(^AUTTHF("B",BNAME))
if BNAME=""
QUIT
Begin DoDot:1
+28 SET IEN=$ORDER(^AUTTHF("B",BNAME,""))
+29 SET NAME=$PIECE($GET(^AUTTHF(IEN,0)),U,1)
+30 IF BNAME=NAME
QUIT
+31 DO BMES^XPDUTL("Setting B index for Health Factor: "_NAME)
+32 KILL ^AUTTHF("B",BNAME)
+33 SET ^AUTTHF("B",NAME,IEN)=""
End DoDot:1
+34 QUIT
+35 ;
+36 ;======================
DSB ;Redo the PCE Data Source "B" index so it is the full length.
+1 DO BMES^XPDUTL("Creating full length 'B' index PCE Data Source.")
+2 ;Kill the old "B" index.
+3 KILL ^PX(839.7,"B")
+4 NEW DIK
+5 SET DIK="^PX(839.7,"
SET DIK(1)=".01^B"
+6 DO ENALL^DIK
+7 QUIT
+8 ;
+9 ;======================
GENPNAME ;For any entry missing a print names generate one.
+1 NEW IEN,IENS,FDA,MSG,NAME,PNAME,REPA,TNAME
+2 DO HFREPA(.REPA)
+3 DO BMES^XPDUTL("Generating Print Names for entries that do not have one.")
+4 ;
+5 DO BMES^XPDUTL("Checking Education Topics.")
+6 SET NAME=""
+7 FOR
SET NAME=$ORDER(^AUTTEDT("B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+8 SET IEN=$ORDER(^AUTTEDT("B",NAME,""))
+9 SET PNAME=$PIECE($GET(^AUTTEDT(IEN,0)),U,4)
+10 IF PNAME'=""
QUIT
+11 KILL FDA,MSG
+12 SET IENS=IEN_","
+13 SET TNAME=$SELECT($EXTRACT(NAME,1,2)="ZZ":$EXTRACT(NAME,3,99),1:NAME)
+14 SET PNAME=$$HFPNAME(TNAME,.REPA)
+15 SET FDA(9999999.09,IENS,.04)=PNAME
+16 DO BMES^XPDUTL("Setting Print Name for Education Topic: "_NAME)
+17 DO MES^XPDUTL("Print Name: "_PNAME)
+18 DO FILE^DIE("ET","FDA","MSG")
End DoDot:1
+19 ;
+20 DO BMES^XPDUTL("Checking Exams.")
+21 SET NAME=""
+22 FOR
SET NAME=$ORDER(^AUTTEXAM("B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+23 SET IEN=$ORDER(^AUTTEXAM("B",NAME,""))
+24 SET PNAME=$PIECE($GET(^AUTTEXAM(IEN,200)),U,1)
+25 IF PNAME'=""
QUIT
+26 KILL FDA,MSG
+27 SET IENS=IEN_","
+28 SET TNAME=$SELECT($EXTRACT(NAME,1,2)="ZZ":$EXTRACT(NAME,3,99),1:NAME)
+29 SET PNAME=$$HFPNAME(TNAME,.REPA)
+30 SET FDA(9999999.15,IENS,200)=PNAME
+31 DO BMES^XPDUTL("Setting Print Name for Exam: "_NAME)
+32 DO MES^XPDUTL("Print Name: "_PNAME)
+33 DO FILE^DIE("ET","FDA","MSG")
End DoDot:1
+34 ;
+35 DO BMES^XPDUTL("Checking Health Factors.")
+36 SET NAME=""
+37 FOR
SET NAME=$ORDER(^AUTTHF("B",NAME))
if (NAME="")
QUIT
Begin DoDot:1
+38 SET IEN=$ORDER(^AUTTHF("B",NAME,""))
+39 SET PNAME=$PIECE($GET(^AUTTHF(IEN,200)),U,1)
+40 IF PNAME'=""
QUIT
+41 KILL FDA,MSG
+42 SET IENS=IEN_","
+43 SET TNAME=$SELECT($EXTRACT(NAME,1,2)="ZZ":$EXTRACT(NAME,3,99),1:NAME)
+44 SET PNAME=$$HFPNAME(TNAME,.REPA)
+45 SET FDA(9999999.64,IENS,200)=PNAME
+46 DO BMES^XPDUTL("Setting Print Name for Health Factor: "_NAME)
+47 DO MES^XPDUTL("Print Name: "_PNAME)
+48 DO FILE^DIE("ET","FDA","MSG")
End DoDot:1
+49 QUIT
+50 ;
+51 ;======================
HFCAT ;Append "[C]" to the .01 of all category factors.
+1 NEW CNAME,CNAMEIEN,IEN,LEN,L3C,NAME,NRPT,REPOINT
+2 DO BMES^XPDUTL("Appending [C] to the .01 of all category health factors.")
+3 SET IEN=""
SET NRPT=0
+4 FOR
SET IEN=+$ORDER(^AUTTHF("AD","C",IEN))
if IEN=0
QUIT
Begin DoDot:1
+5 SET NAME=$PIECE(^AUTTHF(IEN,0),U,1)
+6 SET LEN=$LENGTH(NAME)
SET L3C=$EXTRACT(NAME,(LEN-2),LEN)
+7 IF L3C="[C]"
QUIT
+8 SET CNAME=NAME_" [C]"
+9 ;Does CNAME already exist?
+10 SET CNAMEIEN=+$$FIND1^DIC(9999999.64,"","BXU",CNAME)
+11 IF CNAMEIEN>0
Begin DoDot:2
+12 WRITE !!,"CNAME AND NAME BOTH EXIST"
+13 WRITE !,"NAME=",NAME," IEN=",IEN
+14 WRITE !,"CNAME=",CNAME," CNAMEIEN=",CNAMEIEN
+15 ;Keep the entry with the lowest IEN.
+16 SET NRPT=NRPT+1
+17 IF IEN<CNAMEIEN
SET REPOINT(NRPT)=CNAMEIEN_U_IEN
+18 IF '$TEST
SET REPOINT(NRPT)=IEN_U_CNAMEIEN
End DoDot:2
QUIT
+19 DO RENAME^PXUTIL(9999999.64,NAME,CNAME)
End DoDot:1
+20 QUIT
+21 ;
+22 ;======================
HFPNAME(NAME,REPA) ;Turn name into a print name for health factors.
+1 NEW CF,CHAR,CP,PNAME,ONC
+2 IF $EXTRACT(NAME,1,3)="VA-"
SET PNAME=$EXTRACT(NAME,4,99)
+3 IF '$TEST
SET PNAME=NAME
+4 SET ONC=0
+5 IF $EXTRACT(NAME,1,3)="ONC"
SET ONC=1
+6 IF 'ONC
SET PNAME=$$TITLE^XLFSTR(PNAME)
+7 SET PNAME=$$REPLACE^XLFSTR(PNAME,.REPA)
+8 ;Make sure characters following those below are uppercase.
+9 FOR CHAR="-","/","\"
Begin DoDot:1
+10 SET CP=0
+11 FOR
SET CP=$FIND(PNAME,CHAR,CP)
if CP=0
QUIT
Begin DoDot:2
+12 SET CF=$EXTRACT(PNAME,CP)
+13 SET $EXTRACT(PNAME,CP)=$$UP^XLFSTR(CF)
End DoDot:2
End DoDot:1
+14 QUIT PNAME
+15 ;
+16 ;======================
HFREPA(REPA) ;Establish the replacements for health factor print names.
+1 ;AH health factors
+2 SET REPA("Abn ")="ABN "
SET REPA("Abg")="ABG"
+3 SET REPA("Ah-bpr")="Airborne Hazard Burn Pit Registry"
+4 SET REPA(" Cbc")=" CBC"
SET REPA(" Cc")=" CC"
+5 SET REPA(" Ent ")=" ENT "
SET REPA("/onc")="/ONC"
+6 ;
+7 ;ARCH health factors
+8 SET REPA("Arch")="ARCH"
+9 SET REPA("-no")="-No"
SET REPA("-service")="-Service"
+10 ;
+11 ;CGA health factors
+12 SET REPA("Cg ")="CG "
SET REPA("Cga ")="Caregiver Annual Assessment "
+13 SET REPA(" Pc")=" PC"
+14 SET REPA("W/out")="W/OUT"
SET REPA("Zbi ")="ZBI "
+15 ;
+16 ;CGF health factors
+17 SET REPA("Cgf")="Caregiver 90 Day Monitoring Assessments"
+18 SET REPA(" Cvt")=" CVT"
SET REPA(" Mh")=" MH"
+19 ;
+20 ;CGI health factors
+21 SET REPA("Cgi")="Caregiver Initial Assessment"
+22 ;
+23 ;CGINT health factors
+24 SET REPA("Cgint")="Caregiver Interim Assessment"
+25 ;
+26 ;Ebola health factors
+27 SET REPA("W/o")="W/O"
+28 ;
+29 ;ECOE health factors
+30 SET REPA("Aed ")="AED "
SET REPA("Aeds")="AEDS"
+31 SET REPA("Ecoe")="Epilepsy Center Of Excellence"
+32 SET REPA("Eeg ")="EEG "
SET REPA("Mh ")="MH "
SET REPA("Mri ")="MRI "
+33 SET REPA("Pet ")="PET "
SET REPA("Qolie")="QOLIE"
+34 SET REPA("Tbi")="TBI"
SET REPA("Vid ")="VID "
SET REPA("Vns")="VNS"
+35 SET REPA("Wada")="WADA"
+36 ;
+37 ;Embedded Fragments
+38 SET REPA("Ef-")="Embedded Fragments-"
SET REPA("-ied")="-IED"
+39 SET REPA("rpg")="RPG"
+40 ;
+41 ;GEC health factors
+42 SET REPA("Adl")="ADL"
SET REPA("bipap")="BIPAP"
SET REPA("Cpap")="CPAP"
+43 SET REPA("Dpoa ")="DPOA "
SET REPA("Iadl")="IADL"
SET REPA("Iv ")="IV "
+44 SET REPA("Fx")="FX"
SET REPA("Gec")="Geriatric Extended Care"
+45 SET REPA("Geri ")="GERI "
+46 SET REPA("-medicaid")="-Medicaid"
SET REPA("-medicare")="-Medicare"
+47 SET REPA("Nhcu")="NHCU"
SET REPA("Pt-")="PT-"
SET REPA("/pt")="/PT"
+48 SET REPA("Pt/ot")="PT/OT"
SET REPA("t+/-30d")="T+/-30D"
SET REPA("Tx-")="TX-"
+49 SET REPA("-va")="-VA"
SET REPA("Va ")="VA "
SET REPA("-yes")="-Yes"
+50 SET REPA("Wc ")="WC "
+51 ;
+52 ;Hepatitis C Virus
+53 SET REPA("-hcv")="-Hepatitis C Virus"
SET REPA("Hcv")="Hepatitis C Virus"
+54 SET REPA("Hiv")="HIV"
+55 ;
+56 ;Miscellaneous
+57 SET REPA("Aaa")="AAA"
SET REPA("AAa")="AAA"
SET REPA("Abd ")="ABD "
+58 SET REPA("Acwy")="ACWY"
+59 SET REPA("Cm")="cm"
SET REPA("Fobt")="FOBT"
SET REPA("Hpv")="HPV"
+60 SET REPA("Ihd")="IHD"
SET REPA("-mh")="-MH"
SET REPA("Md ")="MD "
+61 SET REPA("Oef")="OEF"
SET REPA("/oif")="/OIF"
SET REPA("Oif")="OIF"
+62 SET REPA("Na ")="NA "
SET REPA("Tb ")="TB "
SET REPA("Zzmh")="ZZMH"
+63 ;
+64 ;MH health factors
+65 SET REPA("2Nd")="2nd"
SET REPA("3Rd")="3rd"
+66 SET REPA("Act ")="ACT "
SET REPA("Bft ")="BFT "
+67 SET REPA("Cbt-i")="CBT-I"
SET REPA("Cbt-d")="CBT-D"
SET REPA("Cog ")="COG "
+68 SET REPA("Cpt ")="CPT "
SET REPA("Cqs")="CQS"
+69 SET REPA("Dbas ")="DBAS "
SET REPA("Ebp ")="EBP "
SET REPA("Ibct ")="IBCT "
+70 SET REPA("Ipt ")="IPT "
SET REPA("Isi ")="ISI "
SET REPA("Mh ")="MH "
+71 SET REPA("Mst")="MST"
SET REPA("Pct ")="PCT "
+72 SET REPA("Pei ")="PEI "
SET REPA("Phq9")="PHQ-9"
SET REPA("Q&a")="Q&A"
+73 SET REPA("Snq ")="SNQ "
SET REPA(" Ssn")=" SSN"
SET REPA("Sst")="SST"
+74 SET REPA("Waso")="WASO"
+75 ;
+76 ;ONC health factors
+77 SET REPA("Ecog")="ECOG"
SET REPA("ONC ")="Oncology "
SET REPA("(Onc) ")=""
+78 SET REPA("Onc Pca")="ONC PCA"
+79 SET REPA("Pca")="PCA"
SET REPA("Sob")="SOB"
SET REPA("Vsas")="VSAS"
+80 ;
+81 ;ONS health factors
+82 SET REPA("Aa ")="AA "
SET REPA("amb ")="AMB "
SET REPA("Amb ")="AMB "
+83 SET REPA("Cant")="Can't"
SET REPA("Ca/tbi")="CA/TBI"
SET REPA("Cv ")="CV "
+84 SET REPA("Etoh")="ETOH"
SET REPA("Fr ")="FR "
SET REPA(" Gi")=" GI"
+85 SET REPA("Gi ")="GI "
+86 SET REPA("Gu ")="GU "
SET REPA("hn ")="HN "
SET REPA("Hob ")="Head of Bed "
+87 SET REPA("hob")="Head of Bed"
SET REPA("Ic ")="IC "
SET REPA("Id-")="ID-"
+88 SET REPA(" Ii")=" II"
SET REPA(" Iii")=" III"
SET REPA("Iv ")="IV "
+89 SET REPA("Ldl")="LDL"
+90 SET REPA("Mrsa")="MRSA"
SET REPA("Ms ")="MS "
SET REPA("Ntf")="NTF"
+91 SET REPA("Ons ")="ONS "
+92 SET REPA(" Oob")=" OOB"
SET REPA("Pf ")="PF "
+93 SET REPA("Pu ")="Pressure Ulcer "
+94 SET REPA("Q2h")="Q2H"
SET REPA("Ra ")="RA "
+95 SET REPA(" Rn")=" RN"
SET REPA(" Tv")=" TV"
+96 ;
+97 ;PTSD health factors
+98 SET REPA("Ptsd")="PTSD"
+99 ;
+100 ;TBI health factors
+101 SET REPA(" Ii")=" II"
SET REPA(" Iii")=" III"
SET REPA(" Iv")=" IV"
+102 SET REPA("-pt")="-Pt"
+103 ;
+104 ;TDI health factors
+105 SET REPA("Tdi")="Telederm Imager"
SET REPA("Tdr")="Telederm Reader"
+106 ;
+107 ;TDR health factors
+108 SET REPA("Pcc")="PCC"
+109 ;
+110 ;VANOD health factors
+111 SET REPA("Vanod")="VANOD"
+112 ;
+113 ;VC health factors
+114 SET REPA("Vc ")="Veteran's Choice "
+115 ;
+116 ;WH health factors
+117 SET REPA("F/u")="F/U"
SET REPA(" Hf")=" HF"
SET REPA("le<")="LE<"
+118 SET REPA("N/a")="N/A"
SET REPA("Wh ")="Women's Health "
SET REPA("Zzwh")="ZZWH"
+119 QUIT
+120 ;
+121 ;======================
MVTREAT ;Move Treatment from sequence 13 to 15 on PXCE ADD/EDIT MENU.
+1 NEW IENM,IENT,IND
+2 SET IENM=$$FIND1^DIC(101,"","BX","PXCE ADD/EDIT MENU")
+3 IF IENM=""
Begin DoDot:1
+4 DO BMES^XPDUTL("The PXCE ADD/EDIT MENU does not exist.")
End DoDot:1
QUIT
+5 SET IENT=$$FIND1^DIC(101,"","BX","PXCE TREATMENT ADD")
+6 IF IENT=""
Begin DoDot:1
+7 DO BMES^XPDUTL("PXCE TREATMENT ADD does not exist.")
End DoDot:1
QUIT
+8 SET IND=$ORDER(^ORD(101,IENM,10,"B",IENT,""))
+9 IF IND=""
QUIT
+10 SET $PIECE(^ORD(101,IENM,10,IND,0),U,3)=15
+11 QUIT
+12 ;
+13 ;======================
PRE ;Pre-init
+1 DO BINDEX
+2 DO RMOLDDDS
+3 DO MVTREAT
+4 QUIT
+5 ;
+6 ;======================
POST ;Post-init
+1 DO ADDDS^PXP211I
+2 DO SETCLASS^PXP211I
+3 DO GENPNAME^PXP211I
+4 DO UPCNAME^PXP211I
+5 DO HFCAT^PXP211I
+6 DO VSCITASK^PXP211I
+7 DO DSB^PXP211I
+8 DO PROVNARB^PXP211I
+9 DO RBLDBI^PXP211I
+10 DO RMNCTE^PXP211I
+11 ;HMP has been decomissioned so remove this protocol.
+12 NEW RESULT
+13 SET RESULT=$$DELETE^XPDPROT("PXK VISIT DATA EVENT","HMP PCE EVENTS")
+14 DO SDPCE^PXP211I
+15 DO RMPNSCREEN
+16 DO TASKBOTH^PXPNARR
+17 QUIT
+18 ;
+19 ;======================
PROVNARB ;Redo the Provider Narrative "B" index so it is the full
+1 ;length.
+2 ;First determine if the new full-length "B" index is already in place.
+3 NEW LEN,MAXLEN,NAME
+4 SET MAXLEN=0
SET NAME=""
+5 FOR
SET NAME=$ORDER(^AUTNPOV("B",NAME))
if (MAXLEN>30)!(NAME="")
QUIT
Begin DoDot:1
+6 SET LEN=$LENGTH(NAME)
+7 IF LEN>MAXLEN
SET MAXLEN=LEN
End DoDot:1
+8 IF MAXLEN>30
QUIT
+9 ;
+10 DO BMES^XPDUTL("Creating new full length 'B' index for Provider Narrative.")
+11 ;Kill the old "B" index.
+12 KILL ^AUTNPOV("B")
+13 NEW DIK
+14 SET DIK="^AUTNPOV("
SET DIK(1)=".01^B"
+15 DO ENALL^DIK
+16 QUIT
+17 ;
+18 ;======================
RBLDBI ;Make sure the is only one "B" index for PCE Data Source and
+1 ;Education Topics.
+2 NEW DIK
+3 KILL ^AUTTEDT("B")
+4 SET DIK="^AUTTEDT("
SET DIK(1)=".01^B"
+5 DO ENALL^DIK
+6 KILL ^PX(839.7,"B")
+7 SET DIK="^PX(839.7,"
SET DIK(1)=".01^B"
+8 DO ENALL^DIK
+9 QUIT
+10 ;
+11 ;======================
RMNCTE ;Remove the national class entries that were created for testing.
+1 DO DELTLFE^PXUTIL(9999999.09,"VA-NATIONAL CLASS TEST")
+2 DO DELTLFE^PXUTIL(9999999.15,"VA-NATIONAL CLASS TEST")
+3 DO DELTLFE^PXUTIL(9999999.64,"VA-NATIONAL CLASS TEST")
+4 QUIT
+5 ;
+6 ;======================
RMOLDDDS ;Remove old data dictionaries.
+1 NEW DIU,TEXT
+2 DO BMES^XPDUTL("Removing old data dictionaries.")
+3 SET DIU(0)=""
+4 FOR DIU=815,839.7,9000010,9000010.07,9000010.11,9000010.12,9000010.13,9000010.16,9000010.18,9000010.23,9000010.71,9999999.09,9999999.15,9999999.27,9999999.64
Begin DoDot:1
+5 SET TEXT=" Deleting data dictionary for file # "_DIU
+6 DO MES^XPDUTL(TEXT)
+7 DO EN^DIU2
End DoDot:1
+8 QUIT
+9 ;
+10 ;======================
RMPNSCREEN ;Remove the incorrect Provider Narrative screens.
+1 ;ICR #6256
+2 ;V CPT
+3 KILL ^DD(9000010.18,.04,12)
+4 KILL ^DD(9000010.18,.04,12.1)
+5 ;V POV
+6 KILL ^DD(9000010.07,.04,12)
+7 KILL ^DD(9000010.07,.04,12.1)
+8 QUIT
+9 ;
+10 ;======================
SDPCE ;Edit the Description and Entry Action of the protocol SDAM PCE EVENT.
+1 ;ICR #7110.
+2 NEW FDA,IEN,IENS,MSG,WPTMP
+3 SET IEN=+$$FIND1^DIC(101,"","","SDAM PCE EVENT","","","MSG")
+4 IF IEN=0
QUIT
+5 SET WPTMP(1)="This protocol is the event handler attached to the PXK VISIT DATA EVENT protocol."
+6 SET WPTMP(2)=""
+7 SET WPTMP(3)="The protocol processes scheduled appointment check out data made available by this PCE event point. PCE currently obtains this check out data from MCCR data capture pilots and also a manual entry module within the PCE package."
+8 SET WPTMP(4)=""
+9 SET WPTMP(5)="To allow processing of the other items attached to PXK VISIT DATA EVENT as a TaskMan job, the call to EN^SDPCE was moved to EVENT^PXKMAIN in patch PX*1*211."
+10 SET IENS=IEN_","
+11 SET FDA(101,IENS,3.5)="WPTMP"
+12 SET FDA(101,IENS,20)=";D EN^SDPCE"
+13 DO FILE^DIE("","FDA","MSG")
+14 QUIT
+15 ;
+16 ;======================
SETCLASS ;Until a decision on national entries has been made make everything
+1 ;local.
+2 NEW CLASS,FDA,IEN,IENS,IND,MSG,NAME
+3 DO BMES^XPDUTL("Setting undefined Education Topic Class fields.")
+4 SET NAME=""
+5 FOR
SET NAME=$ORDER(^AUTTEDT("B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+6 IF NAME="VA-NATIONAL CLASS TEST"
QUIT
+7 SET IEN=$ORDER(^AUTTEDT("B",NAME,""))
+8 DO MES^XPDUTL(" Setting the Class of Education Topic: "_NAME_" to LOCAL.")
+9 KILL FDA,MSG
+10 SET IENS=IEN_","
+11 ;Remove "VA-" from any non-national entries.
+12 ;I $E(NAME,1,3)="VA-" S FDA(9999999.09,IENS,.01)=$E(NAME,4,99)
+13 SET FDA(9999999.09,IENS,100)="L"
+14 DO FILE^DIE("ET","FDA","MSG")
End DoDot:1
+15 ;
+16 ;Make all Exam entries local and if the name starts with "VA-"
+17 ;remove it.
+18 DO BMES^XPDUTL("Setting all Exam Class fields to LOCAL.")
+19 SET NAME=""
+20 FOR
SET NAME=$ORDER(^AUTTEXAM("B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+21 IF NAME="VA-NATIONAL CLASS TEST"
QUIT
+22 SET IEN=$ORDER(^AUTTEXAM("B",NAME,""))
+23 DO MES^XPDUTL(" Setting the Class of EXAM: "_NAME_" to LOCAL.")
+24 KILL FDA,MSG
+25 SET IENS=IEN_","
+26 ;Remove "VA-" from any non-national entries.
+27 IF $EXTRACT(NAME,1,3)="VA-"
SET FDA(9999999.15,IENS,.01)=$EXTRACT(NAME,4,99)
+28 SET FDA(9999999.15,IENS,100)="L"
+29 DO FILE^DIE("ET","FDA","MSG")
End DoDot:1
+30 ;
+31 DO BMES^XPDUTL("Setting undefined Health Factor Class fields.")
+32 SET NAME=""
+33 FOR
SET NAME=$ORDER(^AUTTHF("B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+34 IF NAME="VA-NATIONAL CLASS TEST"
QUIT
+35 SET IEN=$ORDER(^AUTTHF("B",NAME,""))
+36 DO MES^XPDUTL(" Setting the Class of HF: "_NAME_" to LOCAL.")
+37 KILL FDA,MSG
+38 SET IENS=IEN_","
+39 SET FDA(9999999.64,IENS,100)="L"
+40 DO FILE^DIE("ET","FDA","MSG")
End DoDot:1
+41 QUIT
+42 ;
+43 ;======================
UPCNAME ;Make sure all entries have upppercase .01s.
+1 NEW IEN,IENS,FDA,MSG,NAME,PXNAT,UPCNAME
+2 SET PXNAT=1
+3 DO BMES^XPDUTL("Making sure all .01s are uppercase.")
+4 ;
+5 DO BMES^XPDUTL("Checking Education Topics.")
+6 SET NAME=""
+7 FOR
SET NAME=$ORDER(^AUTTEDT("B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+8 SET UPCNAME=$$UP^XLFSTR(NAME)
+9 IF NAME=UPCNAME
QUIT
+10 SET IEN=$ORDER(^AUTTEDT("B",NAME,""))
+11 KILL FDA,MSG
+12 SET IENS=IEN_","
+13 SET FDA(9999999.09,IENS,.01)=UPCNAME
+14 DO BMES^XPDUTL("Setting Education Topic: "_NAME)
+15 DO MES^XPDUTL("To: "_UPCNAME)
+16 DO FILE^DIE("ET","FDA","MSG")
End DoDot:1
+17 ;
+18 DO BMES^XPDUTL("Checking Exams.")
+19 SET NAME=""
+20 FOR
SET NAME=$ORDER(^AUTTEXAM("B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+21 SET UPCNAME=$$UP^XLFSTR(NAME)
+22 IF NAME=UPCNAME
QUIT
+23 SET IEN=$ORDER(^AUTTEXAM("B",NAME,""))
+24 KILL FDA,MSG
+25 SET IENS=IEN_","
+26 SET FDA(9999999.15,IENS,.01)=UPCNAME
+27 DO BMES^XPDUTL("Setting Exam: "_NAME)
+28 DO MES^XPDUTL("To: "_UPCNAME)
+29 DO FILE^DIE("ET","FDA","MSG")
End DoDot:1
+30 ;
+31 DO BMES^XPDUTL("Checking Health Factors.")
+32 SET NAME=""
+33 FOR
SET NAME=$ORDER(^AUTTHF("B",NAME))
if (NAME="")
QUIT
Begin DoDot:1
+34 SET UPCNAME=$$UP^XLFSTR(NAME)
+35 IF NAME=UPCNAME
QUIT
+36 SET IEN=$ORDER(^AUTTHF("B",NAME,""))
+37 SET IENS=IEN_","
+38 KILL FDA,MSG
+39 SET FDA(9999999.64,IENS,.01)=UPCNAME
+40 DO BMES^XPDUTL("Setting Health Factor: "_NAME)
+41 DO MES^XPDUTL("To: "_UPCNAME)
+42 DO FILE^DIE("ET","FDA","MSG")
End DoDot:1
+43 QUIT
+44 ;
+45 ;======================
VSCINDEX ;Initialize or rebuild the Clinical Reminders Index for V Standard Codes.
+1 IF '$DATA(^PXRMINDX(9000010.71,"DATE BUILT"))
Begin DoDot:1
+2 DO BMES^XPDUTL("Initializing Clinical Reminders Index for V Standard Codes.")
+3 DO VSC^PXPXRMI2
End DoDot:1
+4 ;Rebuild only necessary in test accounts that have entries.
+5 IF $$PROD^XUPROD(1)
QUIT
+6 IF $PIECE($GET(^AUPNVSC(0)),U,4)=0
QUIT
+7 NEW DIK
+8 DO BMES^XPDUTL("Rebuilding V Standard Codes indexes.")
+9 SET DIK="^AUPNVSC("
+10 DO IXALL2^DIK
+11 DO IXALL^DIK
+12 DO VSC^PXPXRMI2
+13 SET ZTREQ="@"
+14 QUIT
+15 ;
+16 ;======================
VSCITASK ;Start a TaskMan job the for rebuilding the V Standard Codes
+1 ;indexes.
+2 NEW TEXT
+3 SET TEXT(1)="Starting a TaskMan job to initialize/rebuild V STANDARD CODES indexes."
+4 SET ZTRTN="VSCINDEX^PXP211I"
+5 SET ZTDESC="Build V STANDARD CODES indexes"
+6 SET ZTDTH=$$NOW^XLFDT
+7 SET ZTIO=""
+8 DO ^%ZTLOAD
+9 SET TEXT(2)="The task number is: "_ZTSK
+10 DO BMES^XPDUTL(.TEXT)
+11 QUIT
+12 ;
