TIUHSOBJ ;SLC/AJB,AGP - Health Summary to TIU Object;Jun 07, 2023@14:57
;;1.0;TEXT INTEGRATION UTILITIES;**135,359**;Jun 20, 1997;Build 17
;
;Reference to $$CRE^GMTSOBJ in ICR #3813
Q
;
CREATE ; create a TIU object
;
N TIUDA,TIUHS,TIUKF,TIUNAME
N DA,DIC,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
;
W @IOF
W !?19,"--- Create TIU/Health Summary Object ---"
;
S DIR(0)="FAO^3:54"
S DIR("A")="Enter a New TIU OBJECT NAME: "
S DIR("?",1)="This is the technical name, 3-54* characters, not starting with punctuation."
S DIR("?",2)="Name must be unique among all object Names, Abbreviations, and Print Names."
S DIR("?",3)="Any lower case characters will automatically be changed to uppercase."
S DIR("?",4)=""
S DIR("?")="* "" (TIU)"" will be appended to the name entered to differentiate how the object was created. Example: OBJECT becomes OBJECT (TIU)"
;
F Q:$G(TIUDA)=0 W ! D ^DIR S X=$$UP^XLFSTR(X) D:'$D(DIRUT) I $D(DIRUT) W ! K DIR S DIR("A")="Enter RETURN to abort TIU Object creation...",DIR(0)="EA" D ^DIR S DIRUT="" Q
. S TIUDA=$$FIND1^DIC(8925.1,"","AMX",X,"D^C^B","I $P(^TIU(8925.1,+Y,0),U,4)=""O""","ERR")
. I TIUDA'=0 W !!,"The object name ",X," already exists." K X,Y,TIUDA Q
. I ($A($E(X,1))'<48&($A($E(X,1))'>57))!($A($E(X,1))'<65&($A($E(X,1))'>90))!($A($E(X,1))=32)
. E W !!,DIR("?",1) K TIUDA,X,Y Q
. W !!,"Object Name: ",X D
. . N DIR,X,Y S DIR("A")="Is this correct",DIR(0)="Y",DIR("B")="YES" W ! D ^DIR
. . Q:$D(DIRUT) I Y(0)="NO" K TIUDA
Q:$D(DIRUT)
;
S TIUKF=0,TIUNAME=X K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
;
D I $D(DIRUT) W ! K DIR S DIR("A")="Enter RETURN to abort TIU Object creation...",DIR(0)="EA" D ^DIR Q
. N DIR
. S DIR("A")="Use a pre-existing Health Summary Object",DIR(0)="Y",DIR("B")="NO" W ! D ^DIR
I $G(Y(0))="NO"
E G PE
;
W !!,"Checking ",TIUNAME_" (TIU)"," with Health Summary..."
I $$FIND1^DIC(142.5,,"BX",TIUNAME_" (TIU)","B",,"ERROR")=0 D
. W ! S TIUHS=$$CRE^GMTSOBJ(TIUNAME_" (TIU)") S TIUKF=1
I D Q:$G(Y)=-1
. I TIUHS=-1 W ! K DIR S DIR("A")="Enter RETURN to abort TIU Object creation...",DIR(0)="EA" D ^DIR S Y=-1 Q
E H .5 W "that name already exists."
PE ;
E D Q:$G(Y)=-1
. S DIC=142.5,DIC("A")="Enter the name of the Health Summary Object: "
. S DIC(0)="AEMQ",DIC("S")="I Y'<1"
. W ! D ^DIC I Y=-1 W ! K DIR S DIR("A")="Enter RETURN to abort TIU Object creation...",DIR(0)="EA" D ^DIR S Y=-1 Q
. S TIUHS=+Y K DIC,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
;
W !!,"Create a TIU Object named: ",TIUNAME ; ,"/",$$GET1^DIQ(142.5,TIUHS_",",.01)
S DIR("A")="Ok",DIR(0)="Y",DIR("B")="YES" W ! D ^DIR
I $G(Y(0))'="YES" D Q
. I TIUKF=1 S DA=TIUHS,DIK="^GMT(142.5," D ^DIK
. W ! K DIR S DIR("A")="Enter RETURN to abort TIU Object creation...",DIR(0)="EA" D ^DIR
;
N FDA,FDAIEN,MSG
S FDA(8925.1,"+1,",.01)=TIUNAME
S FDA(8925.1,"+1,",.03)=TIUNAME
S FDA(8925.1,"+1,",.04)="O"
S FDA(8925.1,"+1,",.05)=DUZ
S FDA(8925.1,"+1,",.07)="11"
S FDA(8925.1,"+1,",9)=$$METHOD(TIUHS)
S FDA(8925.1,"+1,",99)=$H
;
D UPDATE^DIE("","FDA","FDAIEN","MSG")
;
I $D(MSG) D Q
. 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 !!,"TIU Object created successfully.",! K DIR S DIR("A")="Enter RETURN to continue...",DIR(0)="EA" D ^DIR
Q
;
EDIT(TIUDA) ;
;
Q:$G(TIUDA)'>0
Q:$D(^TIU(8925.1,TIUDA,0))'>0
N DA,DIE,DIR,DR,X,Y
I $G(DUZ)'=$P($G(^TIU(8925.1,TIUDA,0)),U,5) D Q
. W !!,"You are not the owner - cannot edit name!"
. S DIR("A")="Enter RETURN to continue...",DIR(0)="EA" W ! D ^DIR
S DA=TIUDA,DIE="^TIU(8925.1,",DR=".01//"
D ^DIE
Q
;
EXIST(HSNUM) ; entry point for Health Summary to verify if a HS Object is used in a TIU Object
;
N EXIST,TIUDA S (EXIST,TIUDA)=0
F S TIUDA=$O(^TIU(8925.1,TIUDA)) Q:TIUDA="" I +$P($G(^TIU(8925.1,TIUDA,9)),",",2)=HSNUM S EXIST=1
Q EXIST
METHOD(TIUHSOBJ) ; Return the method to execute the Health Summary object
;PARAMETER: TIUHSOBJ - Pointer to HEALTH SUMMARY OBJECTS file (#142.5) entry
; OR NAME field (#.01) value of entry
N TIUERROR
S TIUHSOBJ=$G(TIUHSOBJ)
I TIUHSOBJ="" S TIUHSOBJ=0
I TIUHSOBJ'?1.N S TIUHSOBJ=+$$FIND1^DIC(142.5,,"BX",TIUHSOBJ,"B",,"TIUERROR")
Q "S X=$$TIU^GMTSOBJ(DFN,"_TIUHSOBJ_")"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUHSOBJ 4389 printed Oct 16, 2024@18:42:22 Page 2
TIUHSOBJ ;SLC/AJB,AGP - Health Summary to TIU Object;Jun 07, 2023@14:57
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**135,359**;Jun 20, 1997;Build 17
+2 ;
+3 ;Reference to $$CRE^GMTSOBJ in ICR #3813
+4 QUIT
+5 ;
CREATE ; create a TIU object
+1 ;
+2 NEW TIUDA,TIUHS,TIUKF,TIUNAME
+3 NEW DA,DIC,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+4 ;
+5 WRITE @IOF
+6 WRITE !?19,"--- Create TIU/Health Summary Object ---"
+7 ;
+8 SET DIR(0)="FAO^3:54"
+9 SET DIR("A")="Enter a New TIU OBJECT NAME: "
+10 SET DIR("?",1)="This is the technical name, 3-54* characters, not starting with punctuation."
+11 SET DIR("?",2)="Name must be unique among all object Names, Abbreviations, and Print Names."
+12 SET DIR("?",3)="Any lower case characters will automatically be changed to uppercase."
+13 SET DIR("?",4)=""
+14 SET DIR("?")="* "" (TIU)"" will be appended to the name entered to differentiate how the object was created. Example: OBJECT becomes OBJECT (TIU)"
+15 ;
+16 FOR
if $GET(TIUDA)=0
QUIT
WRITE !
DO ^DIR
SET X=$$UP^XLFSTR(X)
if '$DATA(DIRUT)
Begin DoDot:1
+17 SET TIUDA=$$FIND1^DIC(8925.1,"","AMX",X,"D^C^B","I $P(^TIU(8925.1,+Y,0),U,4)=""O""","ERR")
+18 IF TIUDA'=0
WRITE !!,"The object name ",X," already exists."
KILL X,Y,TIUDA
QUIT
+19 IF ($ASCII($EXTRACT(X,1))'<48&($ASCII($EXTRACT(X,1))'>57))!($ASCII($EXTRACT(X,1))'<65&($ASCII($EXTRACT(X,1))'>90))!($ASCII($EXTRACT(X,1))=32)
+20 IF '$TEST
WRITE !!,DIR("?",1)
KILL TIUDA,X,Y
QUIT
+21 WRITE !!,"Object Name: ",X
Begin DoDot:2
+22 NEW DIR,X,Y
SET DIR("A")="Is this correct"
SET DIR(0)="Y"
SET DIR("B")="YES"
WRITE !
DO ^DIR
+23 if $DATA(DIRUT)
QUIT
IF Y(0)="NO"
KILL TIUDA
End DoDot:2
End DoDot:1
IF $DATA(DIRUT)
WRITE !
KILL DIR
SET DIR("A")="Enter RETURN to abort TIU Object creation..."
SET DIR(0)="EA"
DO ^DIR
SET DIRUT=""
QUIT
+24 if $DATA(DIRUT)
QUIT
+25 ;
+26 SET TIUKF=0
SET TIUNAME=X
KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+27 ;
+28 Begin DoDot:1
+29 NEW DIR
+30 SET DIR("A")="Use a pre-existing Health Summary Object"
SET DIR(0)="Y"
SET DIR("B")="NO"
WRITE !
DO ^DIR
End DoDot:1
IF $DATA(DIRUT)
WRITE !
KILL DIR
SET DIR("A")="Enter RETURN to abort TIU Object creation..."
SET DIR(0)="EA"
DO ^DIR
QUIT
+31 IF $GET(Y(0))="NO"
+32 IF '$TEST
GOTO PE
+33 ;
+34 WRITE !!,"Checking ",TIUNAME_" (TIU)"," with Health Summary..."
+35 IF $$FIND1^DIC(142.5,,"BX",TIUNAME_" (TIU)","B",,"ERROR")=0
Begin DoDot:1
+36 WRITE !
SET TIUHS=$$CRE^GMTSOBJ(TIUNAME_" (TIU)")
SET TIUKF=1
End DoDot:1
+37 IF $TEST
Begin DoDot:1
+38 IF TIUHS=-1
WRITE !
KILL DIR
SET DIR("A")="Enter RETURN to abort TIU Object creation..."
SET DIR(0)="EA"
DO ^DIR
SET Y=-1
QUIT
End DoDot:1
if $GET(Y)=-1
QUIT
+39 IF '$TEST
HANG .5
WRITE "that name already exists."
PE ;
+1 IF '$TEST
Begin DoDot:1
+2 SET DIC=142.5
SET DIC("A")="Enter the name of the Health Summary Object: "
+3 SET DIC(0)="AEMQ"
SET DIC("S")="I Y'<1"
+4 WRITE !
DO ^DIC
IF Y=-1
WRITE !
KILL DIR
SET DIR("A")="Enter RETURN to abort TIU Object creation..."
SET DIR(0)="EA"
DO ^DIR
SET Y=-1
QUIT
+5 SET TIUHS=+Y
KILL DIC,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
End DoDot:1
if $GET(Y)=-1
QUIT
+6 ;
+7 ; ,"/",$$GET1^DIQ(142.5,TIUHS_",",.01)
WRITE !!,"Create a TIU Object named: ",TIUNAME
+8 SET DIR("A")="Ok"
SET DIR(0)="Y"
SET DIR("B")="YES"
WRITE !
DO ^DIR
+9 IF $GET(Y(0))'="YES"
Begin DoDot:1
+10 IF TIUKF=1
SET DA=TIUHS
SET DIK="^GMT(142.5,"
DO ^DIK
+11 WRITE !
KILL DIR
SET DIR("A")="Enter RETURN to abort TIU Object creation..."
SET DIR(0)="EA"
DO ^DIR
End DoDot:1
QUIT
+12 ;
+13 NEW FDA,FDAIEN,MSG
+14 SET FDA(8925.1,"+1,",.01)=TIUNAME
+15 SET FDA(8925.1,"+1,",.03)=TIUNAME
+16 SET FDA(8925.1,"+1,",.04)="O"
+17 SET FDA(8925.1,"+1,",.05)=DUZ
+18 SET FDA(8925.1,"+1,",.07)="11"
+19 SET FDA(8925.1,"+1,",9)=$$METHOD(TIUHS)
+20 SET FDA(8925.1,"+1,",99)=$HOROLOG
+21 ;
+22 DO UPDATE^DIE("","FDA","FDAIEN","MSG")
+23 ;
+24 IF $DATA(MSG)
Begin DoDot:1
+25 WRITE !!,"TIU Object creation failed. The following error message was returned:",!!
+26 SET MSG=""
FOR
SET MSG=$ORDER(MSG("DIERR",1,"TEXT",MSG))
if MSG=""
QUIT
WRITE MSG("DIERR",1,"TEXT",MSG),!
End DoDot:1
QUIT
+27 ;
+28 WRITE !!,"TIU Object created successfully.",!
KILL DIR
SET DIR("A")="Enter RETURN to continue..."
SET DIR(0)="EA"
DO ^DIR
+29 QUIT
+30 ;
EDIT(TIUDA) ;
+1 ;
+2 if $GET(TIUDA)'>0
QUIT
+3 if $DATA(^TIU(8925.1,TIUDA,0))'>0
QUIT
+4 NEW DA,DIE,DIR,DR,X,Y
+5 IF $GET(DUZ)'=$PIECE($GET(^TIU(8925.1,TIUDA,0)),U,5)
Begin DoDot:1
+6 WRITE !!,"You are not the owner - cannot edit name!"
+7 SET DIR("A")="Enter RETURN to continue..."
SET DIR(0)="EA"
WRITE !
DO ^DIR
End DoDot:1
QUIT
+8 SET DA=TIUDA
SET DIE="^TIU(8925.1,"
SET DR=".01//"
+9 DO ^DIE
+10 QUIT
+11 ;
EXIST(HSNUM) ; entry point for Health Summary to verify if a HS Object is used in a TIU Object
+1 ;
+2 NEW EXIST,TIUDA
SET (EXIST,TIUDA)=0
+3 FOR
SET TIUDA=$ORDER(^TIU(8925.1,TIUDA))
if TIUDA=""
QUIT
IF +$PIECE($GET(^TIU(8925.1,TIUDA,9)),",",2)=HSNUM
SET EXIST=1
+4 QUIT EXIST
METHOD(TIUHSOBJ) ; Return the method to execute the Health Summary object
+1 ;PARAMETER: TIUHSOBJ - Pointer to HEALTH SUMMARY OBJECTS file (#142.5) entry
+2 ; OR NAME field (#.01) value of entry
+3 NEW TIUERROR
+4 SET TIUHSOBJ=$GET(TIUHSOBJ)
+5 IF TIUHSOBJ=""
SET TIUHSOBJ=0
+6 IF TIUHSOBJ'?1.N
SET TIUHSOBJ=+$$FIND1^DIC(142.5,,"BX",TIUHSOBJ,"B",,"TIUERROR")
+7 QUIT "S X=$$TIU^GMTSOBJ(DFN,"_TIUHSOBJ_")"
