source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFU5.m@ 1578

Last change on this file since 1578 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.9 KB
Line 
1IBDFU5 ;ALB/CJM - ENCOUNTER FORM (utilities) ;JAN 16,1993
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3TOPNBOT(BLOCK,TOP,BOT) ;finds the top and bottom of the block - pass TOP and BOT by reference
4 N NODE
5 S NODE=$G(^IBE(357.1,BLOCK,0))
6 S TOP=+$P(NODE,"^",4),BOT=(TOP+(+$P(NODE,"^",7)))-1
7 Q
8RUSURE(NAME) ;obtains verification from the user for deletion- returns 1 if answered YES, otherwise NO
9 ;if NAME is defined it will be used in the prompt
10 N RET
11 S RET=1
12 K DIR S DIR(0)="Y",DIR("A")=$S(NAME="":"Are you sure",1:"Are you sure "_NAME_" should be deleted"),DIR("B")="NO"
13 D ^DIR K DIR I (Y<1)!$D(DIRUT) S RET=0
14 Q RET
15PAUSE ;
16 N ANS
17 W !,$C(7),"Press RETURN to continue..." R ANS:DTIME
18 Q
19 ;
20NOGRPHCS ;sets graphics variables to "_" and "|"
21 S (IOVL,IOBLC,IOBRC)="|",(IOHL,IOTRC,IOTLC)="_"
22 Q
23 ;
24HELP1 ;displays a list of the record's fields from file 357.6, IB PACKAGE INTERFACE file - EXECUTABLE HELP FOR FIELDS IN THE DATA FIELD FILE
25 ;
26 ;INPUT - D0 is a pointer to a DATA FIELD (file 357.5)
27 ;
28 N RTN
29 Q:'$G(D0)
30 W !,"WHAT DATA SHOULD BE PRINTED IN THE SUBFIELD? CHOOSE FROM:"
31 S RTN=$P($G(^IBE(357.5,D0,0)),"^",3) Q:'RTN
32 D SHOWDATA
33 Q
34HELP2 ;displays a list of the record's fields from file 357.6, IB PACKAGE INTERFACE file - EXECUTABLE HELP FOR FIELDS IN THE SELECTION LIST FILE
35 ;
36 ;INPUT - D0 should be a pointer to a SELECTION LIST
37 ;
38 N RTN
39 W !,"WHAT DATA SHOULD BE PRINTED IN THIS SUBCOLUMN? CHOOSE FROM:"
40 Q:'$G(D0)
41 S RTN=$P($G(^IBE(357.2,D0,0)),"^",11) Q:'RTN
42 D SHOWDATA
43 W !,"You can also enter 0 if you want the item number entered in the subcolumn.",!
44 Q
45 ;
46HELP3 ;displays a list of the record's fields from file 357.6, IB PACKAGE INTERFACE file - used to display available data to the user before he enters a data field label
47 ;
48 ;INPUT - D0 is a pointer to a DATA FIELD (file 357.5)
49 N RTN
50 W !,"Available Data:"
51 Q:'$G(D0)
52 S RTN=$P($G(^IBE(357.5,D0,0)),"^",3) Q:'RTN
53 D SHOWDATA
54 Q
55 ;
56HELP4 ;displays a list of the record's fields from file 357.6, IB PACKAGE INTERFACE file - used to display to the user the available data before a subcolumn to a selection list
57 ;
58 ;INPUT - D0 should be a pointer to a SELECTION LIST
59 ;
60 N RTN
61 W !,"Available Data:"
62 Q:'$G(D0)
63 S RTN=$P($G(^IBE(357.2,D0,0)),"^",11) Q:'RTN
64 D SHOWDATA
65 Q
66HELP5 ;for number of columns in list
67 I $G(IBDEVICE("LISTMAN")) D FULL^VALM1
68 W !!,"A selection list COLUMN contains items on the list. It may consist of several",!,"subcolumns. For example, a typical column may have three subcolumns, one"
69 W !,"containing a code, the second a description, and the third a marking area for",!,"the user to indicate his selections from the list. Besides going down the",!,"form, the list can can go across the form by having multiple columns."
70 W !!,"Entering the number of columns is optional. By default the entire block will",!,"be filled with the list.",!
71 I $G(IBDEVICE("LISTMAN")) D PAUSE^IBDFU5,RE^VALM4
72 Q
73 ;
74SHOWDATA ;displays a discription of the the record returned by the package interface
75 ;
76 ;INPUT - RTN - ptr to the package interface file
77 N NODE,SUB,ROW,COL,LINE,DESCR,CANSHOW,IEN
78 S NODE=$G(^IBE(357.6,RTN,2))
79 ;
80 ;piece 1 may not be displayable (an ien)
81 S CANSHOW=$S($P(NODE,"^",17)=0:0,1:1)
82 I 'CANSHOW S NODE=""
83 ;
84 F ROW=0:1:3 S LINE="" D W:(LINE'="") !,LINE
85 .F COL=1:1:2 S SUB=COL+(2*ROW) D Q:LINE=""
86 ..S DESCR=""
87 ..I (SUB'=1) S NODE="",IEN=$O(^IBE(357.6,RTN,15,"C",SUB,0)) S:IEN NODE=$G(^IBE(357.6,RTN,15,IEN,0))
88 ..I NODE="" I (COL=1&'$D(^IBE(357.6,RTN,15,"C",SUB+1)))!((COL'=1)&(DESCR="(not applicable)")) Q
89 ..S DESCR=$P(NODE,"^") I DESCR'="" S DESCR=DESCR_" :"_$P(NODE,"^",2)_" char"
90 ..I DESCR="" S DESCR="(N/A)"
91 ..S LINE=LINE_$S(DESCR="":"",1:$$PADRIGHT^IBDFU(" "_SUB_"= "_DESCR,39))
92 Q
93 ;
94RESET ;resets the scrolling area of the screen to that defined by List Manager
95 ;I $G(IOSTBM)'="" S IOTM=IOSL-4,IOBM=IOSL W IOSC,@IOSTBM,IORC
96 Q
97VARIABLE(VAR) ;returns 0 if VAR is not syntactically a good local variable name, 1 otherwise
98 N I,LEN,CHAR,GOOD
99 S LEN=$L(VAR)
100 S CHAR=$E(VAR)
101 I '((CHAR?1A)!(CHAR="%")) Q 0
102 S GOOD=1
103 F I=2:1:LEN S CHAR=$E(VAR,I) I '((CHAR?1A)!(CHAR?1N)) S GOOD=0 Q
104 Q GOOD
105ID1 ;writes identifier for subcolumn of selection list (file 357.2)
106 N NODE,TYPE,PIECE,IEN
107 S NODE=$G(^(0)) Q:NODE=""
108 W "HEADER=",$$PADRIGHT^IBDFU($P(NODE,U,2),27)_" CONTENT="
109 I $P(NODE,U,4)=1 D
110 .S TYPE=$P($G(^IBE(357.2,D0,0)),"^",11) Q:'TYPE
111 .S PIECE=+$P(NODE,U,5)
112 .W:'PIECE "#COUNT"
113 .W:PIECE $$DATANAME^IBDFU1B(TYPE,PIECE)
114 I $P(NODE,U,4)=2 D
115 .S TYPE=$P(NODE,U,6) Q:'TYPE
116 .W $P($G(^IBE(357.91,TYPE,0)),U)
117 Q
118 ;
119DFLTS() ;returns the default form if found, 0 otherwise
120 N FORM
121 S FORM=0 F S FORM=$O(^IBE(357,"B","DEFAULTS",FORM)) Q:'FORM Q:$P($G(^IBE(357,FORM,0)),"^",7)
122 Q FORM
123 ;
124OKPIECE(PI,PIECE) ;returns 1 if the piece=PIECE is selectable for the package interface=PI, 0 otherwise
125 ;
126 I ('$G(PIECE))!('$G(PI)) Q 0
127 N QUIT S QUIT=0
128 I PIECE=1 S QUIT=$S($P($G(^IBE(357.6,PI,2)),"^",17)'=0:1,1:0)
129 I PIECE'=1 S QUIT=$D(^IBE(357.6,PI,15,"C",PIECE))
130 Q QUIT
Note: See TracBrowser for help on using the repository browser.