TIUEN182 ; SLC/MAM - Environment Check Rtn for TIU*1*182 ; 6/9/04
;;1.0;Text Integration Utilities;**182**;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("TIU182","DONE"))="ALL" W !,"All Document Definitions exported for the Medicine Conversion have already",!," been created. You won't need to rerun the option." Q
I '$$CLASS^TIUCP W !,"I can't find Class CLINICAL PROCEDURES, exported in patch TIU*1*109. You",!,"won't be able to run the option that creates the Document Definitions",!,"without this class. See patch description.",!
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.",!
; -- Check for potential DDEF duplicates at site:
D SETBASIC ; Set basic data for DDEFS into ^TMP for dups check
W !,"Checking for potential duplicate Document Definitions..."
N TIUDUPS
D TIUDUPS(.TIUDUPS)
I 'TIUDUPS W !," No potential duplicates found.",!,"Remember to run option TIU182 DDEFS, MED CONVERSION after installing the patch." G MAINX
; -- If potential duplicates exist, list them:
K ^TMP("TIU182MSG",$J) ; LISTDUPS needs new ^TMP("TIU182MSG",$J)
D LISTDUPS(.TIUDUPS,0,0)
MAINX K ^TMP("TIU182MSG",$J) ; Clean up after LISTDUPS
K ^TMP("TIU182",$J) ; Clean up after SETBASIC
Q
;
SETBASIC ; Set up basic data in ^TMP("TIU182",$J,"BASICS")
N NUMBER
; -- Set ^TMP("TIU182",$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("TIU182",$J,"BASICS",1,"INTTYPE")="DC"
F NUMBER=2:1:13 S ^TMP("TIU182",$J,"BASICS",NUMBER,"INTTYPE")="DOC"
F NUMBER=1:1:13 S ^TMP("TIU182",$J,"BASICS",NUMBER,"NAME")=$P($T(NAME+NUMBER),";;",2,99)
Q
;
TIUDUPS(TIUDUPS,OPTFLG) ; Set array TIUDUPS of potential duplicate DDEFS
N NUM S TIUDUPS=0,OPTFLG=+$G(OPTFLG)
I $G(^XTMP("TIU182","DONE"))="ALL" Q
F NUM=1:1:13 Q:'NUM D
. ; -- When looking for duplicates, ignore DDEF if
. ; previously created by this patch:
. Q:$G(^XTMP("TIU182",NUM,"DONE"))
. ; -- 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("TIU182",$J,"BASICS",NUM,"NAME")
. S TYPE=^TMP("TIU182",$J,"BASICS",NUM,"INTTYPE")
. F S TIUDA=$O(^TIU(8925.1,"B",NAME,TIUDA)) Q:+TIUDA'>0 D
. . I $P($G(^TIU(8925.1,+TIUDA,0)),U,4)=TYPE S TIUDUPS(NUM)=+TIUDA,TIUDUPS=1
Q
;
LISTDUPS(TIUDUPS,TMPCNT,OPTFLG) ; List duplicates by name
; TIUDUPS = array as set in TIUDUPS. Required.
; TMPCNT = Count at which to start message array ^TMP("TIU182MSG",$J,TMPCNT); Received by reference. (Array already has some nodes if called from option.) Optional.
; OPTFLG = 1 if called from option;
; 0 if called from env check. Optional.
N NUM
S OPTFLG=+$G(OPTFLG)
S TMPCNT=$S($G(TMPCNT):TMPCNT,1:0)
S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="You already have the following Document Definitions exported by this patch."
S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="I don't want to overwrite them. Please change their names so they no longer"
S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="match the exported ones, or if you are not using them, delete them. If you"
S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="change the name of a Document Definition you plan to continue using, remember"
S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="to update its Print Name, as well. For help, contact Enterprise VistA Support."
S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=""
S TMPCNT=TMPCNT+1
I 'OPTFLG D
. S ^TMP("TIU182MSG",$J,TMPCNT)="You will not be able to run option TIU182 DDEFS, MED CONVERSION to create the"
. S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="DDEFS until these matches are eliminated."
E S ^TMP("TIU182MSG",$J,TMPCNT)="You may not run this option until these matches are eliminated."
S NUM=0
F S NUM=$O(TIUDUPS(NUM)) Q:'NUM D
. S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=" "_^TMP("TIU182",$J,"BASICS",NUM,"NAME")
; -- If called from env check, not option, write list:
I OPTFLG Q
N TIUI S TIUI=0
F S TIUI=$O(^TMP("TIU182MSG",$J,TIUI)) Q:'TIUI D
. W !,^TMP("TIU182MSG",$J,TIUI)
Q
;
NAME ; Names of DDEFS in order from 1 to 13
;;HISTORICAL PROCEDURES
;;HISTORICAL CARDIAC CATHETERIZATION PROCEDURE
;;HISTORICAL ELECTROCARDIOGRAM PROCEDURE
;;HISTORICAL ECHOCARDIOGRAM PROCEDURE
;;HISTORICAL ELECTROPHYSIOLOGY PROCEDURE
;;HISTORICAL HOLTER PROCEDURE
;;HISTORICAL EXERCISE TOLERANCE TEST PROCEDURE
;;HISTORICAL PRE/POST SURGERY RISK NOTE
;;HISTORICAL ENDOSCOPIC PROCEDURE
;;HISTORICAL PULMONARY FUNCTION TEST PROCEDURE
;;HISTORICAL HEMATOLOGY PROCEDURE
;;HISTORICAL PACEMAKER IMPLANTATION PROCEDURE
;;HISTORICAL RHEUMATOLOGY PROCEDURE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUEN182 5146 printed Oct 16, 2024@18:40:51 Page 2
TIUEN182 ; SLC/MAM - Environment Check Rtn for TIU*1*182 ; 6/9/04
+1 ;;1.0;Text Integration Utilities;**182**;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("TIU182","DONE"))="ALL"
WRITE !,"All Document Definitions exported for the Medicine Conversion have already",!," been created. You won't need to rerun the option."
QUIT
+3 IF '$$CLASS^TIUCP
WRITE !,"I can't find Class CLINICAL PROCEDURES, exported in patch TIU*1*109. You",!,"won't be able to run the option that creates the Document Definitions",!,"without this class. See patch description.",!
+4 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.",!
+5 ; -- Check for potential DDEF duplicates at site:
+6 ; Set basic data for DDEFS into ^TMP for dups check
DO SETBASIC
+7 WRITE !,"Checking for potential duplicate Document Definitions..."
+8 NEW TIUDUPS
+9 DO TIUDUPS(.TIUDUPS)
+10 IF 'TIUDUPS
WRITE !," No potential duplicates found.",!,"Remember to run option TIU182 DDEFS, MED CONVERSION after installing the patch."
GOTO MAINX
+11 ; -- If potential duplicates exist, list them:
+12 ; LISTDUPS needs new ^TMP("TIU182MSG",$J)
KILL ^TMP("TIU182MSG",$JOB)
+13 DO LISTDUPS(.TIUDUPS,0,0)
MAINX ; Clean up after LISTDUPS
KILL ^TMP("TIU182MSG",$JOB)
+1 ; Clean up after SETBASIC
KILL ^TMP("TIU182",$JOB)
+2 QUIT
+3 ;
SETBASIC ; Set up basic data in ^TMP("TIU182",$J,"BASICS")
+1 NEW NUMBER
+2 ; -- Set ^TMP("TIU182",$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("TIU182",$JOB,"BASICS",1,"INTTYPE")="DC"
+8 FOR NUMBER=2:1:13
SET ^TMP("TIU182",$JOB,"BASICS",NUMBER,"INTTYPE")="DOC"
+9 FOR NUMBER=1:1:13
SET ^TMP("TIU182",$JOB,"BASICS",NUMBER,"NAME")=$PIECE($TEXT(NAME+NUMBER),";;",2,99)
+10 QUIT
+11 ;
TIUDUPS(TIUDUPS,OPTFLG) ; Set array TIUDUPS of potential duplicate DDEFS
+1 NEW NUM
SET TIUDUPS=0
SET OPTFLG=+$GET(OPTFLG)
+2 IF $GET(^XTMP("TIU182","DONE"))="ALL"
QUIT
+3 FOR NUM=1:1:13
if 'NUM
QUIT
Begin DoDot:1
+4 ; -- When looking for duplicates, ignore DDEF if
+5 ; previously created by this patch:
+6 if $GET(^XTMP("TIU182",NUM,"DONE"))
QUIT
+7 ; -- If site already has DDEF w/ same Name & Type as one
+8 ; we are exporting, set its number into array TIUDUPS:
+9 NEW NAME,TYPE,TIUDA
SET TIUDA=0
+10 SET NAME=^TMP("TIU182",$JOB,"BASICS",NUM,"NAME")
+11 SET TYPE=^TMP("TIU182",$JOB,"BASICS",NUM,"INTTYPE")
+12 FOR
SET TIUDA=$ORDER(^TIU(8925.1,"B",NAME,TIUDA))
if +TIUDA'>0
QUIT
Begin DoDot:2
+13 IF $PIECE($GET(^TIU(8925.1,+TIUDA,0)),U,4)=TYPE
SET TIUDUPS(NUM)=+TIUDA
SET TIUDUPS=1
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
LISTDUPS(TIUDUPS,TMPCNT,OPTFLG) ; List duplicates by name
+1 ; TIUDUPS = array as set in TIUDUPS. Required.
+2 ; TMPCNT = Count at which to start message array ^TMP("TIU182MSG",$J,TMPCNT); Received by reference. (Array already has some nodes if called from option.) Optional.
+3 ; OPTFLG = 1 if called from option;
+4 ; 0 if called from env check. Optional.
+5 NEW NUM
+6 SET OPTFLG=+$GET(OPTFLG)
+7 SET TMPCNT=$SELECT($GET(TMPCNT):TMPCNT,1:0)
+8 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU182MSG",$JOB,TMPCNT)="You already have the following Document Definitions exported by this patch."
+9 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU182MSG",$JOB,TMPCNT)="I don't want to overwrite them. Please change their names so they no longer"
+10 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU182MSG",$JOB,TMPCNT)="match the exported ones, or if you are not using them, delete them. If you"
+11 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU182MSG",$JOB,TMPCNT)="change the name of a Document Definition you plan to continue using, remember"
+12 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU182MSG",$JOB,TMPCNT)="to update its Print Name, as well. For help, contact Enterprise VistA Support."
+13 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU182MSG",$JOB,TMPCNT)=""
+14 SET TMPCNT=TMPCNT+1
+15 IF 'OPTFLG
Begin DoDot:1
+16 SET ^TMP("TIU182MSG",$JOB,TMPCNT)="You will not be able to run option TIU182 DDEFS, MED CONVERSION to create the"
+17 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU182MSG",$JOB,TMPCNT)="DDEFS until these matches are eliminated."
End DoDot:1
+18 IF '$TEST
SET ^TMP("TIU182MSG",$JOB,TMPCNT)="You may not run this option until these matches are eliminated."
+19 SET NUM=0
+20 FOR
SET NUM=$ORDER(TIUDUPS(NUM))
if 'NUM
QUIT
Begin DoDot:1
+21 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU182MSG",$JOB,TMPCNT)=" "_^TMP("TIU182",$JOB,"BASICS",NUM,"NAME")
End DoDot:1
+22 ; -- If called from env check, not option, write list:
+23 IF OPTFLG
QUIT
+24 NEW TIUI
SET TIUI=0
+25 FOR
SET TIUI=$ORDER(^TMP("TIU182MSG",$JOB,TIUI))
if 'TIUI
QUIT
Begin DoDot:1
+26 WRITE !,^TMP("TIU182MSG",$JOB,TIUI)
End DoDot:1
+27 QUIT
+28 ;
NAME ; Names of DDEFS in order from 1 to 13
+1 ;;HISTORICAL PROCEDURES
+2 ;;HISTORICAL CARDIAC CATHETERIZATION PROCEDURE
+3 ;;HISTORICAL ELECTROCARDIOGRAM PROCEDURE
+4 ;;HISTORICAL ECHOCARDIOGRAM PROCEDURE
+5 ;;HISTORICAL ELECTROPHYSIOLOGY PROCEDURE
+6 ;;HISTORICAL HOLTER PROCEDURE
+7 ;;HISTORICAL EXERCISE TOLERANCE TEST PROCEDURE
+8 ;;HISTORICAL PRE/POST SURGERY RISK NOTE
+9 ;;HISTORICAL ENDOSCOPIC PROCEDURE
+10 ;;HISTORICAL PULMONARY FUNCTION TEST PROCEDURE
+11 ;;HISTORICAL HEMATOLOGY PROCEDURE
+12 ;;HISTORICAL PACEMAKER IMPLANTATION PROCEDURE
+13 ;;HISTORICAL RHEUMATOLOGY PROCEDURE
+14 QUIT
