source: IHS-VA_UTILITIES-XB/XBHEDD12.m@ 641

Last change on this file since 641 was 641, checked in by Sam Habiel, 15 years ago

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.

File size: 2.3 KB
Line 
1XBHEDD12 ;402,DJB,10/23/91,EDD - File Characteristics
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;;David Bolduc - Togus, ME
4CHAR ;Identifiers, Post Selection Actions, Special Look-up Program
5 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
6 D INIT^XBHEDD7 G:FLAGQ EX
7 W !?21,"F I L E C H A R A C T E R I S T I C S",!?20,"-----------------------------------------"
8 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
9 W !!?2,"1. POST SELECTION ACTION:" I $D(^DD(ZNUM,0,"ACT")) D
10 .W " The following code is executed after an entry to"
11 .W !?29,"this file has been selected. If Y=-1 entry will"
12 .W !?29,"not be selected:"
13 .W !?14,"CODE:" S STRING=^DD(ZNUM,0,"ACT") D STRING
14 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
15 W !!?2,"2. SPECIAL LOOK-UP PROGRAM: " I $D(^DD(ZNUM,0,"DIC")) W "^",^DD(ZNUM,0,"DIC")
16 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
17 W !!?2,"3. IDENTIFIERS:"
18 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 !
19 .W !?1,$J(XX,12),?15,$S(+XX=XX:"Yes",1:"No") S STRING=^DD(ZNUM,0,"ID",XX) D STRING
20 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
21EX ;Exit
22 Q
23STRING ;String=code - Prints a string in lines of 55 characters
24 S LINE(1)=$E(STRING,1,55) W ?M3,LINE(1) I $Y>SIZE D PAGE Q:FLAGQ
25 I $L(STRING)>55 S LINE(2)=$E(STRING,56,110) W !?M3,LINE(2) I $Y>SIZE D PAGE Q:FLAGQ
26 I $L(STRING)>110 S LINE(3)=$E(STRING,111,165) W !?M3,LINE(3) I $Y>SIZE D PAGE Q:FLAGQ
27 I $L(STRING)>165 S LINE(4)=$E(STRING,166,220) W !?M3,LINE(4) I $Y>SIZE D PAGE Q:FLAGQ
28 I $L(STRING)>220 S LINE(5)=$E(STRING,221,275) W !?M3,LINE(5) I $Y>SIZE D PAGE Q:FLAGQ
29 I $L(STRING)>275 S LINE(6)=$E(STRING,276,330) W !?M3,LINE(6) I $Y>SIZE D PAGE Q:FLAGQ
30 Q
31PAGE ;
32 I FLAGP,$E(IOST)="P" W @IOF,!!! D HD Q
33 R !!?2,"<RETURN> to continue, ""^"" to quit, ""^^"" to exit: ",Z1:DTIME S:'$T Z1="^" I Z1["^" S FLAGQ=1 S:Z1="^^" FLAGE=1 Q
34 W @IOF D HD
35 Q
36NOTE ;
37 W " If ASK=Yes, field is asked when a new entry is added.",!
38 Q
39HD ;Heading
40 W !?8,"FIELD",?15,"ASK",?(M3+10),"WRITE STATEMENT TO GENERATE DISPLAY",!?8,"-----",?15,"---",?M3,"-------------------------------------------------------"
41 Q
Note: See TracBrowser for help on using the repository browser.