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

HDIZZ003.m

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