- TIUEN169 ; SLC/MAM - Environment Check Rtn for TIU*1*169 ; 7/28/2004
- ;;1.0;Text Integration Utilities;**169**;Jun 20, 1997
- ; External References
- ; DBIA 3409 ^USR(8930,"B"
- MAIN ; Check environment. If problems found, warn but do not abort install.
- ; -- Check if done:
- I $G(^XTMP("TIU169","DONE"))="ALL" W !,"All Document Definitions for C&P Worksheets have already been",!," created. You won't need to rerun the option." Q
- I $O(^USR(8930,"B","CLINICAL COORDINATOR",""))="" W !,"I can't find User Class CLINICAL COORDINATOR. You won't be able to run",!,"the option that creates the Document Definitions without this class. See",!,"patch description.",!
- W !,"Remember to run option TIU169 DDEFS, C&P WORKSHEETS",!,"after installing the patch."
- Q
- ;
- SETBASIC ; Set up basic data in ^TMP("TIU169",$J,"BASICS")
- N NUMBER
- ; -- Set ^TMP("TIU169",$J,"BASICS",[NUMBER],["INTTYPE" or "NAME"])
- ; -- Set basic data NAME and interior TYPE for new DDEFS into TMP.
- ; Reference DDEFS by NUMBER.
- ; Number parent-to-be BEFORE child.
- ; Name MUST be upper case or ADDITEM fails
- S ^TMP("TIU169",$J,"BASICS",1,"INTTYPE")="DC"
- F NUMBER=2:1:58 S ^TMP("TIU169",$J,"BASICS",NUMBER,"INTTYPE")="DOC"
- F NUMBER=1:1:58 S ^TMP("TIU169",$J,"BASICS",NUMBER,"NAME")=$P($T(NAME+NUMBER),";;",2,99)
- Q
- ;
- TIUDUPS(TIUDUPS,TIUDCDA) ; Set array TIUDUPS of potential duplicate DDEFS
- ; TIUDCDA = IEN of designated DC or 0 if none desig.
- ; Checks for Titles;
- ; If no DC designated, checks for DC too.
- N NUM
- S (TIUDUPS("INDC"),TIUDUPS("NOTINDC"))=0
- I $G(^XTMP("TIU169","DONE"))="ALL" Q
- F NUM=1:1:58 Q:'NUM D
- . ; -- When looking for duplicates, ignore DDEF if
- . ; previously created, designated,or skipped by this patch:
- . I $G(^XTMP("TIU169",NUM,"DONE")) Q
- . ; -- If site already has DDEF w/ same Name & Type as one
- . ; we are exporting, set its number into array TIUDUPS:
- . N NAME,TYPE,TIUDA S TIUDA=0
- . S NAME=^TMP("TIU169",$J,"BASICS",NUM,"NAME")
- . S TYPE=^TMP("TIU169",$J,"BASICS",NUM,"INTTYPE")
- . F S TIUDA=$O(^TIU(8925.1,"B",NAME,TIUDA)) Q:+TIUDA'>0 D
- . . Q:$P($G(^TIU(8925.1,+TIUDA,0)),U,4)'=TYPE
- . . I $$ISA^TIULX(+TIUDA,TIUDCDA) S TIUDUPS("INDC",NUM)=+TIUDA,TIUDUPS("INDC")=TIUDUPS("INDC")+1 I 1
- . . E I TIUDA'=+DESDC S TIUDUPS("NOTINDC",NUM)=+TIUDA,TIUDUPS("NOTINDC")=TIUDUPS("NOTINDC")+1
- Q
- ;
- LISTDUPS(TIUDUPS,INDCFLG) ; List duplicates by name
- ; TIUDUPS = array as set in TIUDUPS. Required.
- ; INDCFLG = 1: List dups in designated DC for skipping over
- ; INDCFLG '= 1: List dups not in designated DC - Quit
- N NUM,SUBSCPT,TIUCNT
- I '$G(INDCFLG),$G(TIUDUPS("NOTINDC",1)) D Q
- . W !!,"You already have the Document Class exported by this patch, C&P EXAMINATION"
- . W !,"REPORTS. Please designate it or change its name (and print name)."
- I '$G(INDCFLG),$G(TIUDUPS("NOTINDC")) D
- . S SUBSCPT="NOTINDC"
- . W !!,"You already have the following DDEFS exported by this patch. I cannot create"
- . W !,"duplicates. Please change their names so they no longer match exported DDEFS,"
- . W !,"or if you are not using them, delete them. If you change the name of a DDEF"
- . W !,"you plan to continue using, remember to update its Print Name as well."
- . W !,"For help, contact Enterprise VistA Support."
- . W !!,"You may not run this option until these matches are eliminated."
- I $G(INDCFLG),$G(TIUDUPS("INDC")) D
- . S SUBSCPT="INDC"
- . W !!,"Your designated C&P Document Class already has matching Titles:"
- Q:'$D(SUBSCPT)
- S NUM=0
- F TIUCNT=1:1:10 S NUM=$O(TIUDUPS(SUBSCPT,NUM)) Q:'NUM D
- . W !," "_^TMP("TIU169",$J,"BASICS",NUM,"NAME")
- I TIUDUPS(SUBSCPT)>8 W !,"... and more; ",TIUDUPS(SUBSCPT)," in all."
- Q
- ;
- DESGNATE() ; Get Designated DC to create C&P titles under
- ; Returns:
- ; -1 - timeout, ^, lookup failed
- ; 0 - none designated; create new DC
- ; DCIFN^DCNAME in 8925.1 - designated DC
- N TIUY,DTOUT,DUOUT,DIRUT,DIROUT
- W !,"I can create a new C&P Document Class or you can designate an existing one."
- W !,"If you designate an existing one, I will change its name to C&P EXAMINATION REPORTS. I will create the new C&P Titles under it, skipping any you already have."
- S TIUY=$$READ^TIUU("YO","Do you want to designate a Document Class","YES")
- I $D(DIRUT) Q -1
- I +TIUY'=1 Q 0
- N Y,DIC,DTOUT,DUOUT
- S DIC=8925.1,DIC(0)="ABEFQ",DIC("S")="I $P(^(0),U,4)=""DC"",$D(^TIU(8925.1,3,10,""B"",Y))"
- D ^DIC
- Q Y
- ;
- NAME ; Names of DDEFS in order from 1 to 58
- ;;C&P EXAMINATION REPORTS
- ;;C&P EXAMINATION
- ;;C&P MULTIPLE EXAM
- ;;C&P ACROMEGALY
- ;;C&P AID AND ATTENDANCE OR HOUSEBOUND EXAM
- ;;C&P ARRHYTHMIAS
- ;;C&P ARTERIES, VEINS AND MISC
- ;;C&P AUDIO
- ;;C&P BONES
- ;;C&P BRAIN AND SPINAL CORD
- ;;C&P CHRONIC FATIGUE SYNDROME
- ;;C&P COLD INJURY PROTOCOL
- ;;C&P CRANIAL NERVES
- ;;C&P CUSHING'S SYNDROME
- ;;C&P DENTAL AND ORAL
- ;;C&P DIABETES MELLITUS
- ;;C&P DIGESTIVE CONDITIONS
- ;;C&P EAR DISEASE
- ;;C&P EATING DISORDERS
- ;;C&P ENDOCRINE DISEASES
- ;;C&P EPILEPSY AND NARCOLEPSY
- ;;C&P ESOPHAGUS AND HIATAL HERNIA
- ;;C&P EYE
- ;;C&P FEET
- ;;C&P FIBROMYALGIA
- ;;C&P GENERAL MEDICAL
- ;;C&P GENITOURINARY
- ;;C&P GULF WAR PROTOCOL
- ;;C&P GYNECOLOGICAL CONDITIONS AND DISORDERS OF THE BREAST
- ;;C&P HAND, THUMB AND FINGERS
- ;;C&P HEART
- ;;C&P HEMIC DISORDERS
- ;;C&P HIV-RELATED ILLNESS
- ;;C&P HYPERTENSION
- ;;C&P INFECTIOUS, IMMUNE AND NUTRITIONAL DISABILITIES
- ;;C&P INTESTINES
- ;;C&P JOINTS (SHOULDER, ELBOW, WRIST, HIP, KNEE, ANKLE)
- ;;C&P LIVER, GALL BLADDER, AND PANCREAS
- ;;C&P LYMPHATIC DISORDERS
- ;;C&P MENTAL DISORDERS
- ;;C&P MOUTH, LIPS, AND TONGUE
- ;;C&P MUSCLES
- ;;C&P NEUROLOGICAL DISORDERS
- ;;C&P NOSE, SINUS, LARYNX, AND PHARYNX
- ;;C&P PERIPHERAL NERVES
- ;;C&P PRISONER OF WAR PROTOCOL
- ;;C&P PTSD, INITIAL EVALUATION
- ;;C&P PTSD, REVIEW
- ;;C&P PULMONARY TUBERCULOSIS AND MYCOBACTERIAL DISEASES
- ;;C&P RECTUM AND ANUS
- ;;C&P RESIDUALS OF AMPUTATIONS
- ;;C&P RESPIRATORY
- ;;C&P SCARS
- ;;C&P SENSE OF SMELL AND TASTE
- ;;C&P SKIN DISEASES
- ;;C&P SPINE
- ;;C&P STOMACH, DUODENUM, AND PERITONEAL ADHESIONS
- ;;C&P THYROID AND PARATHYROID DISEASES
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUEN169 6126 printed Feb 19, 2025@00:06:42 Page 2
- TIUEN169 ; SLC/MAM - Environment Check Rtn for TIU*1*169 ; 7/28/2004
- +1 ;;1.0;Text Integration Utilities;**169**;Jun 20, 1997
- +2 ; External References
- +3 ; DBIA 3409 ^USR(8930,"B"
- MAIN ; Check environment. If problems found, warn but do not abort install.
- +1 ; -- Check if done:
- +2 IF $GET(^XTMP("TIU169","DONE"))="ALL"
- WRITE !,"All Document Definitions for C&P Worksheets have already been",!," created. You won't need to rerun the option."
- QUIT
- +3 IF $ORDER(^USR(8930,"B","CLINICAL COORDINATOR",""))=""
- WRITE !,"I can't find User Class CLINICAL COORDINATOR. You won't be able to run",!,"the option that creates the Document Definitions without this class. See",!,"patch description.",!
- +4 WRITE !,"Remember to run option TIU169 DDEFS, C&P WORKSHEETS",!,"after installing the patch."
- +5 QUIT
- +6 ;
- SETBASIC ; Set up basic data in ^TMP("TIU169",$J,"BASICS")
- +1 NEW NUMBER
- +2 ; -- Set ^TMP("TIU169",$J,"BASICS",[NUMBER],["INTTYPE" or "NAME"])
- +3 ; -- Set basic data NAME and interior TYPE for new DDEFS into TMP.
- +4 ; Reference DDEFS by NUMBER.
- +5 ; Number parent-to-be BEFORE child.
- +6 ; Name MUST be upper case or ADDITEM fails
- +7 SET ^TMP("TIU169",$JOB,"BASICS",1,"INTTYPE")="DC"
- +8 FOR NUMBER=2:1:58
- SET ^TMP("TIU169",$JOB,"BASICS",NUMBER,"INTTYPE")="DOC"
- +9 FOR NUMBER=1:1:58
- SET ^TMP("TIU169",$JOB,"BASICS",NUMBER,"NAME")=$PIECE($TEXT(NAME+NUMBER),";;",2,99)
- +10 QUIT
- +11 ;
- TIUDUPS(TIUDUPS,TIUDCDA) ; Set array TIUDUPS of potential duplicate DDEFS
- +1 ; TIUDCDA = IEN of designated DC or 0 if none desig.
- +2 ; Checks for Titles;
- +3 ; If no DC designated, checks for DC too.
- +4 NEW NUM
- +5 SET (TIUDUPS("INDC"),TIUDUPS("NOTINDC"))=0
- +6 IF $GET(^XTMP("TIU169","DONE"))="ALL"
- QUIT
- +7 FOR NUM=1:1:58
- if 'NUM
- QUIT
- Begin DoDot:1
- +8 ; -- When looking for duplicates, ignore DDEF if
- +9 ; previously created, designated,or skipped by this patch:
- +10 IF $GET(^XTMP("TIU169",NUM,"DONE"))
- QUIT
- +11 ; -- If site already has DDEF w/ same Name & Type as one
- +12 ; we are exporting, set its number into array TIUDUPS:
- +13 NEW NAME,TYPE,TIUDA
- SET TIUDA=0
- +14 SET NAME=^TMP("TIU169",$JOB,"BASICS",NUM,"NAME")
- +15 SET TYPE=^TMP("TIU169",$JOB,"BASICS",NUM,"INTTYPE")
- +16 FOR
- SET TIUDA=$ORDER(^TIU(8925.1,"B",NAME,TIUDA))
- if +TIUDA'>0
- QUIT
- Begin DoDot:2
- +17 if $PIECE($GET(^TIU(8925.1,+TIUDA,0)),U,4)'=TYPE
- QUIT
- +18 IF $$ISA^TIULX(+TIUDA,TIUDCDA)
- SET TIUDUPS("INDC",NUM)=+TIUDA
- SET TIUDUPS("INDC")=TIUDUPS("INDC")+1
- IF 1
- +19 IF '$TEST
- IF TIUDA'=+DESDC
- SET TIUDUPS("NOTINDC",NUM)=+TIUDA
- SET TIUDUPS("NOTINDC")=TIUDUPS("NOTINDC")+1
- End DoDot:2
- End DoDot:1
- +20 QUIT
- +21 ;
- LISTDUPS(TIUDUPS,INDCFLG) ; List duplicates by name
- +1 ; TIUDUPS = array as set in TIUDUPS. Required.
- +2 ; INDCFLG = 1: List dups in designated DC for skipping over
- +3 ; INDCFLG '= 1: List dups not in designated DC - Quit
- +4 NEW NUM,SUBSCPT,TIUCNT
- +5 IF '$GET(INDCFLG)
- IF $GET(TIUDUPS("NOTINDC",1))
- Begin DoDot:1
- +6 WRITE !!,"You already have the Document Class exported by this patch, C&P EXAMINATION"
- +7 WRITE !,"REPORTS. Please designate it or change its name (and print name)."
- End DoDot:1
- QUIT
- +8 IF '$GET(INDCFLG)
- IF $GET(TIUDUPS("NOTINDC"))
- Begin DoDot:1
- +9 SET SUBSCPT="NOTINDC"
- +10 WRITE !!,"You already have the following DDEFS exported by this patch. I cannot create"
- +11 WRITE !,"duplicates. Please change their names so they no longer match exported DDEFS,"
- +12 WRITE !,"or if you are not using them, delete them. If you change the name of a DDEF"
- +13 WRITE !,"you plan to continue using, remember to update its Print Name as well."
- +14 WRITE !,"For help, contact Enterprise VistA Support."
- +15 WRITE !!,"You may not run this option until these matches are eliminated."
- End DoDot:1
- +16 IF $GET(INDCFLG)
- IF $GET(TIUDUPS("INDC"))
- Begin DoDot:1
- +17 SET SUBSCPT="INDC"
- +18 WRITE !!,"Your designated C&P Document Class already has matching Titles:"
- End DoDot:1
- +19 if '$DATA(SUBSCPT)
- QUIT
- +20 SET NUM=0
- +21 FOR TIUCNT=1:1:10
- SET NUM=$ORDER(TIUDUPS(SUBSCPT,NUM))
- if 'NUM
- QUIT
- Begin DoDot:1
- +22 WRITE !," "_^TMP("TIU169",$JOB,"BASICS",NUM,"NAME")
- End DoDot:1
- +23 IF TIUDUPS(SUBSCPT)>8
- WRITE !,"... and more; ",TIUDUPS(SUBSCPT)," in all."
- +24 QUIT
- +25 ;
- DESGNATE() ; Get Designated DC to create C&P titles under
- +1 ; Returns:
- +2 ; -1 - timeout, ^, lookup failed
- +3 ; 0 - none designated; create new DC
- +4 ; DCIFN^DCNAME in 8925.1 - designated DC
- +5 NEW TIUY,DTOUT,DUOUT,DIRUT,DIROUT
- +6 WRITE !,"I can create a new C&P Document Class or you can designate an existing one."
- +7 WRITE !,"If you designate an existing one, I will change its name to C&P EXAMINATION REPORTS. I will create the new C&P Titles under it, skipping any you already have."
- +8 SET TIUY=$$READ^TIUU("YO","Do you want to designate a Document Class","YES")
- +9 IF $DATA(DIRUT)
- QUIT -1
- +10 IF +TIUY'=1
- QUIT 0
- +11 NEW Y,DIC,DTOUT,DUOUT
- +12 SET DIC=8925.1
- SET DIC(0)="ABEFQ"
- SET DIC("S")="I $P(^(0),U,4)=""DC"",$D(^TIU(8925.1,3,10,""B"",Y))"
- +13 DO ^DIC
- +14 QUIT Y
- +15 ;
- NAME ; Names of DDEFS in order from 1 to 58
- +1 ;;C&P EXAMINATION REPORTS
- +2 ;;C&P EXAMINATION
- +3 ;;C&P MULTIPLE EXAM
- +4 ;;C&P ACROMEGALY
- +5 ;;C&P AID AND ATTENDANCE OR HOUSEBOUND EXAM
- +6 ;;C&P ARRHYTHMIAS
- +7 ;;C&P ARTERIES, VEINS AND MISC
- +8 ;;C&P AUDIO
- +9 ;;C&P BONES
- +10 ;;C&P BRAIN AND SPINAL CORD
- +11 ;;C&P CHRONIC FATIGUE SYNDROME
- +12 ;;C&P COLD INJURY PROTOCOL
- +13 ;;C&P CRANIAL NERVES
- +14 ;;C&P CUSHING'S SYNDROME
- +15 ;;C&P DENTAL AND ORAL
- +16 ;;C&P DIABETES MELLITUS
- +17 ;;C&P DIGESTIVE CONDITIONS
- +18 ;;C&P EAR DISEASE
- +19 ;;C&P EATING DISORDERS
- +20 ;;C&P ENDOCRINE DISEASES
- +21 ;;C&P EPILEPSY AND NARCOLEPSY
- +22 ;;C&P ESOPHAGUS AND HIATAL HERNIA
- +23 ;;C&P EYE
- +24 ;;C&P FEET
- +25 ;;C&P FIBROMYALGIA
- +26 ;;C&P GENERAL MEDICAL
- +27 ;;C&P GENITOURINARY
- +28 ;;C&P GULF WAR PROTOCOL
- +29 ;;C&P GYNECOLOGICAL CONDITIONS AND DISORDERS OF THE BREAST
- +30 ;;C&P HAND, THUMB AND FINGERS
- +31 ;;C&P HEART
- +32 ;;C&P HEMIC DISORDERS
- +33 ;;C&P HIV-RELATED ILLNESS
- +34 ;;C&P HYPERTENSION
- +35 ;;C&P INFECTIOUS, IMMUNE AND NUTRITIONAL DISABILITIES
- +36 ;;C&P INTESTINES
- +37 ;;C&P JOINTS (SHOULDER, ELBOW, WRIST, HIP, KNEE, ANKLE)
- +38 ;;C&P LIVER, GALL BLADDER, AND PANCREAS
- +39 ;;C&P LYMPHATIC DISORDERS
- +40 ;;C&P MENTAL DISORDERS
- +41 ;;C&P MOUTH, LIPS, AND TONGUE
- +42 ;;C&P MUSCLES
- +43 ;;C&P NEUROLOGICAL DISORDERS
- +44 ;;C&P NOSE, SINUS, LARYNX, AND PHARYNX
- +45 ;;C&P PERIPHERAL NERVES
- +46 ;;C&P PRISONER OF WAR PROTOCOL
- +47 ;;C&P PTSD, INITIAL EVALUATION
- +48 ;;C&P PTSD, REVIEW
- +49 ;;C&P PULMONARY TUBERCULOSIS AND MYCOBACTERIAL DISEASES
- +50 ;;C&P RECTUM AND ANUS
- +51 ;;C&P RESIDUALS OF AMPUTATIONS
- +52 ;;C&P RESPIRATORY
- +53 ;;C&P SCARS
- +54 ;;C&P SENSE OF SMELL AND TASTE
- +55 ;;C&P SKIN DISEASES
- +56 ;;C&P SPINE
- +57 ;;C&P STOMACH, DUODENUM, AND PERITONEAL ADHESIONS
- +58 ;;C&P THYROID AND PARATHYROID DISEASES
- +59 QUIT