TIUWRII1 ;SLC/AJB,AGP - War Related Illness and Injury Study Center ; 08/18/03
;;1.0;TEXT INTEGRATION UTILITIES;**159**;Jun 20, 1997
;
Q
EN ;
X ^%ZOSF("EON") W $G(IOCUON),@IOF
N FDA,FDAIEN,MSG,POP,TIUABORT,TIUDA,TIUFPRIV,TIUPRNT
S TIUFPRIV=1,TIUPRNT=0
I '$$PATCH^XPDUTL("TIU*1.0*159")!($$CHKTITLE(8925.1,"WRIISC ASSESSMENT NOTE")=-1) F D Q:TIUPRNT>0!($D(DUOUT))
. D GETCLASS
. I +TIUPRNT<0 W !!,"Installation Error: Invalid Selection.",!
I +TIUPRNT<0 W !,"Enter EN^TIUWRII1 at the programmer prompt to re-build note title and objects.",! H 1 Q
I $$CHKTITLE(8925.1,"WRIISC ASSESSMENT NOTE")>0,'$$PATCH^XPDUTL("TIU*1.0*159") W !!,"Installation Error: WRIISC Assessment Note already exists.",! Q
I $$CHKTITLE(8930,"CLINICAL COORDINATOR")<0 W !!,"Installation Error: Class owner cannot be defined.",! Q
D DELOBJS,MKOBJS I $G(TIUABORT)>0 D DELOBJS H 2 Q
I '$$PATCH^XPDUTL("TIU*1.0*159")!($$CHKTITLE(8925.1,"WRIISC ASSESSMENT NOTE")=-1) D
. S FDA(8925.1,"+1,",.01)="WRIISC ASSESSMENT NOTE"
. S FDA(8925.1,"+1,",.03)="WRIISC ASSESSMENT NOTE"
. S FDA(8925.1,"+1,",.04)="DOC"
. S FDA(8925.1,"+1,",.06)=$$CHKTITLE(8930,"CLINICAL COORDINATOR")
. S FDA(8925.1,"+1,",.07)=11
. S FDA(8925.1,"+1,",3.02)=1
. S FDA(8925.1,"+1,",99)=$H
. D UPDATE^DIE("","FDA","FDAIEN","MSG")
. I $D(MSG) D D DELOBJS Q
.. W !!,"The following error message was returned:",!!
.. S MSG="" F S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG="" W MSG("DIERR",1,"TEXT",MSG),!
. W !!,"Creation of WRIISC ASSESSMENT NOTE title successful...",! H 1
. S TIUDA=FDAIEN(1)
. S FDA(8925.14,"+2,"_TIUPRNT_",",.01)=FDAIEN(1)
. S FDA(8925.14,"+2,"_TIUPRNT_",",4)="WRIISC Assessment Note"
. D UPDATE^DIE("","FDA","FDAIEN","MSG")
. I $D(MSG) D Q
.. W !!,"The following error message was returned:",!!
.. S MSG="" F S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG="" W MSG("DIERR",1,"TEXT",MSG),!
. W !,"Addition of "_$P(^TIU(8925.1,TIUPRNT,0),U)_" as parent successful...",! H 1
W !,"Update finished."
D
.N DIR,X,Y
.S DIR(0)="E"
.W ! D ^DIR
Q
CHKTITLE(FILE,NAME) ;
N DIC,X,Y
S DIC=FILE,DIC(0)="X"
S X=NAME
D ^DIC
Q +Y
GETCLASS ;
N DIC,X,Y
S DIC("A")="Select the DOCUMENT CLASS where the new title will be installed: "
S DIC(0)="AEQ",DIC="^TIU(8925.1,",DIC("S")="I $P(^(0),U,4)=""DC"""
D ^DIC
S TIUPRNT=+Y
Q
GETLAB ;
N DIC,X,Y
S DIC("A")="Enter your site's local lab name for "_LABNAME_": "
S DIC(0)="AEQ",DIC="^LAB(60,"
W ! D ^DIC
S LABIEN=+Y S:LABIEN>0 LABNAME=$P(Y,U,2)
Q
MKOBJS ;
N LABIEN,LABNAME,LINE,LINETXT,METHOD,NAME
F LINE=1:1 S LINETXT=$P($T(DATA+LINE),";;",2) Q:LINETXT="EOM"!$G(TIUABORT)>0 D
.S NAME=$P(LINETXT,";"),METHOD=$P(LINETXT,";",2)
.S:METHOD["@" METHOD=$TR(METHOD,"@",";")
.I $$CHKTITLE(8925.1,NAME)>0 W !!,"Installation Error: TIU Object "_NAME_" already exists." H 1 Q
.I METHOD="ASK USER" D
..N DUOUT,FLAG S FLAG=0
..S LABNAME=$P(LINETXT,";",3)
..I LABNAME="HEPATITIS C ANTIBODY" S FLAG=1
..S LABIEN=0
..F Q:LABIEN>0!($D(DUOUT)) D GETLAB
..S:LABIEN>0 METHOD=$S(FLAG=1:"S X=$$LAB2^TIUWRIIS(DFN,"""_LABNAME_""",5,,1410102,$$NOW^XLFDT)",1:"S X=$$LAB2^TIUWRIIS(DFN,"""_LABNAME_""",5,""T-365"")")
.I METHOD="ASK USER" D S TIUABORT=1 Q
..W !!,"Installation Error: TIU Object "_NAME_" creation aborted by user."
..W !,"Enter EN^TIUWRII1 at the programmer prompt to re-build note title and objects.",!
..W !,"See the patch description for more details."
.I $$MKOBJ(NAME,METHOD)<0 D
..W !!,"Installation Error: Creation of TIU Object "_NAME_" failed.",!
Q
MKOBJ(NAME,METHOD) ;
N FDA,FDAIEN,MSG
S FDA(8925.1,"+1,",.01)=NAME
S FDA(8925.1,"+1,",.03)=NAME
S FDA(8925.1,"+1,",.04)="O"
S FDA(8925.1,"+1,",.06)=$$CHKTITLE(8930,"CLINICAL COORDINATOR")
S FDA(8925.1,"+1,",.07)=11
S FDA(8925.1,"+1,",9)=METHOD
S FDA(8925.1,"+1,",99)=$H
D UPDATE^DIE("","FDA","FDAIEN","MSG")
I $D(MSG) D Q -1
. W !!,"TIU Object creation failed. The following error message was returned:",!!
. S MSG="" F S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG="" W MSG("DIERR",1,"TEXT",MSG),!
W !!,"Creation of TIU Object "_NAME_" successful..." H 1
Q 1
DELOBJS ;
N DA,DIK,LINE,LINETXT,NAME,X,Y
F LINE=1:1 S LINETXT=$P($T(DATA+LINE),";;",2) Q:LINETXT="EOM" D
.S NAME=$P(LINETXT,";")
.S DA=0,DA=$O(^TIU(8925.1,"B",NAME,DA))
.S DIK="^TIU(8925.1,"
.I DA>0 D ^DIK
Q
DATA ;
;;VA-WRIISC ADDRESS;S X=$$ADDRESS^TIUWRIIS(DFN)
;;VA-WRIISC ACTIVE PROBLEMS;S X=$$PROB^TIUWRIIS(DFN)
;;VA-WRIISC NEXT OF KIN;S X=$$PNOK^TIUWRIIS(DFN)
;;VA-WRIISC VITALS;S X=$$VITALS^TIUWRIIS(DFN,"T@BP@P@R",1,"T-90")
;;VA-WRIISC CBC;ASK USER;CBC
;;VA-WRIISC GLUCOSE;ASK USER;GLUCOSE
;;VA-WRIISC HEMATOCRIT;ASK USER;HEMATOCRIT
;;VA-WRIISC HEMOGLOBIN;ASK USER;HEMOGLOBIN
;;VA-WRIISC HEPATITIS C ANTIBODY;ASK USER;HEPATITIS C ANTIBODY
;;VA-WRIISC POTASSIUM;ASK USER;POTASSIUM
;;VA-WRIISC SODIUM;ASK USER;SODIUM
;;VA-WRIISC URINALYSIS;ASK USER;URINALYSIS
;;EOM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUWRII1 4989 printed Dec 13, 2024@02:46:32 Page 2
TIUWRII1 ;SLC/AJB,AGP - War Related Illness and Injury Study Center ; 08/18/03
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**159**;Jun 20, 1997
+2 ;
+3 QUIT
EN ;
+1 XECUTE ^%ZOSF("EON")
WRITE $GET(IOCUON),@IOF
+2 NEW FDA,FDAIEN,MSG,POP,TIUABORT,TIUDA,TIUFPRIV,TIUPRNT
+3 SET TIUFPRIV=1
SET TIUPRNT=0
+4 IF '$$PATCH^XPDUTL("TIU*1.0*159")!($$CHKTITLE(8925.1,"WRIISC ASSESSMENT NOTE")=-1)
FOR
Begin DoDot:1
+5 DO GETCLASS
+6 IF +TIUPRNT<0
WRITE !!,"Installation Error: Invalid Selection.",!
End DoDot:1
if TIUPRNT>0!($DATA(DUOUT))
QUIT
+7 IF +TIUPRNT<0
WRITE !,"Enter EN^TIUWRII1 at the programmer prompt to re-build note title and objects.",!
HANG 1
QUIT
+8 IF $$CHKTITLE(8925.1,"WRIISC ASSESSMENT NOTE")>0
IF '$$PATCH^XPDUTL("TIU*1.0*159")
WRITE !!,"Installation Error: WRIISC Assessment Note already exists.",!
QUIT
+9 IF $$CHKTITLE(8930,"CLINICAL COORDINATOR")<0
WRITE !!,"Installation Error: Class owner cannot be defined.",!
QUIT
+10 DO DELOBJS
DO MKOBJS
IF $GET(TIUABORT)>0
DO DELOBJS
HANG 2
QUIT
+11 IF '$$PATCH^XPDUTL("TIU*1.0*159")!($$CHKTITLE(8925.1,"WRIISC ASSESSMENT NOTE")=-1)
Begin DoDot:1
+12 SET FDA(8925.1,"+1,",.01)="WRIISC ASSESSMENT NOTE"
+13 SET FDA(8925.1,"+1,",.03)="WRIISC ASSESSMENT NOTE"
+14 SET FDA(8925.1,"+1,",.04)="DOC"
+15 SET FDA(8925.1,"+1,",.06)=$$CHKTITLE(8930,"CLINICAL COORDINATOR")
+16 SET FDA(8925.1,"+1,",.07)=11
+17 SET FDA(8925.1,"+1,",3.02)=1
+18 SET FDA(8925.1,"+1,",99)=$HOROLOG
+19 DO UPDATE^DIE("","FDA","FDAIEN","MSG")
+20 IF $DATA(MSG)
Begin DoDot:2
+21 WRITE !!,"The following error message was returned:",!!
+22 SET MSG=""
FOR
SET MSG=$ORDER(MSG("DIERR",1,"TEXT",MSG))
if MSG=""
QUIT
WRITE MSG("DIERR",1,"TEXT",MSG),!
End DoDot:2
DO DELOBJS
QUIT
+23 WRITE !!,"Creation of WRIISC ASSESSMENT NOTE title successful...",!
HANG 1
+24 SET TIUDA=FDAIEN(1)
+25 SET FDA(8925.14,"+2,"_TIUPRNT_",",.01)=FDAIEN(1)
+26 SET FDA(8925.14,"+2,"_TIUPRNT_",",4)="WRIISC Assessment Note"
+27 DO UPDATE^DIE("","FDA","FDAIEN","MSG")
+28 IF $DATA(MSG)
Begin DoDot:2
+29 WRITE !!,"The following error message was returned:",!!
+30 SET MSG=""
FOR
SET MSG=$ORDER(MSG("DIERR",1,"TEXT",MSG))
if MSG=""
QUIT
WRITE MSG("DIERR",1,"TEXT",MSG),!
End DoDot:2
QUIT
+31 WRITE !,"Addition of "_$PIECE(^TIU(8925.1,TIUPRNT,0),U)_" as parent successful...",!
HANG 1
End DoDot:1
+32 WRITE !,"Update finished."
+33 Begin DoDot:1
+34 NEW DIR,X,Y
+35 SET DIR(0)="E"
+36 WRITE !
DO ^DIR
End DoDot:1
+37 QUIT
CHKTITLE(FILE,NAME) ;
+1 NEW DIC,X,Y
+2 SET DIC=FILE
SET DIC(0)="X"
+3 SET X=NAME
+4 DO ^DIC
+5 QUIT +Y
GETCLASS ;
+1 NEW DIC,X,Y
+2 SET DIC("A")="Select the DOCUMENT CLASS where the new title will be installed: "
+3 SET DIC(0)="AEQ"
SET DIC="^TIU(8925.1,"
SET DIC("S")="I $P(^(0),U,4)=""DC"""
+4 DO ^DIC
+5 SET TIUPRNT=+Y
+6 QUIT
GETLAB ;
+1 NEW DIC,X,Y
+2 SET DIC("A")="Enter your site's local lab name for "_LABNAME_": "
+3 SET DIC(0)="AEQ"
SET DIC="^LAB(60,"
+4 WRITE !
DO ^DIC
+5 SET LABIEN=+Y
if LABIEN>0
SET LABNAME=$PIECE(Y,U,2)
+6 QUIT
MKOBJS ;
+1 NEW LABIEN,LABNAME,LINE,LINETXT,METHOD,NAME
+2 FOR LINE=1:1
SET LINETXT=$PIECE($TEXT(DATA+LINE),";;",2)
if LINETXT="EOM"!$GET(TIUABORT)>0
QUIT
Begin DoDot:1
+3 SET NAME=$PIECE(LINETXT,";")
SET METHOD=$PIECE(LINETXT,";",2)
+4 if METHOD["@"
SET METHOD=$TRANSLATE(METHOD,"@",";")
+5 IF $$CHKTITLE(8925.1,NAME)>0
WRITE !!,"Installation Error: TIU Object "_NAME_" already exists."
HANG 1
QUIT
+6 IF METHOD="ASK USER"
Begin DoDot:2
+7 NEW DUOUT,FLAG
SET FLAG=0
+8 SET LABNAME=$PIECE(LINETXT,";",3)
+9 IF LABNAME="HEPATITIS C ANTIBODY"
SET FLAG=1
+10 SET LABIEN=0
+11 FOR
if LABIEN>0!($DATA(DUOUT))
QUIT
DO GETLAB
+12 if LABIEN>0
SET METHOD=$SELECT(FLAG=1:"S X=$$LAB2^TIUWRIIS(DFN,"""_LABNAME_""",5,,1410102,$$NOW^XLFDT)",1:"S X=$$LAB2^TIUWRIIS(DFN,"""_LABNAME_""",5,""T-365"")")
End DoDot:2
+13 IF METHOD="ASK USER"
Begin DoDot:2
+14 WRITE !!,"Installation Error: TIU Object "_NAME_" creation aborted by user."
+15 WRITE !,"Enter EN^TIUWRII1 at the programmer prompt to re-build note title and objects.",!
+16 WRITE !,"See the patch description for more details."
End DoDot:2
SET TIUABORT=1
QUIT
+17 IF $$MKOBJ(NAME,METHOD)<0
Begin DoDot:2
+18 WRITE !!,"Installation Error: Creation of TIU Object "_NAME_" failed.",!
End DoDot:2
End DoDot:1
+19 QUIT
MKOBJ(NAME,METHOD) ;
+1 NEW FDA,FDAIEN,MSG
+2 SET FDA(8925.1,"+1,",.01)=NAME
+3 SET FDA(8925.1,"+1,",.03)=NAME
+4 SET FDA(8925.1,"+1,",.04)="O"
+5 SET FDA(8925.1,"+1,",.06)=$$CHKTITLE(8930,"CLINICAL COORDINATOR")
+6 SET FDA(8925.1,"+1,",.07)=11
+7 SET FDA(8925.1,"+1,",9)=METHOD
+8 SET FDA(8925.1,"+1,",99)=$HOROLOG
+9 DO UPDATE^DIE("","FDA","FDAIEN","MSG")
+10 IF $DATA(MSG)
Begin DoDot:1
+11 WRITE !!,"TIU Object creation failed. The following error message was returned:",!!
+12 SET MSG=""
FOR
SET MSG=$ORDER(MSG("DIERR",1,"TEXT",MSG))
if MSG=""
QUIT
WRITE MSG("DIERR",1,"TEXT",MSG),!
End DoDot:1
QUIT -1
+13 WRITE !!,"Creation of TIU Object "_NAME_" successful..."
HANG 1
+14 QUIT 1
DELOBJS ;
+1 NEW DA,DIK,LINE,LINETXT,NAME,X,Y
+2 FOR LINE=1:1
SET LINETXT=$PIECE($TEXT(DATA+LINE),";;",2)
if LINETXT="EOM"
QUIT
Begin DoDot:1
+3 SET NAME=$PIECE(LINETXT,";")
+4 SET DA=0
SET DA=$ORDER(^TIU(8925.1,"B",NAME,DA))
+5 SET DIK="^TIU(8925.1,"
+6 IF DA>0
DO ^DIK
End DoDot:1
+7 QUIT
DATA ;
+1 ;;VA-WRIISC ADDRESS;S X=$$ADDRESS^TIUWRIIS(DFN)
+2 ;;VA-WRIISC ACTIVE PROBLEMS;S X=$$PROB^TIUWRIIS(DFN)
+3 ;;VA-WRIISC NEXT OF KIN;S X=$$PNOK^TIUWRIIS(DFN)
+4 ;;VA-WRIISC VITALS;S X=$$VITALS^TIUWRIIS(DFN,"T@BP@P@R",1,"T-90")
+5 ;;VA-WRIISC CBC;ASK USER;CBC
+6 ;;VA-WRIISC GLUCOSE;ASK USER;GLUCOSE
+7 ;;VA-WRIISC HEMATOCRIT;ASK USER;HEMATOCRIT
+8 ;;VA-WRIISC HEMOGLOBIN;ASK USER;HEMOGLOBIN
+9 ;;VA-WRIISC HEPATITIS C ANTIBODY;ASK USER;HEPATITIS C ANTIBODY
+10 ;;VA-WRIISC POTASSIUM;ASK USER;POTASSIUM
+11 ;;VA-WRIISC SODIUM;ASK USER;SODIUM
+12 ;;VA-WRIISC URINALYSIS;ASK USER;URINALYSIS
+13 ;;EOM
+14 QUIT
