- 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 Feb 19, 2025@00:08:13 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_")"