Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUHSOBJ

TIUHSOBJ.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;Reference to $$CRE^GMTSOBJ in ICR #3813
  1. Q
  1. ;
  1. CREATE ; create a TIU object
  1. ;
  1. N TIUDA,TIUHS,TIUKF,TIUNAME
  1. N DA,DIC,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. ;
  1. W @IOF
  1. W !?19,"--- Create TIU/Health Summary Object ---"
  1. ;
  1. S DIR(0)="FAO^3:54"
  1. S DIR("A")="Enter a New TIU OBJECT NAME: "
  1. S DIR("?",1)="This is the technical name, 3-54* characters, not starting with punctuation."
  1. S DIR("?",2)="Name must be unique among all object Names, Abbreviations, and Print Names."
  1. S DIR("?",3)="Any lower case characters will automatically be changed to uppercase."
  1. S DIR("?",4)=""
  1. S DIR("?")="* "" (TIU)"" will be appended to the name entered to differentiate how the object was created. Example: OBJECT becomes OBJECT (TIU)"
  1. ;
  1. 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
  1. . S TIUDA=$$FIND1^DIC(8925.1,"","AMX",X,"D^C^B","I $P(^TIU(8925.1,+Y,0),U,4)=""O""","ERR")
  1. . I TIUDA'=0 W !!,"The object name ",X," already exists." K X,Y,TIUDA Q
  1. . 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)
  1. . E W !!,DIR("?",1) K TIUDA,X,Y Q
  1. . W !!,"Object Name: ",X D
  1. . . N DIR,X,Y S DIR("A")="Is this correct",DIR(0)="Y",DIR("B")="YES" W ! D ^DIR
  1. . . Q:$D(DIRUT) I Y(0)="NO" K TIUDA
  1. Q:$D(DIRUT)
  1. ;
  1. S TIUKF=0,TIUNAME=X K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. ;
  1. D I $D(DIRUT) W ! K DIR S DIR("A")="Enter RETURN to abort TIU Object creation...",DIR(0)="EA" D ^DIR Q
  1. . N DIR
  1. . S DIR("A")="Use a pre-existing Health Summary Object",DIR(0)="Y",DIR("B")="NO" W ! D ^DIR
  1. I $G(Y(0))="NO"
  1. E G PE
  1. ;
  1. W !!,"Checking ",TIUNAME_" (TIU)"," with Health Summary..."
  1. I $$FIND1^DIC(142.5,,"BX",TIUNAME_" (TIU)","B",,"ERROR")=0 D
  1. . W ! S TIUHS=$$CRE^GMTSOBJ(TIUNAME_" (TIU)") S TIUKF=1
  1. I D Q:$G(Y)=-1
  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
  1. E H .5 W "that name already exists."
  1. PE ;
  1. E D Q:$G(Y)=-1
  1. . S DIC=142.5,DIC("A")="Enter the name of the Health Summary Object: "
  1. . S DIC(0)="AEMQ",DIC("S")="I Y'<1"
  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
  1. . S TIUHS=+Y K DIC,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. ;
  1. W !!,"Create a TIU Object named: ",TIUNAME ; ,"/",$$GET1^DIQ(142.5,TIUHS_",",.01)
  1. S DIR("A")="Ok",DIR(0)="Y",DIR("B")="YES" W ! D ^DIR
  1. I $G(Y(0))'="YES" D Q
  1. . I TIUKF=1 S DA=TIUHS,DIK="^GMT(142.5," D ^DIK
  1. . W ! K DIR S DIR("A")="Enter RETURN to abort TIU Object creation...",DIR(0)="EA" D ^DIR
  1. ;
  1. N FDA,FDAIEN,MSG
  1. S FDA(8925.1,"+1,",.01)=TIUNAME
  1. S FDA(8925.1,"+1,",.03)=TIUNAME
  1. S FDA(8925.1,"+1,",.04)="O"
  1. S FDA(8925.1,"+1,",.05)=DUZ
  1. S FDA(8925.1,"+1,",.07)="11"
  1. S FDA(8925.1,"+1,",9)=$$METHOD(TIUHS)
  1. S FDA(8925.1,"+1,",99)=$H
  1. ;
  1. D UPDATE^DIE("","FDA","FDAIEN","MSG")
  1. ;
  1. I $D(MSG) D Q
  1. . W !!,"TIU Object creation failed. The following error message was returned:",!!
  1. . S MSG="" F S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG="" W MSG("DIERR",1,"TEXT",MSG),!
  1. ;
  1. W !!,"TIU Object created successfully.",! K DIR S DIR("A")="Enter RETURN to continue...",DIR(0)="EA" D ^DIR
  1. Q
  1. ;
  1. EDIT(TIUDA) ;
  1. ;
  1. Q:$G(TIUDA)'>0
  1. Q:$D(^TIU(8925.1,TIUDA,0))'>0
  1. N DA,DIE,DIR,DR,X,Y
  1. I $G(DUZ)'=$P($G(^TIU(8925.1,TIUDA,0)),U,5) D Q
  1. . W !!,"You are not the owner - cannot edit name!"
  1. . S DIR("A")="Enter RETURN to continue...",DIR(0)="EA" W ! D ^DIR
  1. S DA=TIUDA,DIE="^TIU(8925.1,",DR=".01//"
  1. D ^DIE
  1. Q
  1. ;
  1. EXIST(HSNUM) ; entry point for Health Summary to verify if a HS Object is used in a TIU Object
  1. ;
  1. N EXIST,TIUDA S (EXIST,TIUDA)=0
  1. F S TIUDA=$O(^TIU(8925.1,TIUDA)) Q:TIUDA="" I +$P($G(^TIU(8925.1,TIUDA,9)),",",2)=HSNUM S EXIST=1
  1. Q EXIST
  1. METHOD(TIUHSOBJ) ; Return the method to execute the Health Summary object
  1. ;PARAMETER: TIUHSOBJ - Pointer to HEALTH SUMMARY OBJECTS file (#142.5) entry
  1. ; OR NAME field (#.01) value of entry
  1. N TIUERROR
  1. S TIUHSOBJ=$G(TIUHSOBJ)
  1. I TIUHSOBJ="" S TIUHSOBJ=0
  1. I TIUHSOBJ'?1.N S TIUHSOBJ=+$$FIND1^DIC(142.5,,"BX",TIUHSOBJ,"B",,"TIUERROR")
  1. Q "S X=$$TIU^GMTSOBJ(DFN,"_TIUHSOBJ_")"