- TIU182DF ; SLC/MAM - Create new HP DDEFS ; 7/22/04
- ;;1.0;Text Integration Utilities;**182**;Jun 20, 1997
- ; Run this after installing patch 182.
- ;Use option: TIU182 DDEFS, MED CONVERSION
- ; External References
- ; DBIA 3409 ^USR(8930,"B"
- BEGIN ; Create DDEFS
- W !!,"This option creates Historical Procedure Document Definitions (DDEFS) for",!,"the Medicine Package conversion."
- W !,"It may take one or two minutes to run. It will tell you whether or not",!,"it is successful."
- W ! K IOP N %ZIS S %ZIS="Q" D ^%ZIS I POP K POP Q
- I $D(IO("Q")) K IO("Q") D Q
- .S ZTRTN="MAIN^TIUPS182"
- .S ZTDESC="Create DDEFS for Medicine Conversion - TIU*1*182"
- .D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Canceled!")
- .K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
- .D HOME^%ZIS
- U IO D MAIN,^%ZISC
- Q
- ;
- MAIN ; Create Historical Procedure DDEFS for Medicine Conversion
- N TIUDUPS,TMPCNT,TIUSTTS
- ; -- Set ^XTMP deletion date for about 2 years hence:
- ; Set it even if all are already created, in case it's in test
- ; for more than 2 years, so sites can reset it by running option.
- S ^XTMP("TIU182",0)=$$FMADD^XLFDT(DT,730)_U_DT_U_"Tracks DDEFS created by Option TIU182 DDEFS, MED CONVERSION"
- K ^TMP("TIU182MSG",$J),^TMP("TIU182ERR",$J),^TMP("TIU182",$J)
- ; -- Begin message array ^TMP("TIU182MSG",$J:
- S TMPCNT=0
- S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="*** Historical Procedure Document Definitions for the Medicine Conversion ***"
- ; -- Check if ALL done; check for Class Clinical Coord:
- I $G(^XTMP("TIU182","DONE"))="ALL" D G MAINX
- . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="All DDEFS exported for the conversion have already been created"
- . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="by option TIU182 DDEFS, MED CONVERSION."
- N CPCLASS S CPCLASS=$$CLASS^TIUCP I 'CPCLASS D
- . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="I can't find Class CLINICAL PROCEDURES, exported in patch TIU*1*109."
- . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="Option cannot be run without it."
- . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=""
- I $O(^USR(8930,"B","CLINICAL COORDINATOR",""))="" D
- . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="I can't find User Class CLINICAL COORDINATOR. Option cannot be run without it."
- . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=""
- ; -- Set basic DDEF data into BASICS node of data array ^TMP("TIU182":
- D SETBASIC^TIUEN182
- ; -- Check for potential DDEF duplicates at site:
- D TIUDUPS^TIUEN182(.TIUDUPS,1)
- ; -- If potential duplicates exist, add them to message array:
- I TIUDUPS D LISTDUPS^TIUEN182(.TIUDUPS,.TMPCNT,1) G MAINX
- I $O(^USR(8930,"B","CLINICAL COORDINATOR",""))="" G MAINX
- I 'CPCLASS G MAINX
- ; -- If no potential dups, User Class exists, CLINICAL PROCEDURES
- ; Class exists, go on:
- S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="Environment looks OK."
- ; -- Check if some DDEFS done:
- I $G(^XTMP("TIU182","DONE"))="SOME" D
- . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="Some of the DDEFS exported for the conversion have already been"
- . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="created by this option. I will now create the others..."
- ; -- If none created yet:
- I '$D(^XTMP("TIU182","DONE")) D
- . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="Creating the Document Definitions..."
- ; -- Set flds for FILE call & item data into nodes FILEDATA & DATA
- ; of array ^TMP("TIU182":
- D SETDATA^TIU182D
- ; -- Loop through DDEFS to create them:
- N NUM
- F NUM=1:1:13 D
- . N TIUIEN,YDDEF,TIUDA,PIEN,ITEMDA
- . ; -- If DDEF was previously created by this option,
- . ; quit and get next DDEF:
- . S TIUIEN=+$G(^XTMP("TIU182",NUM,"DONE")) Q:TIUIEN
- . ; -- If not, create new DDEF:
- . S YDDEF=$$CREATE^TIU182D1(NUM)
- . ; -- If DDEF couldn't be created or was found by lookup
- . ; instead of being created, quit and get next DDEF:
- . I $G(^TMP("TIU182ERR",$J,NUM))="CREATE" Q
- . S TIUDA=+YDDEF
- . ; -- Call FILE to stuff fields from ^TMP("TIU182",$J,"FILEDATA",NUM:
- . D FILE^TIU182D1(NUM,TIUDA)
- . I $G(^TMP("TIU182ERR",$J,NUM))="FILE" D DELETE^TIU182D1(TIUDA) Q
- . ; -- Add item to parent, stuff item data:
- . S PIEN=$$PARENT^TIU182D1(NUM)
- . I $G(^TMP("TIU182ERR",$J,NUM))="FINDPARENT" D DELETE^TIU182D1(TIUDA) Q
- . S ITEMDA=+$$ADDITEM^TIU182D1(NUM,TIUDA,PIEN)
- . I $G(^TMP("TIU182ERR",$J,NUM))="ADDITEM" D DELETE^TIU182D1(TIUDA) Q
- . D FILEITEM^TIU182D1(NUM,PIEN,ITEMDA)
- . I $G(^TMP("TIU182ERR",$J,NUM))="FILEITEM" D DELETE^TIU182D1(TIUDA,PIEN,ITEMDA) Q
- . ; -- DDEF NUM has been created and edited successfully:
- . S ^XTMP("TIU182",NUM,"DONE")=TIUDA
- . S ^XTMP("TIU182","DONE")="SOME"
- . Q
- ; -- Add results from CREATE loop to message array:
- N NUM S NUM=0
- I $O(^TMP("TIU182ERR",$J,NUM))="" D G MAINX
- . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="All Document Definitions have now been created successfully."
- . S ^XTMP("TIU182","DONE")="ALL"
- . ; -- Kill indiv DONE nodes:
- . N NUMBER F NUMBER=1:1:13 K ^XTMP("TIU182",NUMBER)
- . ; -- Edit Print Form Header,delete PF Number of Class CP:
- . N FDA,TIUFPRIV S FDA(8925.1,CPCLASS_",",6.1)="CLINICAL PROCEDURES"
- . S FDA(8925.1,CPCLASS_",",6.12)="@"
- . S TIUFPRIV=1
- . D FILE^DIE("TE","FDA")
- . Q:'$D(^TMP("DIERR",$J))
- . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="Couldn't update CP Print Fields. See patch description or contact EVS."
- S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=""
- S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="Problems were encountered creating the following Document Definitions:"
- F S NUM=$O(^TMP("TIU182ERR",$J,NUM)) Q:NUM="" D
- . N PROB S PROB=^TMP("TIU182ERR",$J,NUM)
- . D
- . . I PROB="CREATE" S PROB="Couldn't create DDEF." Q
- . . I PROB="FILE" S PROB="Couldn't file fields. DDEF deleted." Q
- . . I PROB="FINDPARENT" S PROB="Couldn't find parent. DDEF deleted." Q
- . . I PROB="ADDITEM" S PROB="Couldn't add DDEF to parent. DDEF deleted."
- . . I PROB="FILEITEM" S PROB="Couldn't file Menu Text. DDEF deleted."
- . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=$S(NUM=1:"Document Class ",1:"Title ")_^TMP("TIU182",$J,"BASICS",NUM,"NAME")_": "
- . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=" "_PROB
- S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=""
- S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="Please contact Enterprise VistA Support. When problems have been resolved,"
- S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="come back and rerun the option."
- MAINX ; Exit
- ; -- Leave latest error arrays ^TMP("DIERR",$J) & TIUIERR around until
- ; now in case modules are run separately for debugging:
- K TIUIERR,^TMP("DIERR",$J)
- ; -- Finish message array ^TMP("TIU182MSG",$J and print it:
- S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=""
- S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=" *************"
- D PRINT^TIU182D
- K ^TMP("TIU182MSG",$J),^TMP("TIU182ERR",$J),^TMP("TIU182",$J)
- Q
- TIU182DF ; SLC/MAM - Create new HP DDEFS ; 7/22/04
- +1 ;;1.0;Text Integration Utilities;**182**;Jun 20, 1997
- +2 ; Run this after installing patch 182.
- +3 ;Use option: TIU182 DDEFS, MED CONVERSION
- +4 ; External References
- +5 ; DBIA 3409 ^USR(8930,"B"
- BEGIN ; Create DDEFS
- +1 WRITE !!,"This option creates Historical Procedure Document Definitions (DDEFS) for",!,"the Medicine Package conversion."
- +2 WRITE !,"It may take one or two minutes to run. It will tell you whether or not",!,"it is successful."
- +3 WRITE !
- KILL IOP
- NEW %ZIS
- SET %ZIS="Q"
- DO ^%ZIS
- IF POP
- KILL POP
- QUIT
- +4 IF $DATA(IO("Q"))
- KILL IO("Q")
- Begin DoDot:1
- +5 SET ZTRTN="MAIN^TIUPS182"
- +6 SET ZTDESC="Create DDEFS for Medicine Conversion - TIU*1*182"
- +7 DO ^%ZTLOAD
- WRITE !,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Canceled!")
- +8 KILL ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
- +9 DO HOME^%ZIS
- End DoDot:1
- QUIT
- +10 USE IO
- DO MAIN
- DO ^%ZISC
- +11 QUIT
- +12 ;
- MAIN ; Create Historical Procedure DDEFS for Medicine Conversion
- +1 NEW TIUDUPS,TMPCNT,TIUSTTS
- +2 ; -- Set ^XTMP deletion date for about 2 years hence:
- +3 ; Set it even if all are already created, in case it's in test
- +4 ; for more than 2 years, so sites can reset it by running option.
- +5 SET ^XTMP("TIU182",0)=$$FMADD^XLFDT(DT,730)_U_DT_U_"Tracks DDEFS created by Option TIU182 DDEFS, MED CONVERSION"
- +6 KILL ^TMP("TIU182MSG",$JOB),^TMP("TIU182ERR",$JOB),^TMP("TIU182",$JOB)
- +7 ; -- Begin message array ^TMP("TIU182MSG",$J:
- +8 SET TMPCNT=0
- +9 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)="*** Historical Procedure Document Definitions for the Medicine Conversion ***"
- +10 ; -- Check if ALL done; check for Class Clinical Coord:
- +11 IF $GET(^XTMP("TIU182","DONE"))="ALL"
- Begin DoDot:1
- +12 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)="All DDEFS exported for the conversion have already been created"
- +13 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)="by option TIU182 DDEFS, MED CONVERSION."
- End DoDot:1
- GOTO MAINX
- +14 NEW CPCLASS
- SET CPCLASS=$$CLASS^TIUCP
- IF 'CPCLASS
- Begin DoDot:1
- +15 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)="I can't find Class CLINICAL PROCEDURES, exported in patch TIU*1*109."
- +16 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)="Option cannot be run without it."
- +17 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)=""
- End DoDot:1
- +18 IF $ORDER(^USR(8930,"B","CLINICAL COORDINATOR",""))=""
- Begin DoDot:1
- +19 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)="I can't find User Class CLINICAL COORDINATOR. Option cannot be run without it."
- +20 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)=""
- End DoDot:1
- +21 ; -- Set basic DDEF data into BASICS node of data array ^TMP("TIU182":
- +22 DO SETBASIC^TIUEN182
- +23 ; -- Check for potential DDEF duplicates at site:
- +24 DO TIUDUPS^TIUEN182(.TIUDUPS,1)
- +25 ; -- If potential duplicates exist, add them to message array:
- +26 IF TIUDUPS
- DO LISTDUPS^TIUEN182(.TIUDUPS,.TMPCNT,1)
- GOTO MAINX
- +27 IF $ORDER(^USR(8930,"B","CLINICAL COORDINATOR",""))=""
- GOTO MAINX
- +28 IF 'CPCLASS
- GOTO MAINX
- +29 ; -- If no potential dups, User Class exists, CLINICAL PROCEDURES
- +30 ; Class exists, go on:
- +31 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)="Environment looks OK."
- +32 ; -- Check if some DDEFS done:
- +33 IF $GET(^XTMP("TIU182","DONE"))="SOME"
- Begin DoDot:1
- +34 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)="Some of the DDEFS exported for the conversion have already been"
- +35 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)="created by this option. I will now create the others..."
- End DoDot:1
- +36 ; -- If none created yet:
- +37 IF '$DATA(^XTMP("TIU182","DONE"))
- Begin DoDot:1
- +38 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)="Creating the Document Definitions..."
- End DoDot:1
- +39 ; -- Set flds for FILE call & item data into nodes FILEDATA & DATA
- +40 ; of array ^TMP("TIU182":
- +41 DO SETDATA^TIU182D
- +42 ; -- Loop through DDEFS to create them:
- +43 NEW NUM
- +44 FOR NUM=1:1:13
- Begin DoDot:1
- +45 NEW TIUIEN,YDDEF,TIUDA,PIEN,ITEMDA
- +46 ; -- If DDEF was previously created by this option,
- +47 ; quit and get next DDEF:
- +48 SET TIUIEN=+$GET(^XTMP("TIU182",NUM,"DONE"))
- IF TIUIEN
- QUIT
- +49 ; -- If not, create new DDEF:
- +50 SET YDDEF=$$CREATE^TIU182D1(NUM)
- +51 ; -- If DDEF couldn't be created or was found by lookup
- +52 ; instead of being created, quit and get next DDEF:
- +53 IF $GET(^TMP("TIU182ERR",$JOB,NUM))="CREATE"
- QUIT
- +54 SET TIUDA=+YDDEF
- +55 ; -- Call FILE to stuff fields from ^TMP("TIU182",$J,"FILEDATA",NUM:
- +56 DO FILE^TIU182D1(NUM,TIUDA)
- +57 IF $GET(^TMP("TIU182ERR",$JOB,NUM))="FILE"
- DO DELETE^TIU182D1(TIUDA)
- QUIT
- +58 ; -- Add item to parent, stuff item data:
- +59 SET PIEN=$$PARENT^TIU182D1(NUM)
- +60 IF $GET(^TMP("TIU182ERR",$JOB,NUM))="FINDPARENT"
- DO DELETE^TIU182D1(TIUDA)
- QUIT
- +61 SET ITEMDA=+$$ADDITEM^TIU182D1(NUM,TIUDA,PIEN)
- +62 IF $GET(^TMP("TIU182ERR",$JOB,NUM))="ADDITEM"
- DO DELETE^TIU182D1(TIUDA)
- QUIT
- +63 DO FILEITEM^TIU182D1(NUM,PIEN,ITEMDA)
- +64 IF $GET(^TMP("TIU182ERR",$JOB,NUM))="FILEITEM"
- DO DELETE^TIU182D1(TIUDA,PIEN,ITEMDA)
- QUIT
- +65 ; -- DDEF NUM has been created and edited successfully:
- +66 SET ^XTMP("TIU182",NUM,"DONE")=TIUDA
- +67 SET ^XTMP("TIU182","DONE")="SOME"
- +68 QUIT
- End DoDot:1
- +69 ; -- Add results from CREATE loop to message array:
- +70 NEW NUM
- SET NUM=0
- +71 IF $ORDER(^TMP("TIU182ERR",$JOB,NUM))=""
- Begin DoDot:1
- +72 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)="All Document Definitions have now been created successfully."
- +73 SET ^XTMP("TIU182","DONE")="ALL"
- +74 ; -- Kill indiv DONE nodes:
- +75 NEW NUMBER
- FOR NUMBER=1:1:13
- KILL ^XTMP("TIU182",NUMBER)
- +76 ; -- Edit Print Form Header,delete PF Number of Class CP:
- +77 NEW FDA,TIUFPRIV
- SET FDA(8925.1,CPCLASS_",",6.1)="CLINICAL PROCEDURES"
- +78 SET FDA(8925.1,CPCLASS_",",6.12)="@"
- +79 SET TIUFPRIV=1
- +80 DO FILE^DIE("TE","FDA")
- +81 IF '$DATA(^TMP("DIERR",$JOB))
- QUIT
- +82 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)="Couldn't update CP Print Fields. See patch description or contact EVS."
- End DoDot:1
- GOTO MAINX
- +83 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)=""
- +84 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)="Problems were encountered creating the following Document Definitions:"
- +85 FOR
- SET NUM=$ORDER(^TMP("TIU182ERR",$JOB,NUM))
- IF NUM=""
- QUIT
- Begin DoDot:1
- +86 NEW PROB
- SET PROB=^TMP("TIU182ERR",$JOB,NUM)
- +87 Begin DoDot:2
- +88 IF PROB="CREATE"
- SET PROB="Couldn't create DDEF."
- QUIT
- +89 IF PROB="FILE"
- SET PROB="Couldn't file fields. DDEF deleted."
- QUIT
- +90 IF PROB="FINDPARENT"
- SET PROB="Couldn't find parent. DDEF deleted."
- QUIT
- +91 IF PROB="ADDITEM"
- SET PROB="Couldn't add DDEF to parent. DDEF deleted."
- +92 IF PROB="FILEITEM"
- SET PROB="Couldn't file Menu Text. DDEF deleted."
- End DoDot:2
- +93 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)=$SELECT(NUM=1:"Document Class ",1:"Title ")_^TMP("TIU182",$JOB,"BASICS",NUM,"NAME")_": "
- +94 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)=" "_PROB
- End DoDot:1
- +95 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)=""
- +96 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)="Please contact Enterprise VistA Support. When problems have been resolved,"
- +97 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)="come back and rerun the option."
- MAINX ; Exit
- +1 ; -- Leave latest error arrays ^TMP("DIERR",$J) & TIUIERR around until
- +2 ; now in case modules are run separately for debugging:
- +3 KILL TIUIERR,^TMP("DIERR",$JOB)
- +4 ; -- Finish message array ^TMP("TIU182MSG",$J and print it:
- +5 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)=""
- +6 SET TMPCNT=TMPCNT+1
- SET ^TMP("TIU182MSG",$JOB,TMPCNT)=" *************"
- +7 DO PRINT^TIU182D
- +8 KILL ^TMP("TIU182MSG",$JOB),^TMP("TIU182ERR",$JOB),^TMP("TIU182",$JOB)
- +9 QUIT
