- XBHEDD12 ;402,DJB,10/23/91,EDD - File Characteristics
- ;;2.6;IHS UTILITIES;;JUN 28, 1993
- ;;David Bolduc - Togus, ME
- CHAR ;Identifiers, Post Selection Actions, Special Look-up Program
- I '$D(^DD(ZNUM,0,"ID")),'$D(^DD(ZNUM,0,"ACT")),'$D(^DD(ZNUM,0,"DIC")) W !?10,"No Identifiers, Post Selection Actions, or Special Look-up Program." S FLAGG=1 Q
- D INIT^XBHEDD7 G:FLAGQ EX
- W !?21,"F I L E C H A R A C T E R I S T I C S",!?20,"-----------------------------------------"
- ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- W !!?2,"1. POST SELECTION ACTION:" I $D(^DD(ZNUM,0,"ACT")) D
- .W " The following code is executed after an entry to"
- .W !?29,"this file has been selected. If Y=-1 entry will"
- .W !?29,"not be selected:"
- .W !?14,"CODE:" S STRING=^DD(ZNUM,0,"ACT") D STRING
- ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- W !!?2,"2. SPECIAL LOOK-UP PROGRAM: " I $D(^DD(ZNUM,0,"DIC")) W "^",^DD(ZNUM,0,"DIC")
- ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- W !!?2,"3. IDENTIFIERS:"
- I $D(^DD(ZNUM,0,"ID")) D NOTE,HD S XX="" F S XX=$O(^DD(ZNUM,0,"ID",XX)) Q:XX=""!FLAGQ D W !
- .W !?1,$J(XX,12),?15,$S(+XX=XX:"Yes",1:"No") S STRING=^DD(ZNUM,0,"ID",XX) D STRING
- ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- EX ;Exit
- Q
- STRING ;String=code - Prints a string in lines of 55 characters
- S LINE(1)=$E(STRING,1,55) W ?M3,LINE(1) I $Y>SIZE D PAGE Q:FLAGQ
- I $L(STRING)>55 S LINE(2)=$E(STRING,56,110) W !?M3,LINE(2) I $Y>SIZE D PAGE Q:FLAGQ
- I $L(STRING)>110 S LINE(3)=$E(STRING,111,165) W !?M3,LINE(3) I $Y>SIZE D PAGE Q:FLAGQ
- I $L(STRING)>165 S LINE(4)=$E(STRING,166,220) W !?M3,LINE(4) I $Y>SIZE D PAGE Q:FLAGQ
- I $L(STRING)>220 S LINE(5)=$E(STRING,221,275) W !?M3,LINE(5) I $Y>SIZE D PAGE Q:FLAGQ
- I $L(STRING)>275 S LINE(6)=$E(STRING,276,330) W !?M3,LINE(6) I $Y>SIZE D PAGE Q:FLAGQ
- Q
- PAGE ;
- I FLAGP,$E(IOST)="P" W @IOF,!!! D HD Q
- R !!?2,"<RETURN> to continue, ""^"" to quit, ""^^"" to exit: ",Z1:DTIME S:'$T Z1="^" I Z1["^" S FLAGQ=1 S:Z1="^^" FLAGE=1 Q
- W @IOF D HD
- Q
- NOTE ;
- W " If ASK=Yes, field is asked when a new entry is added.",!
- Q
- HD ;Heading
- W !?8,"FIELD",?15,"ASK",?(M3+10),"WRITE STATEMENT TO GENERATE DISPLAY",!?8,"-----",?15,"---",?M3,"-------------------------------------------------------"
- Q
- XBHEDD12 ;402,DJB,10/23/91,EDD - File Characteristics
- +1 ;;2.6;IHS UTILITIES;;JUN 28, 1993
- +2 ;;David Bolduc - Togus, ME
- CHAR ;Identifiers, Post Selection Actions, Special Look-up Program
- +1 IF '$DATA(^DD(ZNUM,0,"ID"))
- IF '$DATA(^DD(ZNUM,0,"ACT"))
- IF '$DATA(^DD(ZNUM,0,"DIC"))
- WRITE !?10,"No Identifiers, Post Selection Actions, or Special Look-up Program."
- SET FLAGG=1
- QUIT
- +2 DO INIT^XBHEDD7
- IF FLAGQ
- GOTO EX
- +3 WRITE !?21,"F I L E C H A R A C T E R I S T I C S",!?20,"-----------------------------------------"
- +4 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- +5 WRITE !!?2,"1. POST SELECTION ACTION:"
- IF $DATA(^DD(ZNUM,0,"ACT"))
- Begin DoDot:1
- +6 WRITE " The following code is executed after an entry to"
- +7 WRITE !?29,"this file has been selected. If Y=-1 entry will"
- +8 WRITE !?29,"not be selected:"
- +9 WRITE !?14,"CODE:"
- SET STRING=^DD(ZNUM,0,"ACT")
- DO STRING
- End DoDot:1
- +10 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- +11 WRITE !!?2,"2. SPECIAL LOOK-UP PROGRAM: "
- IF $DATA(^DD(ZNUM,0,"DIC"))
- WRITE "^",^DD(ZNUM,0,"DIC")
- +12 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- +13 WRITE !!?2,"3. IDENTIFIERS:"
- +14 IF $DATA(^DD(ZNUM,0,"ID"))
- DO NOTE
- DO HD
- SET XX=""
- FOR
- SET XX=$ORDER(^DD(ZNUM,0,"ID",XX))
- IF XX=""!FLAGQ
- QUIT
- Begin DoDot:1
- +15 WRITE !?1,$JUSTIFY(XX,12),?15,$SELECT(+XX=XX:"Yes",1:"No")
- SET STRING=^DD(ZNUM,0,"ID",XX)
- DO STRING
- End DoDot:1
- WRITE !
- +16 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- EX ;Exit
- +1 QUIT
- STRING ;String=code - Prints a string in lines of 55 characters
- +1 SET LINE(1)=$EXTRACT(STRING,1,55)
- WRITE ?M3,LINE(1)
- IF $Y>SIZE
- DO PAGE
- IF FLAGQ
- QUIT
- +2 IF $LENGTH(STRING)>55
- SET LINE(2)=$EXTRACT(STRING,56,110)
- WRITE !?M3,LINE(2)
- IF $Y>SIZE
- DO PAGE
- IF FLAGQ
- QUIT
- +3 IF $LENGTH(STRING)>110
- SET LINE(3)=$EXTRACT(STRING,111,165)
- WRITE !?M3,LINE(3)
- IF $Y>SIZE
- DO PAGE
- IF FLAGQ
- QUIT
- +4 IF $LENGTH(STRING)>165
- SET LINE(4)=$EXTRACT(STRING,166,220)
- WRITE !?M3,LINE(4)
- IF $Y>SIZE
- DO PAGE
- IF FLAGQ
- QUIT
- +5 IF $LENGTH(STRING)>220
- SET LINE(5)=$EXTRACT(STRING,221,275)
- WRITE !?M3,LINE(5)
- IF $Y>SIZE
- DO PAGE
- IF FLAGQ
- QUIT
- +6 IF $LENGTH(STRING)>275
- SET LINE(6)=$EXTRACT(STRING,276,330)
- WRITE !?M3,LINE(6)
- IF $Y>SIZE
- DO PAGE
- IF FLAGQ
- QUIT
- +7 QUIT
- PAGE ;
- +1 IF FLAGP
- IF $EXTRACT(IOST)="P"
- WRITE @IOF,!!!
- DO HD
- QUIT
- +2 READ !!?2,"<RETURN> to continue, ""^"" to quit, ""^^"" to exit: ",Z1:DTIME
- IF '$TEST
- SET Z1="^"
- IF Z1["^"
- SET FLAGQ=1
- IF Z1="^^"
- SET FLAGE=1
- QUIT
- +3 WRITE @IOF
- DO HD
- +4 QUIT
- NOTE ;
- +1 WRITE " If ASK=Yes, field is asked when a new entry is added.",!
- +2 QUIT
- HD ;Heading
- +1 WRITE !?8,"FIELD",?15,"ASK",?(M3+10),"WRITE STATEMENT TO GENERATE DISPLAY",!?8,"-----",?15,"---",?M3,"-------------------------------------------------------"
- +2 QUIT
