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

TIUWRII1.m

Go to the documentation of this file. 
  1. TIUWRII1 ;SLC/AJB,AGP - War Related Illness and Injury Study Center ; 08/18/03
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**159**;Jun 20, 1997
  1.  ;
  1.  Q
  1. EN ;
  1.  X ^%ZOSF("EON") W $G(IOCUON),@IOF
  1.  N FDA,FDAIEN,MSG,POP,TIUABORT,TIUDA,TIUFPRIV,TIUPRNT
  1.  S TIUFPRIV=1,TIUPRNT=0
  1.  I '$$PATCH^XPDUTL("TIU*1.0*159")!($$CHKTITLE(8925.1,"WRIISC ASSESSMENT NOTE")=-1) F  D  Q:TIUPRNT>0!($D(DUOUT))
  1.  . D GETCLASS
  1.  . I +TIUPRNT<0 W !!,"Installation Error:  Invalid Selection.",!
  1.  I +TIUPRNT<0 W !,"Enter EN^TIUWRII1 at the programmer prompt to re-build note title and objects.",! H 1 Q
  1.  I $$CHKTITLE(8925.1,"WRIISC ASSESSMENT NOTE")>0,'$$PATCH^XPDUTL("TIU*1.0*159") W !!,"Installation Error:  WRIISC Assessment Note already exists.",! Q
  1.  I $$CHKTITLE(8930,"CLINICAL COORDINATOR")<0 W !!,"Installation Error:  Class owner cannot be defined.",! Q
  1.  D DELOBJS,MKOBJS I $G(TIUABORT)>0 D DELOBJS H 2 Q
  1.  I '$$PATCH^XPDUTL("TIU*1.0*159")!($$CHKTITLE(8925.1,"WRIISC ASSESSMENT NOTE")=-1) D
  1.  . S FDA(8925.1,"+1,",.01)="WRIISC ASSESSMENT NOTE"
  1.  . S FDA(8925.1,"+1,",.03)="WRIISC ASSESSMENT NOTE"
  1.  . S FDA(8925.1,"+1,",.04)="DOC"
  1.  . S FDA(8925.1,"+1,",.06)=$$CHKTITLE(8930,"CLINICAL COORDINATOR")
  1.  . S FDA(8925.1,"+1,",.07)=11
  1.  . S FDA(8925.1,"+1,",3.02)=1
  1.  . S FDA(8925.1,"+1,",99)=$H
  1.  . D UPDATE^DIE("","FDA","FDAIEN","MSG")
  1.  . I $D(MSG) D  D DELOBJS Q
  1.  .. W !!,"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.  . W !!,"Creation of WRIISC ASSESSMENT NOTE title successful...",! H 1
  1.  . S TIUDA=FDAIEN(1)
  1.  . S FDA(8925.14,"+2,"_TIUPRNT_",",.01)=FDAIEN(1)
  1.  . S FDA(8925.14,"+2,"_TIUPRNT_",",4)="WRIISC Assessment Note"
  1.  . D UPDATE^DIE("","FDA","FDAIEN","MSG")
  1.  . I $D(MSG) D  Q
  1.  .. W !!,"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.  . W !,"Addition of "_$P(^TIU(8925.1,TIUPRNT,0),U)_" as parent successful...",! H 1
  1.  W !,"Update finished."
  1.  D
  1.  .N DIR,X,Y
  1.  .S DIR(0)="E"
  1.  .W ! D ^DIR
  1.  Q
  1. CHKTITLE(FILE,NAME) ;
  1.  N DIC,X,Y
  1.  S DIC=FILE,DIC(0)="X"
  1.  S X=NAME
  1.  D ^DIC
  1.  Q +Y
  1. GETCLASS ;
  1.  N DIC,X,Y
  1.  S DIC("A")="Select the DOCUMENT CLASS where the new title will be installed:  "
  1.  S DIC(0)="AEQ",DIC="^TIU(8925.1,",DIC("S")="I $P(^(0),U,4)=""DC"""
  1.  D ^DIC
  1.  S TIUPRNT=+Y
  1.  Q
  1. GETLAB ;
  1.  N DIC,X,Y
  1.  S DIC("A")="Enter your site's local lab name for "_LABNAME_": "
  1.  S DIC(0)="AEQ",DIC="^LAB(60,"
  1.  W ! D ^DIC
  1.  S LABIEN=+Y S:LABIEN>0 LABNAME=$P(Y,U,2)
  1.  Q
  1. MKOBJS ;
  1.  N LABIEN,LABNAME,LINE,LINETXT,METHOD,NAME
  1.  F LINE=1:1 S LINETXT=$P($T(DATA+LINE),";;",2) Q:LINETXT="EOM"!$G(TIUABORT)>0  D
  1.  .S NAME=$P(LINETXT,";"),METHOD=$P(LINETXT,";",2)
  1.  .S:METHOD["@" METHOD=$TR(METHOD,"@",";")
  1.  .I $$CHKTITLE(8925.1,NAME)>0 W !!,"Installation Error:  TIU Object "_NAME_" already exists." H 1 Q
  1.  .I METHOD="ASK USER" D
  1.  ..N DUOUT,FLAG S FLAG=0
  1.  ..S LABNAME=$P(LINETXT,";",3)
  1.  ..I LABNAME="HEPATITIS C ANTIBODY" S FLAG=1
  1.  ..S LABIEN=0
  1.  ..F  Q:LABIEN>0!($D(DUOUT))  D GETLAB
  1.  ..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"")")
  1.  .I METHOD="ASK USER" D  S TIUABORT=1 Q
  1.  ..W !!,"Installation Error:  TIU Object "_NAME_" creation aborted by user."
  1.  ..W !,"Enter EN^TIUWRII1 at the programmer prompt to re-build note title and objects.",!
  1.  ..W !,"See the patch description for more details."
  1.  .I $$MKOBJ(NAME,METHOD)<0 D
  1.  ..W !!,"Installation Error:  Creation of TIU Object "_NAME_" failed.",!
  1.  Q
  1. MKOBJ(NAME,METHOD) ;
  1.  N FDA,FDAIEN,MSG
  1.  S FDA(8925.1,"+1,",.01)=NAME
  1.  S FDA(8925.1,"+1,",.03)=NAME
  1.  S FDA(8925.1,"+1,",.04)="O"
  1.  S FDA(8925.1,"+1,",.06)=$$CHKTITLE(8930,"CLINICAL COORDINATOR")
  1.  S FDA(8925.1,"+1,",.07)=11
  1.  S FDA(8925.1,"+1,",9)=METHOD
  1.  S FDA(8925.1,"+1,",99)=$H
  1.  D UPDATE^DIE("","FDA","FDAIEN","MSG")
  1.  I $D(MSG) D  Q -1
  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.  W !!,"Creation of TIU Object "_NAME_" successful..." H 1
  1.  Q 1
  1. DELOBJS ;
  1.  N DA,DIK,LINE,LINETXT,NAME,X,Y
  1.  F LINE=1:1 S LINETXT=$P($T(DATA+LINE),";;",2) Q:LINETXT="EOM"  D
  1.  .S NAME=$P(LINETXT,";")
  1.  .S DA=0,DA=$O(^TIU(8925.1,"B",NAME,DA))
  1.  .S DIK="^TIU(8925.1,"
  1.  .I DA>0 D ^DIK
  1.  Q
  1. DATA ;
  1.  ;;VA-WRIISC ADDRESS;S X=$$ADDRESS^TIUWRIIS(DFN)
  1.  ;;VA-WRIISC ACTIVE PROBLEMS;S X=$$PROB^TIUWRIIS(DFN)
  1.  ;;VA-WRIISC NEXT OF KIN;S X=$$PNOK^TIUWRIIS(DFN)
  1.  ;;VA-WRIISC VITALS;S X=$$VITALS^TIUWRIIS(DFN,"T@BP@P@R",1,"T-90")
  1.  ;;VA-WRIISC CBC;ASK USER;CBC
  1.  ;;VA-WRIISC GLUCOSE;ASK USER;GLUCOSE
  1.  ;;VA-WRIISC HEMATOCRIT;ASK USER;HEMATOCRIT
  1.  ;;VA-WRIISC HEMOGLOBIN;ASK USER;HEMOGLOBIN
  1.  ;;VA-WRIISC HEPATITIS C ANTIBODY;ASK USER;HEPATITIS C ANTIBODY
  1.  ;;VA-WRIISC POTASSIUM;ASK USER;POTASSIUM
  1.  ;;VA-WRIISC SODIUM;ASK USER;SODIUM
  1.  ;;VA-WRIISC URINALYSIS;ASK USER;URINALYSIS
  1.  ;;EOM
  1.  Q