©2011-2018 Open Source Electronic Health Record Alliance
This work is licensed under a Creative Commons Attribution 3.0 Unported License
This work is licensed under a Creative Commons Attribution 3.0 Unported License
HDIZZ003 ;BPFO/JRP - ORLANDO CLEANUP;02/18/2009
;;1.0;HEALTH DATA & INFORMATICS;**xx**;Feb 22, 2005
;
;******************************************************
;** This routine is not for general distribution **
;******************************************************
;
;Can not execute from top of routine. Must use line tag.
QUIT
;
;
ORLANDO ;Main entry point
IF '$$AYS() QUIT
WRITE !!!!,"Starting corrective actions (",$$HTE^XLFDT($H),")",!
DO SYSTEM
DO PARAMS
DO STATUS
DO VUIDLOAD
WRITE !!!!,"Corrective actions completed (",$$HTE^XLFDT($H),")",!
QUIT
;
AYS() ;Are you sure ?
NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
SET DIR("A")="Are you sure you want to continue"
SET DIR("A",1)="This routine was explicitly written for the Orlando VAMC"
SET DIR("A",2)="and corrects problems specific to their Allergies, Vitals,"
SET DIR("A",3)="and Health Data & Informatics files. As such, it should"
SET DIR("A",4)="only be run at the Orlando VAMC."
SET DIR("A",5)=" "
SET DIR("B")="NO",DIR(0)="Y"
DO ^DIR
QUIT +$GET(Y)
;
SYSTEM ;Make corrections to HDIS SYSTEM file
NEW IEN,DA,DIK,HDIZ,HDIZERR
;Make sure only one entry exists
Write !!,"Ensuring that only one entry exists in HDIS SYSTEM file ..."
SET IEN=1
FOR SET IEN=+$ORDER(^HDISF(7118.21,IEN)) QUIT:'IEN DO
. Write "."
. SET DA=IEN
. SET DIK="^HDISF(7118.21,"
. DO ^DIK
. QUIT
;Make sure first entry is accurate
Write !!,"Ensuring that first entry in HDIS SYSTEM file is correct ..."
SET HDIZ(7118.21,"1,",.01)=$$FACPTR^HDISVF01()
SET HDIZ(7118.21,"1,",.02)=$G(^XMB("NETNAME"))
SET HDIZ(7118.21,"1,",.03)=$$PROD^XUPROD()
D FILE^DIE("","HDIZ","HDIZERR")
IF $DATA(HDIZERR) DO
. WRITE !!,"*****"
. WRITE !,"FILE^DIE was unable to update entry 1 of the HDIS SYSTEM file"
. WRITE !,"*****",!!
. QUIT
QUIT
;
PARAMS ;Make corrections to HDIS PARAMETER file
NEW HDIZ,HDIZERR
;Make sure first entry points to first entry in HDIS SYSTEM file
Write !!,"Ensuring that first entry in HDIS PARAMETER file points to"
Write !,"first entry in HDIS SYSTEM file ..."
SET HDIZ(7118.29,"1,",.01)=1
D FILE^DIE("","HDIZ","HDIZERR")
IF $DATA(HDIZERR) DO
. WRITE !!,"*****"
. WRITE !,"FILE^DIE was unable to make the first entry in the HDIS PARAMETER"
. WRITE !,"file point to the first entry in the HDIS SYSTEM file"
. WRITE !,"*****",!!
. QUIT
QUIT
;
STATUS ;Make corrections to HDIS VUID IMPLEMENTATION STATUS file
NEW IEN,HDIZ,HDIZERR,FILE
;Make sure all entries point to first entry in HDIS SYSTEM file
Write !!,"Ensuring that all entries in HDIS VUID IMPLEMENTATION"
Write !,"STATUS file point to first entry in HDIS SYSTEM file ..."
SET IEN=0
FOR SET IEN=+$ORDER(^HDISF(7118.25,IEN)) QUIT:'IEN DO
. Write "."
. K HDIZ,HDIZERR
. SET HDIZ(7118.25,IEN_",",.01)=1
. D FILE^DIE("","HDIZ","HDIZERR")
. IF $DATA(HDIZERR) DO
. . WRITE !!,"*****"
. . WRITE !,"FILE^DIE was unable to make entry ",IEN," in the HDIS VUID"
. . WRITE !,"IMPLEMENTATION STATUS file point to the first entry in the"
. . WRITE !,"HDIS SYSTEM file"
. . WRITE !,"*****",!!
. . QUIT
. QUIT
;Make sure files in Vitals and Allergies domain are marked with
;implementation status code 6 (completed)
WRITE !!,"Ensuring that VUID Seeding for the Vitals and Allergies"
WRITE !,"files are marked as having run to completion (this prevents"
WRITE !,"non-standard terms from being selectable) ..."
FOR FILE=120.51,120.52,120.53,120.82,120.83 DO
. WRITE "."
. ;Status code already '6'
. IF +$$GETSTAT^HDISVF01(FILE,.01)=6 QUIT
. ;Mark file as completed (status code '6')
. DO SETSTAT^HDISVF01(FILE,.01,6)
. QUIT
QUIT
;
VUIDLOAD ;Load/store non-standard VUIDs
NEW LINE,DATA,FILE,TERM,VUID,STOP,FINDLIST,FINDERR,SEQ,IEN
;Initialize global arrays used
SET FINDLIST=$NAME(^TMP("HDIZZ003",$J,"FINDLIST"))
SET FINDERR=$NAME(^TMP("HDIZZ003",$J,"FINDERR"))
KILL @FINDLIST,@FINDERR
;Loop through list of non-standard VUIDs to load
WRITE !!,"Storing VUIDs and inactivating terms ..."
SET STOP=0
FOR LINE=1:1 DO QUIT:STOP
. ;Get line of data
. SET DATA=$PIECE($TEXT(VUIDDATA+LINE),";;",2)
. ;Reached end of data lines
. IF DATA="$END" SET STOP=1 QUIT
. ;Piece out data
. SET FILE=$PIECE(DATA,"^",1)
. SET TERM=$PIECE(DATA,"^",2)
. SET VUID=$PIECE(DATA,"^",3)
. ;Skip blank lines (used to visually separate files)
. QUIT:(FILE="")
. ;Find matches for term
. KILL @FINDLIST,@FINDERR
. DO FIND^DIC(FILE,"",".01;99.99","QX",TERM,"*","B^","","",FINDLIST,FINDERR)
. ;Error
. IF $DATA(@FINDERR) DO QUIT
. . WRITE !!,"*****"
. . WRITE !,"FIND^DIC reported an error when attempting to find entries for"
. . WRITE !,"""",TERM,""" in file number ",FILE
. . WRITE !,"*****",!!
. . QUIT
. ;Term not found
. IF '$GET(@FINDLIST@("DILIST",0)) DO QUIT
. . WRITE !!,"*****"
. . WRITE !,"FIND^DIC did not find any matches for"
. . WRITE !,"""",TERM,""" in file number ",FILE
. . WRITE !,"*****",!!
. . QUIT
. ;Loop through each match
. SET SEQ=0
. FOR SET SEQ=+$ORDER(@FINDLIST@("DILIST","ID",SEQ)) QUIT:'SEQ DO
. . WRITE "."
. . ;Get entry number
. . SET IEN=+$GET(@FINDLIST@("DILIST",2,SEQ))
. . IF 'IEN DO QUIT
. . .;IEN node missing
. . . WRITE !!,"*****"
. . . WRITE !,"IEN node missing for match number ",SEQ," of"
. . . WRITE !,"""",TERM,""" in file number ",FILE
. . . WRITE !,"*****",!!
. . . QUIT
. . ;VUID already defined
. . IF $GET(@FINDLIST@("DILIST","ID",SEQ,99.99))'="" DO QUIT
. . . WRITE !!,"*****"
. . . WRITE !,"VUID already defined for IEN ",IEN," of"
. . . WRITE !,"""",TERM,""" in file number ",FILE
. . . WRITE !,"*****",!!
. . . QUIT
. . ;Store VUID
. . IF '$$SETVUID^XTID(FILE,.01,IEN_",",VUID) DO QUIT
. . . WRITE !!,"*****"
. . . WRITE !,"Unable to store VUID for IEN ",IEN," of"
. . . WRITE !,"""",TERM,""" in file number ",FILE
. . . WRITE !,"*****",!!
. . . QUIT
. . ;Inactivate entry
. . IF '$$SETSTAT^XTID(FILE,.01,IEN_",",0,3050801.0001) DO QUIT
. . . WRITE !!,"*****"
. . . WRITE !,"Unable to inactivate IEN ",IEN," of"
. . . WRITE !,"""",TERM,""" in file number ",FILE
. . . WRITE !,"*****",!!
. . . QUIT
. . QUIT
. QUIT
KILL @FINDLIST,@FINDERR
QUIT
;
;
VUIDDATA ;;File^Term^VUID
;;120.51^ABDOMINAL GIRTH^4536404
;;120.51^HEAD CIRCUMFERENCE^4536405
;;
;;120.52^ADULT^4536409
;;120.52^CUFF^4536408
;;120.52^LG ADULT^4536411
;;120.52^OTHER^4536406
;;120.52^PEDIATRIC^4536412
;;120.52^SM ADULT^4536410
;;
;;120.82^ANTIRABIES SERUM^4538526
;;120.82^ASPIRIN^4538527
;;120.82^AUROTHIOGLUCOSE (SESAME OIL)^4636954
;;120.82^BANANA^4636707
;;120.82^BCG VACCINE^4538528
;;120.82^BENZALKONIUM CHLORIDE^4538529
;;120.82^BISMUTH SUBSALICYLATE^4538530
;;120.82^BOTULISM ANTITOXIN^4538531
;;120.82^BROAD BEANS^4690957
;;120.82^BUTTERSCOTCH FLAVORING^4538532
;;120.82^CALCITONIN, SALMON^4538534
;;120.82^CETYLPYRIDINIUM^4538536
;;120.82^CITRATED CAFFEINE^4538537
;;120.82^DIGOXIN IMMUNE FAB (OVINE)^4538538
;;120.82^DIPHTHERIA ANTITOXIN, EQUINE^4538539
;;120.82^DIPHTHERIA TOXOID^4538540
;;120.82^ESTRADIOL CYPIONATE^4538541
;;120.82^F D & C BLUE #2^4018104
;;120.82^F D & C GREEN #6^4019324
;;120.82^F D & C RED #3^4019486
;;120.82^F D & C RED #40^4019362
;;120.82^F D & C RED #40 LAKE^4019363
;;120.82^F D & C YELLOW #6^4019360
;;120.82^F D & C YELLOW #6 LAKE^4019361
;;120.82^FLUPHENAZINE DECANOATE^4538542
;;120.82^FOOD STARCH, MODIFIED^4637464
;;120.82^GOLD SODIUM THIOMALATE^4538543
;;120.82^HEPARIN SODIUM (BEEF LUNG)^4538544
;;120.82^HEPARIN SODIUM (PORK)^4538545
;;120.82^HORSE SERUM^4541611
;;120.82^INSULIN^4538546
;;120.82^IODINE^4538521
;;120.82^IRON FILLINGS^4538522
;;120.82^METHYLCELLULOSE^4538535
;;120.82^NAFARELIN ACETATE^4538547
;;120.82^NANDROLONE, ETC^4538548
;;120.82^OTHER ALLERGY/ADVERSE REACTION^4538520
;;120.82^PARA-AMINOBENZOIC ACID^4538549
;;120.82^PARABEN^4538533
;;120.82^PINEAPPLE^4637343
;;120.82^POTASSIUM IODIDE^4538550
;;120.82^POTATO^4636964
;;120.82^POVIDONE IODINE^4538551
;;120.82^PSYLLIUM^4538552
;;120.82^RABIES IMMUNE GLOBULIN^4538553
;;120.82^RED FOOD DYE^4538524
;;120.82^SALICYLAMIDE^4538554
;;120.82^SALICYLIC ACID^4538555
;;120.82^SHELL FISH^4636953
;;120.82^SOY BEANS^4636950
;;120.82^TARTARIC ACID^4538556
;;120.82^TESTOSTERONE^4538557
;;120.82^TOMATO^4637354
;;120.82^VASOPRESSIN TANNATE (IN OIL)^4538558
;;
;;120.83^AGITATION^4538582
;;120.83^APPETITE,INCREASED^4538583
;;120.83^ARRHYTHMIA^4538584
;;120.83^BRACHYCARDIA^4538585
;;120.83^BREAST ENGORGEMENT^4538586
;;120.83^CHILLS^4538587
;;120.83^CONFUSION^4538568
;;120.83^CONGESTION,NASAL^4538588
;;120.83^CONJUNCTIVAL CONGESTION^4538589
;;120.83^COUGHING^4538572
;;120.83^DEAFNESS^4538591
;;120.83^DELERIUM^4538592
;;120.83^DELUSION^4538569
;;120.83^DEPRESSION,MENTAL^4538624
;;120.83^DEPRESSION,POSTICTAL^4538590
;;120.83^DERMATITIS,CONTACT^4538604
;;120.83^DERMATITIS,PHOTOALLERGENIC^4538605
;;120.83^DISTURBED COORDINATION^4538594
;;120.83^DREAMING,INCREASED^4538595
;;120.83^DROWSINESS^4538596
;;120.83^DRY NOSE^4538599
;;120.83^DRY THROAT^4538598
;;120.83^ECG CHANGES^4538600
;;120.83^EPIGASTRIC DISTRESS^4538601
;;120.83^EXCITATION^4538602
;;120.83^FACE FLUSHED^4538609
;;120.83^FACIAL DYSKINESIA^4538606
;;120.83^FAINTNESS^4538607
;;120.83^FEELING OF WARMTH^4538608
;;120.83^GI REACTION^4538570
;;120.83^HEMOGLOBIN,INCREASED^4538611
;;120.83^HIVES^4541623
;;120.83^IMPAIRMENT OF ERECTION^4538614
;;120.83^INAPPROPRIATE PENILE ERECTION^4538615
;;120.83^IRRITABILITY^4538616
;;120.83^ITCHING,WATERING EYES^4538561
;;120.83^JUNCTIONAL RHYTHM^4538618
;;120.83^LABYRINTHITIS,ACUTE^4538623
;;120.83^LACRIMATION^4538617
;;120.83^LDH,INCREASED^4538619
;;120.83^LEUKOCYTE COUNT,DECREASED^4538620
;;120.83^LIBIDO,DECREASED^4538621
;;120.83^LIBIDO,INCREASED^4538622
;;120.83^MIOSIS^4538625
;;120.83^NAUSEA,VOMITING^4538564
;;120.83^NERVOUSNESS,AGITATION^4538566
;;120.83^NEUTROPHIL COUNT,DECREASED^4538627
;;120.83^ORGASM,INHIBITED^4538629
;;120.83^ORONASALPHARYNGEAL IRRITATION^4538626
;;120.83^OTHER REACTION^4538580
;;120.83^PAIN,JOINT^4538630
;;120.83^PARKINSONIAN-LIKE SYNDROME^4538631
;;120.83^POSSIBLE REACTION^4538562
;;120.83^PRURITIS^4538702
;;120.83^PURPURA^4538647
;;120.83^RALES^4538634
;;120.83^RASH,PAPULAR^4538638
;;120.83^RHINORRHEA^4538636
;;120.83^RHONCHUS^4538637
;;120.83^SEIZURES^4538640
;;120.83^SEIZURES,TONIC-CLONIC^4538639
;;120.83^SELF-DEPRECATION^4538641
;;120.83^SEVERE RASH^4538581
;;120.83^SHORTNESS OF BREATH^4538571
;;120.83^SINUS BRACHYCARDIA^4538642
;;120.83^SOMNOLENCE^4538643
;;120.83^SPEECH DISORDER^4538644
;;120.83^S-T CHANGES,TRANSIENT^4538645
;;120.83^SWELLING (NON-SPECIFIC)^4538574
;;120.83^SWELLING-EYES^4538575
;;120.83^SWELLING-LIPS^4538577
;;120.83^SWELLING-THROAT^4538576
;;120.83^TREMORS^4538648
;;120.83^URINARY FLOW,DELAYED^4538649
;;120.83^URINARY FREQUENCY^4538579
;;120.83^URINARY FREQUENCY,INCREASED^4538650
;;120.83^URINARY RETENTION^4538578
;;120.83^VISION,BLURRED^4538565
;;120.83^VISUAL DISTURBANCES^4538573
;;120.83^WEIGHT GAIN^4538651
;;
;;$END