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

TIUPS169.m

Go to the documentation of this file. 
  1. TIUPS169 ; SLC/MAM - After installing TIU*1*169 ; 7/27/2004
  1.  ;;1.0;Text Integration Utilities;**169**;Jun 20, 1997
  1.  ; Option TIU169 DDEFS, C&P WORKSHEETS. Run after installing patch 169.
  1.  ; External References
  1.  ;   DBIA 3409  ^USR(8930,"B"
  1. BEGIN ; Create DDEFS
  1.  N TIUY,DESDC,TIUDUPS,TIUQUIT
  1.  W !!,"This option creates Document Definitions (DDEFS) for C&P Worksheets."
  1.  W !,"It may take one or two minutes to run.  It will tell you whether or not",!,"it is successful."
  1.  ; -- Set ^XTMP deletion date for about 2 years hence:
  1.  ;    Set it even if all are already created, in case it's in test
  1.  ;      for more than 2 years, so sites can reset it by running option.
  1.  S ^XTMP("TIU169",0)=$$FMADD^XLFDT(DT,730)_U_DT_U_"Tracks DDEFS created by Option TIU169 DDEFS, C&P WORKSHEETS"
  1.  ; -- Check if ALL done; check for Class Clinical Coord:
  1.  I $G(^XTMP("TIU169","DONE"))="ALL" D  Q
  1.  . W !,"All C&P Document Definitions have already been created."
  1.  I $O(^USR(8930,"B","CLINICAL COORDINATOR",""))="" D  Q
  1.  . W !,"I can't find User Class CLINICAL COORDINATOR. Option cannot be run without it."
  1.  ; -- Set basic DDEF data into BASICS node of data array ^TMP("TIU169":
  1.  D SETBASIC^TIUEN169
  1.  ; -- If DC was created or designated on previous run, set DESDC &
  1.  ;    check for new dups:
  1.  I $G(^XTMP("TIU169",1,"DONE")) D  Q:$G(TIUQUIT)
  1.  . S DESDC=^XTMP("TIU169",1,"DONE")
  1.  . W !!,"Proceeding with Document Class C&P EXAMINATION REPORTS..."
  1.  . D TIUDUPS^TIUEN169(.TIUDUPS,+DESDC)
  1.  . I $G(TIUDUPS("NOTINDC")) D LISTDUPS^TIUEN169(.TIUDUPS,0) S TIUQUIT=1 Q
  1.  ; -- If DC NOT created or designated on previous run, designate:
  1.  I '$G(^XTMP("TIU169",1,"DONE")) D  Q:$G(TIUQUIT)
  1.  . S DESDC=$$DESGNATE^TIUEN169
  1.  . I +DESDC=-1 W !,"Try later." S TIUQUIT=1 Q
  1.  . D TIUDUPS^TIUEN169(.TIUDUPS,+DESDC)
  1.  . I +$G(TIUDUPS("NOTINDC")) D LISTDUPS^TIUEN169(.TIUDUPS,0) S TIUQUIT=1 Q
  1.  . ; -- User has not designated a DC:
  1.  . I +DESDC=0 D  Q:$G(TIUQUIT)
  1.  . . S TIUY=$$READ^TIUU("YO","I will create a new Document Class with new Titles under it. OK","YES")
  1.  . . I +TIUY'=1 W !,"OK, try again when you're ready." S TIUQUIT=1
  1.  . ; -- No matching titles in Des DC:
  1.  . I +DESDC>0,'$G(TIUDUPS("INDC")) D  Q:$G(TIUQUIT)
  1.  . . S TIUY=$$READ^TIUU("YO","I will create the new Titles under Document Class "_$P(DESDC,U,2)_". OK","YES")
  1.  . . I +TIUY'=1 W !,"OK, try again when you're ready." S TIUQUIT=1
  1.  . ; -- Matching titles in Des DC:
  1.  . I +DESDC>0,+$G(TIUDUPS("INDC")) D  Q:$G(TIUQUIT)
  1.  . . D LISTDUPS^TIUEN169(.TIUDUPS,1)
  1.  . . S TIUY=$$READ^TIUU("YO","I will create the non-matching Titles under Document Class "_$P(DESDC,U,2)_", and skip the matching Titles. OK","YES")
  1.  . . I +TIUY'=1 W !,"OK, try again when you're ready." S TIUQUIT=1
  1.  . ; -- If user has designated DC and agreed, change Name & set DONE node:
  1.  . I +DESDC>0 D
  1.  . . N DCNAME,DA,DIE,DR,X,Y S DCNAME="C&P EXAMINATION REPORTS",DA=+DESDC,DIE=8925.1,DR=".01///^S X=DCNAME" D ^DIE
  1.  . . S ^XTMP("TIU169",1,"DONE")=+DESDC
  1.  ; -- If DDEFs are being skipped, set their DONE nodes:
  1.  N NUM,ALLFLG S ALLFLG=1
  1.  F NUM=2:1:58 D
  1.   . I '$G(TIUDUPS("INDC",NUM)),'$D(^XTMP("TIU169",NUM,"DONE")) S ALLFLG=0 Q
  1.   . I $G(TIUDUPS("INDC",NUM)) S ^XTMP("TIU169",NUM,"DONE")=TIUDUPS("INDC",NUM)
  1.  I ALLFLG S ^XTMP("TIU169","DONE")="ALL" D  Q
  1.  . W !,"All Document Definitions have already been created."
  1.  W ! K IOP N %ZIS S %ZIS="Q" D ^%ZIS
  1.  I POP W !,"Nothing created." K POP Q
  1.  I $D(IO("Q")) K IO("Q") D  Q
  1.  .S ZTRTN="MAIN^TIUPS169"
  1.  .S ZTDESC="Create DDEFS for C&P Worksheets - TIU*1*169"
  1.  .D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Canceled!")
  1.  .K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
  1.  .D HOME^%ZIS
  1.  U IO D MAIN,^%ZISC
  1.  Q
  1.  ;
  1. MAIN ; Create DDEFS for C&P
  1.  N TMPCNT,TIUSTTS
  1.  K ^TMP("TIU169MSG",$J),^TMP("TIU169ERR",$J)
  1.  ; -- Begin message array ^TMP("TIU169MSG",$J:
  1.  S TMPCNT=0
  1.  S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="         ***** Document Definitions (DDEFS) for C&P Worksheets *****"
  1.  S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="Creating the Document Definitions..."
  1.  ; -- Set flds for FILE call & item data into nodes FILEDATA & DATA
  1.  ;    of array ^TMP("TIU169":
  1.  D SETDATA^TIU169D
  1.  ; -- Loop through DDEFS to create them:
  1.  N NUM
  1.  F NUM=1:1:58 D
  1.  . N TIUIEN,YDDEF,TIUDA,PIEN,ITEMDA
  1.  . ; -- If DDEF was previously created by this option, or is being
  1.  . ;    skipped, quit and get next DDEF:
  1.  . S TIUIEN=+$G(^XTMP("TIU169",NUM,"DONE")) Q:TIUIEN
  1.  . ; -- If not, create new DDEF:
  1.  . S YDDEF=$$CREATE(NUM)
  1.  . ; -- If DDEF couldn't be created or was found by lookup
  1.  . ;    instead of being created, quit and get next DDEF: 
  1.  . I $G(^TMP("TIU169ERR",$J,NUM))="CREATE" Q
  1.  . S TIUDA=+YDDEF
  1.  . ; -- Call FILE to stuff fields from ^TMP("TIU169",$J,"FILEDATA",NUM:
  1.  . D FILE(NUM,TIUDA)
  1.  . I $G(^TMP("TIU169ERR",$J,NUM))="FILE" D DELETE^TIU169D(TIUDA) Q
  1.  . ; -- Add item to parent, stuff item data:
  1.  . S PIEN=$$PARENT(NUM)
  1.  . I $G(^TMP("TIU169ERR",$J,NUM))="FINDPARENT" D DELETE^TIU169D(TIUDA) Q
  1.  . S ITEMDA=+$$ADDITEM^TIU169D(NUM,TIUDA,PIEN)
  1.  . I $G(^TMP("TIU169ERR",$J,NUM))="ADDITEM" D DELETE^TIU169D(TIUDA) Q
  1.  . D FILEITEM^TIU169D(NUM,PIEN,ITEMDA)
  1.  . I $G(^TMP("TIU169ERR",$J,NUM))="FILEITEM" D DELETE^TIU169D(TIUDA,PIEN,ITEMDA) Q
  1.  . ; -- DDEF NUM has been created and edited successfully:
  1.  . S ^XTMP("TIU169",NUM,"DONE")=TIUDA
  1.  . Q
  1.  ; -- Add results from CREATE loop to message array:
  1.  N NUM S NUM=0
  1.  I $O(^TMP("TIU169ERR",$J,NUM))="" D  G MAINX
  1.  . S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="All Document Definitions have now been created successfully."
  1.  . S ^XTMP("TIU169","DONE")="ALL"
  1.  . ; -- Kill indiv DONE nodes:
  1.  . N NUMBER F NUMBER=1:1:58 K ^XTMP("TIU169",NUMBER)
  1.  S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=""
  1.  S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="Problems were encountered creating the following Document Definitions:"
  1.  F  S NUM=$O(^TMP("TIU169ERR",$J,NUM)) Q:NUM=""  D
  1.  . N PROB S PROB=^TMP("TIU169ERR",$J,NUM)
  1.  . D
  1.  . . I PROB="CREATE" S PROB="Couldn't create DDEF." Q
  1.  . . I PROB="FILE" S PROB="Couldn't file fields. DDEF deleted." Q
  1.  . . I PROB="FINDPARENT" S PROB="Couldn't find parent. DDEF deleted." Q
  1.  . . I PROB="ADDITEM" S PROB="Couldn't add DDEF to parent. DDEF deleted."
  1.  . . I PROB="FILEITEM" S PROB="Couldn't file Menu Text. DDEF deleted."
  1.  . S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=$S(NUM=1:"Document Class ",1:"Title ")_^TMP("TIU169",$J,"BASICS",NUM,"NAME")_": "
  1.  . S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="  "_PROB
  1.  S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=""
  1.  S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="Please contact Enterprise VistA Support. When problems have been resolved,"
  1.  S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="come back and rerun the option."
  1. MAINX ; Exit
  1.  ; -- Leave latest error arrays ^TMP("DIERR",$J) & TIUIERR around until
  1.  ;    now in case modules are run separately for debugging:
  1.  K TIUIERR,^TMP("DIERR",$J)
  1.  ; -- Finish message array ^TMP("TIU169MSG",$J and print it:
  1.  S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=""
  1.  S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="                           *************"
  1.  D PRINT^TIU169D
  1.  K ^TMP("TIU169MSG",$J),^TMP("TIU169ERR",$J),^TMP("TIU169",$J)
  1.  Q
  1.  ;
  1. PARENT(NUM) ; Return IEN of parent new DDEF should be added to
  1.  N PIEN,PNUM
  1.  ; Parent node has form:
  1.  ;   ^TMP("TIU169",$J,"DATA",NUM,PIEN) = IEN of parent if known, or
  1.  ;   ^TMP("TIU169",$J,"DATA",NUM,PNUM) = DDEF# of parent if not
  1.  S PIEN=$G(^TMP("TIU169",$J,"DATA",NUM,"PIEN"))
  1.  ; -- If parent IEN is known, we're done:
  1.  I +PIEN G PARENTX
  1.  ; -- If not, get DDEF# of parent
  1.  S PNUM=+$G(^TMP("TIU169",$J,"DATA",NUM,"PNUM"))
  1.  ; -- Get Parent IEN from "DONE" node, which was set
  1.  ;    when parent was created:
  1.  S PIEN=+$G(^XTMP("TIU169",PNUM,"DONE"))
  1. PARENTX I 'PIEN!'$D(^TIU(8925.1,PIEN,0)) D
  1.  . S ^TMP("TIU169ERR",$J,NUM)="FINDPARENT"
  1.  Q PIEN
  1.  ;
  1. FILE(NUM,TIUDA) ; File fields for new DDEF TIUDA
  1.  ; Files ALL FIELDS set in "FILEDATA" nodes of ^TMP:
  1.  ;   ^TMP("TIU169",$J,"FILEDATA",NUM,Field#)
  1.  N TIUFPRIV,FDA
  1.  K ^TMP("DIERR",$J)
  1.  S TIUFPRIV=1
  1.  M FDA(8925.1,TIUDA_",")=^TMP("TIU169",$J,"FILEDATA",NUM)
  1.  D FILE^DIE("TE","FDA")
  1.  I $D(^TMP("DIERR",$J)) S ^TMP("TIU169ERR",$J,NUM)="FILE"
  1.  Q
  1.  ;
  1. CREATE(NUM) ; Create new DDEF entry
  1.  N DIC,DLAYGO,DA,X,Y
  1.  S DIC="^TIU(8925.1,",DLAYGO=8925.1
  1.  S DIC(0)="LX",X=^TMP("TIU169",$J,"BASICS",NUM,"NAME")
  1.  S DIC("S")="I $P(^(0),U,4)="_""""_^TMP("TIU169",$J,"BASICS",NUM,"INTTYPE")_""""
  1.  D ^DIC
  1.  I $P($G(Y),U,3)'=1 S ^TMP("TIU169ERR",$J,NUM)="CREATE"
  1.  Q $G(Y)