- TIUFHLP ; SLC/MAM,JER - On-line help library: HELP ;4/23/97 11:19
- ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
- ;
- HELP ; Action Help for TIUF Document Definition Templates A, C, H, J,T,D,X
- N TIUX,ORU,ORUPRMT,VALMDDF,VALMPGE,CREATE,DTOUT,DIRUT,DIROUT
- S TIUX=$$UPPER^TIULS(X),CREATE=$G(TIUFCBEG)
- S VALMBCK="R",VALMSG=$$VMSG^TIUFL
- D ONE:TIUX="?NEW",ONE:TIUX="?",TWO:TIUX="??",THREE:TIUX="???"
- HELPX I $D(DTOUT) S VALMBCK="Q"
- Q
- ;
- ONE ; Help for One ?.
- ;Requires CREATE
- I TIUX="?NEW" W !?3 D FULL^VALM1,ITEM(^TMP("TIUF",$J,"NEWHELP")) D Q ;Option Create
- . W !," Enter ? for Help"
- . W !," Enter ?? for detailed help on actions including PRINTING"
- . W !," Enter ??? for detailed help on display"
- . D PAUSE^TIUFXHLX
- I TIUFTMPL="C",'$D(TIUFSTMP) W !,TIUFCMSG(1),!,TIUFCMSG(2),! W:$D(TIUFCMSG(3)) TIUFCMSG(3),! D PAUSE^TIUFXHLX Q:$D(DIRUT)
- D DISP^XQORM1 D PAUSE^TIUFXHLX Q:$D(DIRUT)
- W !!," Type action name from Action List. Example: Type 'D' or 'DET' for Detailed",!,"Display. There are also 'Hidden Actions' which don't show on the Action List",!,"such as PL Print List."
- W " Enter ?? to see hidden actions, and for",!,"descriptions of actions."
- D PAUSE^TIUFXHLX Q:$D(DIRUT)
- W !," Action and Entry Number can be selected in a single step. Examples: To see a",!,"Detailed Display of Entry 3, enter 'DET=3'. To scroll to the extreme right,",!,"enter '>=>'.",!
- D PAUSE^TIUFXHLX Q:$D(DIRUT)
- I ("HACJ"[TIUFTMPL&'$D(TIUFSTMP))!($G(TIUFSTMP)="T") D Q:$D(DIRUT)
- . W !!,"To see more columns of essential information, enter '>' to scroll to the right",!,"whenever >>> shows on the highlighted message bar. Enter '<' to scroll left.",!!
- . D PAUSE^TIUFXHLX
- W !," Enter ? for Help"
- W !," Enter ?? for detailed help on actions including PRINTING"
- W !," Enter ??? for detailed help on display",!
- I TIUFTMPL="C" W " Enter '?NEW' for New User Help"
- D PAUSE^TIUFXHLX Q:$D(DIRUT)
- W !," When editing a field (as opposed to Selecting an Action), ? will give you one"
- W !,"line of help on the field. ?? will give you a complete description of the"
- W !,"field and how it works.",!
- D PAUSE^TIUFXHLX
- Q
- ;
- TWO ; Help for ??
- D FULL^VALM1,CLEAR^VALM1
- W !!,$$CENTER^TIUFL("Help on Listed Actions",80),!!
- W !,"Actions are not selectable when they are enclosed in parentheses.",!!
- K DIRUT D MENU(XQORNOD) Q:$D(DIRUT)
- W !!,$$CENTER^TIUFL("Help on Hidden Actions including PRINTING",80),!!
- D MENU(^TMP("TIUF",$J,"HIDDEN"))
- Q
- ;
- THREE ; Help for ???
- D FULL^VALM1,CLEAR^VALM1
- I "HACJ"[TIUFTMPL,'$D(TIUFSTMP) D BASINFD
- I $G(TIUFSTMP)="T" D ITEMINFD
- I $G(TIUFSTMP)="D" D EDITVW^TIUFHLP1
- I $G(TIUFSTMP)="X" D BOILTX^TIUFHLP1
- Q
- ;
- BASINFD ; Write Field Description for Basic Info Fields
- N TIUI,FLDNM,FLDNO,MSG,HERE
- W !,$$CENTER^TIUFL("Help on Display",80),! K DIROUT
- F FLDNO=.01,.04,.1,.13,.07,.05,.06,.08,.12,.03,.11 D Q:$D(DIROUT)
- . I $G(TIUFTMPL)="J",(FLDNO=.1)!(FLDNO=.08)!(FLDNO=.12)!(FLDNO=.11) Q
- . S FLDNM=$P(^TMP("TIUF",$J,FLDNO,"LABEL"),U)
- . K DIRUT W:$$CONTINUE !?1,$G(IOINHI),FLDNM,$G(IOINORM),! Q:$D(DIRUT)
- . I FLDNO=.01,TIUFTMPL="H",'$D(TIUFSTMP) W !," Plus (+) indicates entry has Items under it and can be expanded.",!!
- . D HELP^DIE(8925.1,"",FLDNO,"D")
- . S HERE=1 I $G(TIUFTMPL)="J",(FLDNO=.04)!(FLDNO=.07)!(FLDNO=.01) S HERE=0
- . F TIUI=1:1:DIHELP S MSG=^TMP("DIHELP",$J,TIUI) K DIRUT D Q:$D(DIRUT)
- . . I FLDNO=.04,$G(TIUFTMPL)="J",MSG["O OBJECT" S HERE=1
- . . I FLDNO=.07,$G(TIUFTMPL)="J",MSG["OBJECT STATUS",MSG'["OBJECT STATUS," S HERE=1
- . . I FLDNO=.01,$G(TIUFTMPL)="J",MSG["OBJECT Name" S HERE=1
- . . W:HERE&$$CONTINUE ?3,MSG,!
- D CLEAN^DILF
- Q
- ;
- ITEMINFD ; Write Field Description for Item Fields
- N TIUI,FLDNM,FLDNO,MSG
- W !,$$CENTER^TIUFL("Help on Display",80),! K DIROUT
- F FLDNO=10 D Q:$D(DIROUT)
- . S FLDNM=^TMP("TIUF",$J,FLDNO,"LABEL")
- . K DIRUT W:$$CONTINUE !?1,$G(IOINHI),FLDNM,$G(IOINORM),! Q:$D(DIRUT)
- . D HELP^DIE(8925.1,"",FLDNO,"D")
- . F TIUI=1:1:DIHELP S MSG=^TMP("DIHELP",$J,TIUI) K DIRUT D Q:$D(DIRUT)
- . . W:$$CONTINUE ?3,MSG,!
- K DIROUT F FLDNO=2:1:4 D Q:$D(DIROUT)
- . S FLDNM=^TMP("TIUF",$J,10,FLDNO,"LABEL")
- . K DIRUT W:$$CONTINUE !?1,$G(IOINHI),FLDNM,$G(IOINORM),! Q:$D(DIRUT)
- . D HELP^DIE(8925.14,"",FLDNO,"D")
- . F TIUI=1:1:DIHELP S MSG=^TMP("DIHELP",$J,TIUI) K DIRUT D Q:$D(DIRUT)
- . . W:$$CONTINUE ?3,MSG,!
- D CLEAN^DILF
- Q
- ;
- N TIUSEQ,TIUI,TIUJ
- K DIRUT W:$$CONTINUE "The following actions are available:",! Q:$D(DIRUT)
- S TIUI=0 F S TIUI=$O(^ORD(101,+XQORNOD,10,TIUI)) Q:+TIUI'>0 K DIRUT D Q:$D(DIRUT)
- . S TIUJ=+$P($G(^ORD(101,+XQORNOD,10,TIUI,0)),U,3) S:$D(TIUSEQ(TIUJ)) TIUJ=TIUJ+.1
- . S TIUSEQ(TIUJ)=+$P(^ORD(101,+XQORNOD,10,TIUI,0),U)
- S TIUI=0 F S TIUI=$O(TIUSEQ(TIUI)) Q:+TIUI'>0 K DIRUT D Q:$D(DIRUT)
- . I $D(^ORD(101,+TIUSEQ(TIUI),0)) D ITEM(+TIUSEQ(TIUI))
- Q
- ITEM(XQORNOD) ; Show descriptions of protocol menu actions
- N TIUI,TMPQUIT,HERE
- Q:$P($G(^ORD(101,+XQORNOD,0)),U,2)']""
- I $G(TIUFTMPL)="J",$G(TIUFSTMP)="D",(^ORD(101,+XQORNOD,0)["Items")!(^ORD(101,+XQORNOD,0)["Boil")!(^ORD(101,+XQORNOD,0)["Upload") Q
- I $G(TIUFSTMP)="T",^ORD(101,+XQORNOD,0)["Try" Q
- Q:XQORNOD=^TMP("TIUF",$J,"STOP") ;protocol TIUF QUIT1 in hidden actions - dummy to allow user to enter QU
- ; ?NEW for create is contained in protocol TIUFC ACTION MENU; don't write the name of the protocol:
- ; Note on heritable fields is contained in protocol TIUFD ACTION MENU MGR; don't write the name of the protocol:
- I XQORNOD'=^TMP("TIUF",$J,"NEWHELP"),XQORNOD'=^TMP("TIUF",$J,"INHERIT") K DIRUT W:$$CONTINUE ?1,$G(IOINHI),$$UPPER^TIULS($P($G(^ORD(101,+XQORNOD,0)),U,2)),$G(IOINORM),! Q:$D(DIRUT)
- S HERE=1 I $G(TIUFTMPL)="J",$G(^ORD(101,+XQORNOD,0))["Delete" S HERE=0
- S TIUI=0 F S TIUI=$O(^ORD(101,+XQORNOD,1,TIUI)) Q:+TIUI'>0 K DIRUT D Q:$D(DIRUT)
- . S LINE=$G(^ORD(101,+XQORNOD,1,TIUI,0))
- . Q:'$$CONTINUE
- . I 'HERE,LINE["OBJECT DELETE" S HERE=1
- . I 'HERE Q
- . ; ?NEW for create, note on heritable: first 2 lines aren't relevant:
- . I XQORNOD=^TMP("TIUF",$J,"NEWHELP")!(XQORNOD=^TMP("TIUF",$J,"INHERIT")),TIUI<3 Q
- . ;protocol description is written in 2 parts, first for clinicians, second for managers. Display appropriate part:
- . I TIUFWHO="C" D
- . . Q:LINE["CLINICIAN OPTIONS"
- . . I LINE'["MANAGER OPTIONS" W ?3,$G(^ORD(101,+XQORNOD,1,TIUI,0)),! Q
- . . S TIUI=5000
- . I "NM"[TIUFWHO D
- . . I LINE["CLINICIAN OPTIONS" S TMPQUIT=1 Q
- . . I LINE["MANAGER OPTIONS" S TMPQUIT=0 Q
- . . Q:$G(TMPQUIT)
- . . W ?3,$G(^ORD(101,+XQORNOD,1,TIUI,0)),!
- Q:XQORNOD=^TMP("TIUF",$J,"NEWHELP") ;don't show items of TIUFC ACTION MENU
- Q:XQORNOD=^TMP("TIUF",$J,"INHERIT") ;don't show items of TIUFD ACTION MENU MGR
- S TIUI=0 F S TIUI=$O(^ORD(101,+XQORNOD,10,TIUI)) Q:+TIUI'>0 K DIRUT D Q:$D(DIRUT)
- . D ITEM(+$G(^ORD(101,+XQORNOD,10,+TIUI,0))_";ORD(101,")
- Q
- CONTINUE() ; Pagination control
- N Y K DIRUT
- I $Y<(IOSL-2) S Y=1 G CONTX
- S Y=$$BOTTM W @IOF,!
- CONTX Q Y
- ;
- BOTTM() ; Call DIR at bottom of screen
- N DIR,X,Y
- I $E(IOST)'="C" S Y=1 G BOTTX
- I (IOSL>($Y+5)) F W ! Q:IOSL<($Y+6)
- S DIR(0)="FO^1:1",DIR("A")="Press RETURN to continue or '^' or '^^' to exit"
- S DIR("?")="Enter '^' to quit present section or '^^' to quit to menu"
- D ^DIR I $D(DIRUT),(Y="") K DIRUT
- S Y=$S(Y="^"!(Y="^^"):Y,$D(DTOUT):"",1:1)
- BOTTX Q Y
- TIUFHLP ; SLC/MAM,JER - On-line help library: HELP ;4/23/97 11:19
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
- +2 ;
- HELP ; Action Help for TIUF Document Definition Templates A, C, H, J,T,D,X
- +1 NEW TIUX,ORU,ORUPRMT,VALMDDF,VALMPGE,CREATE,DTOUT,DIRUT,DIROUT
- +2 SET TIUX=$$UPPER^TIULS(X)
- SET CREATE=$GET(TIUFCBEG)
- +3 SET VALMBCK="R"
- SET VALMSG=$$VMSG^TIUFL
- +4 IF TIUX="?NEW"
- DO ONE
- IF TIUX="?"
- DO ONE
- IF TIUX="??"
- DO TWO
- IF TIUX="???"
- DO THREE
- HELPX IF $DATA(DTOUT)
- SET VALMBCK="Q"
- +1 QUIT
- +2 ;
- ONE ; Help for One ?.
- +1 ;Requires CREATE
- +2 ;Option Create
- IF TIUX="?NEW"
- WRITE !?3
- DO FULL^VALM1
- DO ITEM(^TMP("TIUF",$JOB,"NEWHELP"))
- Begin DoDot:1
- +3 WRITE !," Enter ? for Help"
- +4 WRITE !," Enter ?? for detailed help on actions including PRINTING"
- +5 WRITE !," Enter ??? for detailed help on display"
- +6 DO PAUSE^TIUFXHLX
- End DoDot:1
- QUIT
- +7 IF TIUFTMPL="C"
- IF '$DATA(TIUFSTMP)
- WRITE !,TIUFCMSG(1),!,TIUFCMSG(2),!
- IF $DATA(TIUFCMSG(3))
- WRITE TIUFCMSG(3),!
- DO PAUSE^TIUFXHLX
- IF $DATA(DIRUT)
- QUIT
- +8 DO DISP^XQORM1
- DO PAUSE^TIUFXHLX
- IF $DATA(DIRUT)
- QUIT
- +9 WRITE !!," Type action name from Action List. Example: Type 'D' or 'DET' for Detailed",!,"Display. There are also 'Hidden Actions' which don't show on the Action List",!,"such as PL Print List."
- +10 WRITE " Enter ?? to see hidden actions, and for",!,"descriptions of actions."
- +11 DO PAUSE^TIUFXHLX
- IF $DATA(DIRUT)
- QUIT
- +12 WRITE !," Action and Entry Number can be selected in a single step. Examples: To see a",!,"Detailed Display of Entry 3, enter 'DET=3'. To scroll to the extreme right,",!,"enter '>=>'.",!
- +13 DO PAUSE^TIUFXHLX
- IF $DATA(DIRUT)
- QUIT
- +14 IF ("HACJ"[TIUFTMPL&'$DATA(TIUFSTMP))!($GET(TIUFSTMP)="T")
- Begin DoDot:1
- +15 WRITE !!,"To see more columns of essential information, enter '>' to scroll to the right",!,"whenever >>> shows on the highlighted message bar. Enter '<' to scroll left.",!!
- +16 DO PAUSE^TIUFXHLX
- End DoDot:1
- IF $DATA(DIRUT)
- QUIT
- +17 WRITE !," Enter ? for Help"
- +18 WRITE !," Enter ?? for detailed help on actions including PRINTING"
- +19 WRITE !," Enter ??? for detailed help on display",!
- +20 IF TIUFTMPL="C"
- WRITE " Enter '?NEW' for New User Help"
- +21 DO PAUSE^TIUFXHLX
- IF $DATA(DIRUT)
- QUIT
- +22 WRITE !," When editing a field (as opposed to Selecting an Action), ? will give you one"
- +23 WRITE !,"line of help on the field. ?? will give you a complete description of the"
- +24 WRITE !,"field and how it works.",!
- +25 DO PAUSE^TIUFXHLX
- +26 QUIT
- +27 ;
- TWO ; Help for ??
- +1 DO FULL^VALM1
- DO CLEAR^VALM1
- +2 WRITE !!,$$CENTER^TIUFL("Help on Listed Actions",80),!!
- +3 WRITE !,"Actions are not selectable when they are enclosed in parentheses.",!!
- +4 KILL DIRUT
- DO MENU(XQORNOD)
- IF $DATA(DIRUT)
- QUIT
- +5 WRITE !!,$$CENTER^TIUFL("Help on Hidden Actions including PRINTING",80),!!
- +6 DO MENU(^TMP("TIUF",$JOB,"HIDDEN"))
- +7 QUIT
- +8 ;
- THREE ; Help for ???
- +1 DO FULL^VALM1
- DO CLEAR^VALM1
- +2 IF "HACJ"[TIUFTMPL
- IF '$DATA(TIUFSTMP)
- DO BASINFD
- +3 IF $GET(TIUFSTMP)="T"
- DO ITEMINFD
- +4 IF $GET(TIUFSTMP)="D"
- DO EDITVW^TIUFHLP1
- +5 IF $GET(TIUFSTMP)="X"
- DO BOILTX^TIUFHLP1
- +6 QUIT
- +7 ;
- BASINFD ; Write Field Description for Basic Info Fields
- +1 NEW TIUI,FLDNM,FLDNO,MSG,HERE
- +2 WRITE !,$$CENTER^TIUFL("Help on Display",80),!
- KILL DIROUT
- +3 FOR FLDNO=.01,.04,.1,.13,.07,.05,.06,.08,.12,.03,.11
- Begin DoDot:1
- +4 IF $GET(TIUFTMPL)="J"
- IF (FLDNO=.1)!(FLDNO=.08)!(FLDNO=.12)!(FLDNO=.11)
- QUIT
- +5 SET FLDNM=$PIECE(^TMP("TIUF",$JOB,FLDNO,"LABEL"),U)
- +6 KILL DIRUT
- IF $$CONTINUE
- WRITE !?1,$GET(IOINHI),FLDNM,$GET(IOINORM),!
- IF $DATA(DIRUT)
- QUIT
- +7 IF FLDNO=.01
- IF TIUFTMPL="H"
- IF '$DATA(TIUFSTMP)
- WRITE !," Plus (+) indicates entry has Items under it and can be expanded.",!!
- +8 DO HELP^DIE(8925.1,"",FLDNO,"D")
- +9 SET HERE=1
- IF $GET(TIUFTMPL)="J"
- IF (FLDNO=.04)!(FLDNO=.07)!(FLDNO=.01)
- SET HERE=0
- +10 FOR TIUI=1:1:DIHELP
- SET MSG=^TMP("DIHELP",$JOB,TIUI)
- KILL DIRUT
- Begin DoDot:2
- +11 IF FLDNO=.04
- IF $GET(TIUFTMPL)="J"
- IF MSG["O OBJECT"
- SET HERE=1
- +12 IF FLDNO=.07
- IF $GET(TIUFTMPL)="J"
- IF MSG["OBJECT STATUS"
- IF MSG'["OBJECT STATUS,"
- SET HERE=1
- +13 IF FLDNO=.01
- IF $GET(TIUFTMPL)="J"
- IF MSG["OBJECT Name"
- SET HERE=1
- +14 IF HERE&$$CONTINUE
- WRITE ?3,MSG,!
- End DoDot:2
- IF $DATA(DIRUT)
- QUIT
- End DoDot:1
- IF $DATA(DIROUT)
- QUIT
- +15 DO CLEAN^DILF
- +16 QUIT
- +17 ;
- ITEMINFD ; Write Field Description for Item Fields
- +1 NEW TIUI,FLDNM,FLDNO,MSG
- +2 WRITE !,$$CENTER^TIUFL("Help on Display",80),!
- KILL DIROUT
- +3 FOR FLDNO=10
- Begin DoDot:1
- +4 SET FLDNM=^TMP("TIUF",$JOB,FLDNO,"LABEL")
- +5 KILL DIRUT
- IF $$CONTINUE
- WRITE !?1,$GET(IOINHI),FLDNM,$GET(IOINORM),!
- IF $DATA(DIRUT)
- QUIT
- +6 DO HELP^DIE(8925.1,"",FLDNO,"D")
- +7 FOR TIUI=1:1:DIHELP
- SET MSG=^TMP("DIHELP",$JOB,TIUI)
- KILL DIRUT
- Begin DoDot:2
- +8 IF $$CONTINUE
- WRITE ?3,MSG,!
- End DoDot:2
- IF $DATA(DIRUT)
- QUIT
- End DoDot:1
- IF $DATA(DIROUT)
- QUIT
- +9 KILL DIROUT
- FOR FLDNO=2:1:4
- Begin DoDot:1
- +10 SET FLDNM=^TMP("TIUF",$JOB,10,FLDNO,"LABEL")
- +11 KILL DIRUT
- IF $$CONTINUE
- WRITE !?1,$GET(IOINHI),FLDNM,$GET(IOINORM),!
- IF $DATA(DIRUT)
- QUIT
- +12 DO HELP^DIE(8925.14,"",FLDNO,"D")
- +13 FOR TIUI=1:1:DIHELP
- SET MSG=^TMP("DIHELP",$JOB,TIUI)
- KILL DIRUT
- Begin DoDot:2
- +14 IF $$CONTINUE
- WRITE ?3,MSG,!
- End DoDot:2
- IF $DATA(DIRUT)
- QUIT
- End DoDot:1
- IF $DATA(DIROUT)
- QUIT
- +15 DO CLEAN^DILF
- +16 QUIT
- +17 ;
- +1 NEW TIUSEQ,TIUI,TIUJ
- +2 KILL DIRUT
- IF $$CONTINUE
- WRITE "The following actions are available:",!
- IF $DATA(DIRUT)
- QUIT
- +3 SET TIUI=0
- FOR
- SET TIUI=$ORDER(^ORD(101,+XQORNOD,10,TIUI))
- IF +TIUI'>0
- QUIT
- KILL DIRUT
- Begin DoDot:1
- +4 SET TIUJ=+$PIECE($GET(^ORD(101,+XQORNOD,10,TIUI,0)),U,3)
- IF $DATA(TIUSEQ(TIUJ))
- SET TIUJ=TIUJ+.1
- +5 SET TIUSEQ(TIUJ)=+$PIECE(^ORD(101,+XQORNOD,10,TIUI,0),U)
- End DoDot:1
- IF $DATA(DIRUT)
- QUIT
- +6 SET TIUI=0
- FOR
- SET TIUI=$ORDER(TIUSEQ(TIUI))
- IF +TIUI'>0
- QUIT
- KILL DIRUT
- Begin DoDot:1
- +7 IF $DATA(^ORD(101,+TIUSEQ(TIUI),0))
- DO ITEM(+TIUSEQ(TIUI))
- End DoDot:1
- IF $DATA(DIRUT)
- QUIT
- +8 QUIT
- ITEM(XQORNOD) ; Show descriptions of protocol menu actions
- +1 NEW TIUI,TMPQUIT,HERE
- +2 IF $PIECE($GET(^ORD(101,+XQORNOD,0)),U,2)']""
- QUIT
- +3 IF $GET(TIUFTMPL)="J"
- IF $GET(TIUFSTMP)="D"
- IF (^ORD(101,+XQORNOD,0)["Items")!(^ORD(101,+XQORNOD,0)["Boil")!(^ORD(101,+XQORNOD,0)["Upload")
- QUIT
- +4 IF $GET(TIUFSTMP)="T"
- IF ^ORD(101,+XQORNOD,0)["Try"
- QUIT
- +5 ;protocol TIUF QUIT1 in hidden actions - dummy to allow user to enter QU
- IF XQORNOD=^TMP("TIUF",$JOB,"STOP")
- QUIT
- +6 ; ?NEW for create is contained in protocol TIUFC ACTION MENU; don't write the name of the protocol:
- +7 ; Note on heritable fields is contained in protocol TIUFD ACTION MENU MGR; don't write the name of the protocol:
- +8 IF XQORNOD'=^TMP("TIUF",$JOB,"NEWHELP")
- IF XQORNOD'=^TMP("TIUF",$JOB,"INHERIT")
- KILL DIRUT
- IF $$CONTINUE
- WRITE ?1,$GET(IOINHI),$$UPPER^TIULS($PIECE($GET(^ORD(101,+XQORNOD,0)),U,2)),$GET(IOINORM),!
- IF $DATA(DIRUT)
- QUIT
- +9 SET HERE=1
- IF $GET(TIUFTMPL)="J"
- IF $GET(^ORD(101,+XQORNOD,0))["Delete"
- SET HERE=0
- +10 SET TIUI=0
- FOR
- SET TIUI=$ORDER(^ORD(101,+XQORNOD,1,TIUI))
- IF +TIUI'>0
- QUIT
- KILL DIRUT
- Begin DoDot:1
- +11 SET LINE=$GET(^ORD(101,+XQORNOD,1,TIUI,0))
- +12 IF '$$CONTINUE
- QUIT
- +13 IF 'HERE
- IF LINE["OBJECT DELETE"
- SET HERE=1
- +14 IF 'HERE
- QUIT
- +15 ; ?NEW for create, note on heritable: first 2 lines aren't relevant:
- +16 IF XQORNOD=^TMP("TIUF",$JOB,"NEWHELP")!(XQORNOD=^TMP("TIUF",$JOB,"INHERIT"))
- IF TIUI<3
- QUIT
- +17 ;protocol description is written in 2 parts, first for clinicians, second for managers. Display appropriate part:
- +18 IF TIUFWHO="C"
- Begin DoDot:2
- +19 IF LINE["CLINICIAN OPTIONS"
- QUIT
- +20 IF LINE'["MANAGER OPTIONS"
- WRITE ?3,$GET(^ORD(101,+XQORNOD,1,TIUI,0)),!
- QUIT
- +21 SET TIUI=5000
- End DoDot:2
- +22 IF "NM"[TIUFWHO
- Begin DoDot:2
- +23 IF LINE["CLINICIAN OPTIONS"
- SET TMPQUIT=1
- QUIT
- +24 IF LINE["MANAGER OPTIONS"
- SET TMPQUIT=0
- QUIT
- +25 IF $GET(TMPQUIT)
- QUIT
- +26 WRITE ?3,$GET(^ORD(101,+XQORNOD,1,TIUI,0)),!
- End DoDot:2
- End DoDot:1
- IF $DATA(DIRUT)
- QUIT
- +27 ;don't show items of TIUFC ACTION MENU
- IF XQORNOD=^TMP("TIUF",$JOB,"NEWHELP")
- QUIT
- +28 ;don't show items of TIUFD ACTION MENU MGR
- IF XQORNOD=^TMP("TIUF",$JOB,"INHERIT")
- QUIT
- +29 SET TIUI=0
- FOR
- SET TIUI=$ORDER(^ORD(101,+XQORNOD,10,TIUI))
- IF +TIUI'>0
- QUIT
- KILL DIRUT
- Begin DoDot:1
- +30 DO ITEM(+$GET(^ORD(101,+XQORNOD,10,+TIUI,0))_";ORD(101,")
- End DoDot:1
- IF $DATA(DIRUT)
- QUIT
- +31 QUIT
- CONTINUE() ; Pagination control
- +1 NEW Y
- KILL DIRUT
- +2 IF $Y<(IOSL-2)
- SET Y=1
- GOTO CONTX
- +3 SET Y=$$BOTTM
- WRITE @IOF,!
- CONTX QUIT Y
- +1 ;
- BOTTM() ; Call DIR at bottom of screen
- +1 NEW DIR,X,Y
- +2 IF $EXTRACT(IOST)'="C"
- SET Y=1
- GOTO BOTTX
- +3 IF (IOSL>($Y+5))
- FOR
- WRITE !
- IF IOSL<($Y+6)
- QUIT
- +4 SET DIR(0)="FO^1:1"
- SET DIR("A")="Press RETURN to continue or '^' or '^^' to exit"
- +5 SET DIR("?")="Enter '^' to quit present section or '^^' to quit to menu"
- +6 DO ^DIR
- IF $DATA(DIRUT)
- IF (Y="")
- KILL DIRUT
- +7 SET Y=$SELECT(Y="^"!(Y="^^"):Y,$DATA(DTOUT):"",1:1)
- BOTTX QUIT Y
