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