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

TIUP171P.m

Go to the documentation of this file. 
  1. TIUP171P ; SLC/JMH - Post install for TIU*1.0*171 [12/7/04 8:19am]
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**171**;Jun 20,1997
  1.  D ENV
  1.  Q
  1. POST ;
  1.  N TIUFPRIV S TIUFPRIV=1
  1.  D ENV
  1.  I $G(XPDQUIT)=2
  1.  W !
  1.  N TIUQ,X,X1,X2
  1.  S TIUQ=0
  1.  K ^TMP("TIUP171",$J)
  1.  S X1=DT,X2=90 D C^%DTC
  1.  S ^XTMP("TIUP171",0)=X_"^"_DT
  1.  F NUM=1:1:21 D  Q:+TIUQ
  1.  . N TIUDA
  1.  . ;set data array
  1.  . I '$$SETDATA(NUM) S TIUQ="1^SETDATA^"_NUM Q
  1.  . ;check if patch already installed this one
  1.  . I $$ALREADY(NUM) W NUM,":" D UPDATE(NUM) Q
  1.  . ;get new ddef ien
  1.  . I '$$CREATE(NUM) S TIUQ="1^CREATE^"_NUM Q
  1.  . ;file data
  1.  . I '$$FILE(NUM) S TIUQ="1^FILE^"_NUM Q
  1.  . ;add item to parent class
  1.  . I '$$ADDITEM(NUM) S TIUQ="1^ADDITEM^"_NUM Q
  1. POSTX ;
  1.  I +TIUQ D MESSAGE(TIUQ)
  1.  K ^TMP("TIUP171",$J)
  1.  W "...DONE"
  1.  Q
  1. ALREADY(NUM) ;
  1.  N NAME,IEN
  1.  S NAME=^TMP("TIUP171",$J,NUM,"DATA",.01)
  1.  S IEN=$O(^TIU(8925.1,"B",NAME,0))
  1.  I 'IEN Q 0
  1.  I $D(^XTMP("TIUP171",IEN)) Q 1
  1.  Q 0
  1. MESSAGE(TIUQ) ;
  1.  N CNT,NUM,LINE
  1.  S CNT="",NUM=$P(TIUQ,U,3)
  1.  S LINE=$P($T(DATA+NUM),";;",2,99)
  1.  W !!,"Error while creating Document Definition"
  1.  W !,"    ",$P(LINE,U)
  1.  W !!,$G(^TMP("TIUP171",$J,"ERROR"))
  1.  W !!,"The Document Definitions that were already created by this "
  1.  W !,"  patch will remain on your system.  You will need to"
  1.  W !,"  resolve the above error(s) and reinstall the patch to"
  1.  W !,"  get the remaining Document Definitions."
  1.  Q
  1. SETDATA(NUM) ;
  1.  N LINE,PIEN
  1.  S LINE=$P($T(DATA+NUM),";;",2,99)
  1.  I '$D(LINE) Q 0
  1.  S ^TMP("TIUP171",$J,NUM,"DATA",.01)=$P(LINE,U,1)
  1.  S ^TMP("TIUP171",$J,NUM,"DATA",.02)=$P(LINE,U,2)
  1.  S ^TMP("TIUP171",$J,NUM,"DATA",.03)=$P(LINE,U,4)
  1.  S ^TMP("TIUP171",$J,NUM,"DATA",.04)=$P(LINE,U,5)
  1.  S ^TMP("TIUP171",$J,NUM,"DATA",.06)="CLINICAL COORDINATOR"
  1.  S ^TMP("TIUP171",$J,NUM,"DATA",.07)="ACTIVE"
  1.  S ^TMP("TIUP171",$J,NUM,"DATA",.13)="YES"
  1.  I $P(LINE,U,5)="O" D
  1.  . N CODE S CODE=$P(LINE,U,6)
  1.  . S ^TMP("TIUP171",$J,NUM,"DATA",9)=$TR(CODE,"#","^")
  1.  I $P(LINE,U,5)'="O" D
  1.  . S ^TMP("TIUP171",$J,NUM,"ITEM",4)=$P(LINE,U,7)
  1.  I +$$PARENT(NUM)=0 D  Q 0
  1.  . N PARENT,TYPE
  1.  . S TYPE="DOCUMENT CLASS"
  1.  . I NUM=1 S TYPE="CLASS"
  1.  . S PARENT=$P(LINE,U,3)
  1.  . S ^TMP("TIUP171",$J,"ERROR")="Could not locate "_PARENT_" "_TYPE_" while attempting to create Document Definition."
  1.  Q 1
  1. CREATE(NUM) ;
  1.  N DIC,DLAYGO,DA,X,Y
  1.  S DIC="^TIU(8925.1,",DLAYGO=8925.1
  1.  S DIC(0)="LX",X=^TMP("TIUP171",$J,NUM,"DATA",.01)
  1.  S DIC("S")="I $P(^(0),U,4)="_""""_^TMP("TIUP171",$J,NUM,"DATA",.04)_""""
  1.  D ^DIC
  1.  I $P($G(Y),U,3)'=1 D  Q 0
  1.  . S ^TMP("TIUP171",$J,"ERROR")="Could not create the Document Definition.  There could be another entry with the same name that already exists."
  1.  S ^TMP("TIUP171",$J,NUM,"TIUDA")=+Y
  1.  S ^XTMP("TIUP171",+Y)=""
  1.  Q 1
  1. FILE(NUM) ;
  1.  N TIUFPRIV,FDA,TIUDA,ERROR
  1.  K ^TMP("DIERR",$J)
  1.  S TIUDA=$G(^TMP("TIUP171",$J,NUM,"TIUDA"))
  1.  S TIUFPRIV=1
  1.  M FDA(8925.1,TIUDA_",")=^TMP("TIUP171",$J,NUM,"DATA")
  1.  D FILE^DIE("TE","FDA","ERROR")
  1.  I $D(ERROR) D  Q 0
  1.  . S ^TMP("TIUP171",$J,"ERROR")="Could not file the Document Definition. Fileman error message: "_$G(ERROR("DIERR",1))
  1.  Q 1
  1. ADDITEM(NUM) ;
  1.  N DA,DIC,DLAYGO,X,TIUDA,TIUFISC,Y,TIUFPRIV,DIE,DR
  1.  I '$D(^TMP("TIUP171",$J,NUM,"PARENT")) Q 1
  1.  S TIUFPRIV=1
  1.  S DA(1)=^TMP("TIUP171",$J,NUM,"PARENT")
  1.  S DIC="^TIU(8925.1,"_DA(1)_",10,",DIC(0)="LX"
  1.  S DLAYGO=8925.14
  1.  S X=^TMP("TIUP171",$J,NUM,"DATA",.01)
  1.  S TIUDA=^TMP("TIUP171",$J,NUM,"TIUDA")
  1.  S TIUFISC=TIUDA
  1.  D ^DIC
  1.  I Y'>0!($P(Y,U,3)'=1) D  Q 0
  1.  . S ^TMP("TIUP171",$J,"ERROR")="Could not add the item parent."
  1.  I $D(^TMP("TIUP171",$J,NUM,"ITEM",4)) D
  1.  . N SUB,ROOT,IENS,FDA
  1.  . S SUB=$O(^TIU(8925.1,DA(1),10,"B",TIUDA,""))
  1.  . S IENS=SUB_","_DA(1)
  1.  . S ROOT(8925.14,IENS,4)=^TMP("TIUP171",$J,NUM,"ITEM",4)
  1.  . S FDA="ROOT"
  1.  . D FILE^DIE("ET",FDA)
  1.  Q 1
  1. PARENT(NUM) ;
  1.  N NAME,PIEN
  1.  S LINE=$P($T(DATA+NUM),";;",2,99)
  1.  S NAME=$P(LINE,U,3)
  1.  I NAME="" Q -1
  1.  S PIEN=$O(^TIU(8925.1,"B",NAME,""))
  1.  S ^TMP("TIUP171",$J,NUM,"PARENT")=PIEN
  1.  Q PIEN
  1. ROLLBACK ;
  1.  N TIUIEN
  1.  S TIUIEN=""
  1.  F  S TIUIEN=$O(^XTMP("TIUP171",TIUIEN),-1) Q:'TIUIEN  D
  1.  . D ITEMRB(TIUIEN)
  1.  . S DIK="^TIU(8925.1,",DA=TIUIEN
  1.  . D ^DIK
  1.  . K ^XTMP("TIUP171",TIUIEN)
  1.  Q
  1. ITEMRB(TIUDA) ;
  1.  N DA,DIK
  1.  S DA(1)=$O(^TIU(8925.1,"AD",TIUDA,""))
  1.  Q:'DA(1)
  1.  S DA=$O(^TIU(8925.1,DA(1),10,"B",TIUDA,""))
  1.  Q:'DA
  1.  S DIK="^TIU(8925.1,"_DA(1)_",10,"
  1.  D ^DIK
  1.  Q
  1. ENV ;
  1.  N CNT,NUM,X,X1,X2
  1.  K ^TMP("TIUP171",$J)
  1.  S X1=DT,X2=90 D C^%DTC
  1.  S ^XTMP("TIUP171",0)=X_"^"_DT
  1.  S CNT=0
  1.  ;check for the ASU Class "CLINICAL COORDINATOR"
  1.  I $O(^USR(8930,"B","CLINICAL COORDINATOR",""))="" D
  1.  . S CNT=CNT+1
  1.  . S ^TMP("TIUP171",$J,"ENV",CNT)="Cannot Find the CLINICAL COORDINATOR User Class"
  1.  ;check for the Class "PROGRESS NOTES"
  1.  I $O(^TIU(8925.1,"B","PROGRESS NOTES",""))="" D
  1.  . S CNT=CNT+1
  1.  . S ^TMP("TIUP171",$J,"ENV",CNT)="Cannot Find the PROGRESS NOTES Document Definition CLASS"
  1.  ;look for duplicates of entries this patch will add
  1.  F NUM=1:1:21 D
  1.  . N LINE,NAME,DA
  1.  . S DA=""
  1.  . S LINE=$P($T(DATA+NUM),";;",2,99)
  1.  . S NAME=$P(LINE,U,1)
  1.  . F  S DA=$O(^TIU(8925.1,"B",NAME,DA)) Q:'DA  D
  1.  . . I $D(^XTMP("TIUP171",DA)) Q
  1.  . . I $P(LINE,U,5)=$P($G(^TIU(8925.1,DA,0)),U,4) D
  1.  . . . I $P($G(^TIU(8925.1,DA,0)),U,13) S ^XTMP("TIUP171",DA)="" Q
  1.  . . . S CNT=CNT+1
  1.  . . . S ^TMP("TIUP171",$J,"ENV",CNT)="A Doc. Definition of type "_$P(LINE,U,5)_" named "_NAME_" already exists."
  1.  I $D(^TMP("TIUP171",$J,"ENV")) D
  1.  . S XPDQUIT=2
  1.  . W !!,"ENVIRONMENTAL CHECK - PROBLEMS REPORT FOR TIU*1*171"
  1.  . W !,"========================================================"
  1.  . W !!,"Patch TIU*1*171 cannot complete installation due to the following issue(s):",!
  1.  . N DA
  1.  . S DA=""
  1.  . F  S DA=$O(^TMP("TIUP171",$J,"ENV",DA)) Q:'DA  D
  1.  . . W !,^TMP("TIUP171",$J,"ENV",DA)
  1.  . W !!,"These issues must be addressed before the patch can be installed."
  1.  . W !!,"Please share this report with the Clinical Applications Coordinator"
  1.  . W !,"responsible for the TIU application so that he/she can make the"
  1.  . W !,"necessary corrections."
  1.  I '$D(^TMP("TIUP171",$J,"ENV")) W !!,"Environmental Check Results:  No Problems"
  1.  K ^TMP("TIUP171",$J)
  1.  Q
  1. UPDATE(NUM) ;
  1.  N DA,NAME
  1.  S NAME=^TMP("TIUP171",$J,NUM,"DATA",.01)
  1.  S DA=$O(^TIU(8925.1,"B",NAME,0))
  1.  I 'DA Q
  1.  N DIE,DR
  1.  S DIE=8925.1,DR=".03///"_$G(^TMP("TIUP171",$J,NUM,"DATA",.03)) D ^DIE
  1.  W " ",DA," UPDATED "_$G(^TMP("TIUP171",$J,NUM,"DATA",.03)),!
  1.  Q
  1. DATA ;
  1.  ;;SCI OUTCOMES^SCIO^PROGRESS NOTES^SCI OUTCOMES^DC^^SCI-OUTCOMES
  1.  ;;SCI FUNCTIONAL INDEPENDENCE MEASURE^SCIF^SCI OUTCOMES^SCI FUNCTIONAL INDEPENDENCE MEASURE^DOC^^SCI FIM
  1.  ;;SCI GENERAL NOTE^SCIG^SCI OUTCOMES^SCI GENERAL NOTE^DOC^^SCI General Note
  1.  ;;SCI CRAIG HANDICAP ASSESSMENT&REPORTING TECHNIQUE-SHORT FORM^SCIC^SCI OUTCOMES^SCI CRAIG HANDICAP ASSESSMENT&REPORTING TECHNIQUE-SHORT FORM^DOC^^SCI CHARTSF
  1.  ;;SCI DIENER SATISFACTION WITH LIFE SCALE^SCIS^SCI OUTCOMES^SCI DIENER SATISFACTION WITH LIFE SCALE^DOC^^SCI Diener SWLS
  1.  ;;SCI BOWEL CARE DATE CERTIFIED^BCDC^^SCI BOWEL CARE DATE CERTIFIED^O^S X=$$BCDC#SPNOBJ(DFN)
  1.  ;;SCI BOWEL CARE PROVIDER^BCP^^SCI BOWEL CARE PROVIDER^O^S X=$$BCPROV#SPNOBJ(DFN)
  1.  ;;SCI BOWEL CARE REIMBURSEMENT^BCR^^SCI BOWEL CARE REIMBURSEMENT^O^S X=$$BCREIMB#SPNOBJ(DFN)
  1.  ;;SCI ENROLLMENT PRIORITY^ENPR^^SCI ENROLLMENT PRIORITY^O^S X=$$EP#SPNOBJ(DFN)
  1.  ;;SCI ETIOLOGY^ETIO^^SCI ETIOLOGY^O^S X=$$EN#SPNETOBJ(DFN)
  1.  ;;SCI EXTENT OF SCI^ESCI^^SCI EXTENT OF SCI^O^S X=$$EXTNT#SPNOBJ(DFN)
  1.  ;;SCI LAST ANNUAL EVAL OFFERED^LAEO^^SCI LAST ANNUAL EVAL OFFERED^O^S X=$$LOFF#SPNOBJ(DFN)
  1.  ;;SCI LAST ANNUAL EVAL RECEIVED^LAER^^SCI LAST ANNUAL EVAL RECEIVED^O^S X=$$LREC#SPNOBJ(DFN)
  1.  ;;SCI MARITAL STATUS^MARS^^SCI MARITAL STATUS^O^S X=$$MAR#SPNOBJ(DFN)
  1.  ;;SCI MULTIPLE SCLEROSIS SUB TYPE^MSST^^SCI MULTIPLE SCLEROSIS SUB TYPE^O^S X=$$MSSUBT#SPNOBJ(DFN)
  1.  ;;SCI PRIMARY CARE PROVIDER^PCP^^SCI PRIMARY CARE PROVIDER^O^S X=$$PCPROV#SPNOBJ(DFN)
  1.  ;;SCI REGISTRATION STATUS^REGS^^SCI REGISTRATION STATUS^O^S X=$$RSTAT#SPNOBJ(DFN)
  1.  ;;SCI REMARKS^RMKS^^SCI REMARKS^O^S X=$$REMARKS#SPNOBJ(DFN)
  1.  ;;SCI SCD COORDINATOR^SCRD^^SCI SCD COORDINATOR^O^S X=$$SCDCOOR#SPNOBJ(DFN)
  1.  ;;SCI LEVEL^SLEV^^SCI LEVEL^O^S X=$$SCILEV#SPNOBJ(DFN)
  1.  ;;SCI VA SCI STATUS^VAST^^SCI VA SCI STATUS^O^S X=$$VASCI#SPNOBJ(DFN)
  1.  Q