source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF9B1.m@ 1582

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

initial load of FOIAVistA 6/30/08 version

File size: 4.7 KB
Line 
1IBDF9B1 ;ALB/CJM - ENCOUNTER FORM - (report data fields) ;APRIL 22,1993
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4REPORT ;
5 N TOP,BOTTOM,LEFT,RIGHT,QUIT,SCRNSIZE
6 S QUIT=0,SCRNSIZE=4
7 D RANGE
8 D:'QUIT SEARCH(TOP,BOTTOM,LEFT,RIGHT)
9 Q
10RANGE ;asks the user for the range - returns TOP,BOTTOM,LEFT,RIGHT
11 N I,HT,WIDTH
12 S HT=IBBLK("H"),WIDTH=IBBLK("W")
13 K DIR
14 ;get TOP
15 S DIR("A")="What is the top-most row to report on?"
16 S DIR(0)="N^1:"_HT_":0",DIR("B")=1
17 D ^DIR K DIR I (Y=-1)!$D(DIRUT) S QUIT=1 Q
18 S TOP=Y
19 ;now get BOTTOM
20 S DIR("A")="What is the bottom-most row to report on? (optional)",DIR("?",1)="Enter the lowest row that you want to report on.",DIR("?")="Enter nothing to report all data fields below the highest row that you specified."
21 K DIR("B") ;S DIR("B")=HT
22 S DIR(0)="NO^"_TOP_":"_HT_":0"
23 D ^DIR K DIR I (Y=-1)!$D(DTOUT)!$D(DUOUT) S QUIT=1 Q
24 S BOTTOM=Y
25 ;get LEFT
26 S DIR("A")="What is the left-most column to report on?"
27 S DIR(0)="N^1:"_WIDTH_":0",DIR("B")=1
28 D ^DIR K DIR I (Y=-1)!$D(DIRUT) S QUIT=1 Q
29 S LEFT=Y
30 ;now get RIGHT
31 S DIR("A")="What is the right-most column to report on? (optional)"
32 S DIR("?",1)="Enter the right-most column that you want to report on.",DIR("?")="Enter nothing to report all data fields to the right of the left-most column that you specified."
33 K DIR("B") ;S DIR("B")=WIDTH
34 S DIR(0)="NO^"_LEFT_":"_WIDTH_":0"
35 D ^DIR K DIR I (Y=-1)!$D(DTOUT)!$D(DUOUT) S QUIT=1 Q
36 S RIGHT=Y
37 ;now change TOP,BOTTOM,LEFT,RIGHT to their internal values
38 ;(BOTTOM or RIGHT)="" has special meaning - means shift without limit
39 S TOP=TOP-1,LEFT=LEFT-1
40 S:BOTTOM>0 BOTTOM=BOTTOM-1
41 S:RIGHT>0 RIGHT=RIGHT-1
42 Q
43SEARCH(TOP,BOTTOM,LEFT,RIGHT) ;searches for data fields in IBBLK falling within the rectangle defined by TOP,BOTTOM,LEFT,RIGHT and reports on them
44 N SUBFLD,IBX,IBY,FLD,QUIT,ARY,RTN,WP,LIST,CNT,NODE,COUNT
45 S ARY="^TMP(""IBDF"",$J,""LIST OF DATA FIELDS"")"
46 K @ARY
47 S (COUNT,QUIT)=0
48 S FLD="" F S FLD=$O(^IBE(357.5,"C",IBBLK,FLD)) Q:QUIT!('FLD) D
49 .S FLD("NODE0")=$G(^IBE(357.5,FLD,0))
50 .Q:FLD("NODE0")=""
51 .S FLD("NAME")=$P(FLD("NODE0"),"^")
52 .S FLD("MULTIPLE SF")="NO"
53 .S (SUBFLD,CNT)=0 F S SUBFLD=$O(^IBE(357.5,FLD,2,SUBFLD)) Q:'SUBFLD S NODE=$G(^IBE(357.5,FLD,2,SUBFLD,0)) I $P(NODE,"^",9),$P(NODE,"^",8) S CNT=CNT+1 I CNT>1 S FLD("MULTIPLE SF")="YES" Q
54 .Q:$P(FLD("NODE0"),"^",2)'=IBBLK
55 .D RTNDESCR
56 .I WP S IBX=+$P(FLD("NODE0"),"^",10),IBY=+$P(FLD("NODE0"),"^",11) D:$$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) Q
57 ..S FLD("MULTIPLE SF")="NO"
58 ..D SETARY
59 .S SUBFLD=0 F S SUBFLD=$O(^IBE(357.5,FLD,2,SUBFLD)) Q:QUIT!('SUBFLD) D
60 ..S SUBFLD("NODE0")=$G(^IBE(357.5,FLD,2,SUBFLD,0)) Q:SUBFLD("NODE0")=""
61 ..S IBX=$P(SUBFLD("NODE0"),"^",7),IBY=$P(SUBFLD("NODE0"),"^",6) I IBX]"",IBY]"" I $$INRANGE^IBDF10A(IBX,IBY,TOP,BOTTOM,LEFT,RIGHT) D SETARY
62 D PRINT
63 K @ARY
64 Q
65RTNDESCR ;sets RTN=package interface and gets fields needed from the 0 node, sets the flags LIST, & WP
66 S RTN=$P(FLD("NODE0"),"^",3)
67 I 'RTN S (WP,RTN("INTERFACE"),RTN("PRINT COMPLETE"),LIST,RTN("NODE0"))=0 Q
68 S RTN("NODE0")=$G(^IBE(357.6,RTN,0))
69 S LIST=$S("34"[$P(RTN("NODE0"),"^",7):1,1:0)
70 S WP=$S($P(RTN("NODE0"),"^",7)=5:1,1:0)
71 S RTN("INTERFACE")=$P(RTN("NODE0"),"^"),RTN("INTERFACE")=$E(RTN("INTERFACE"),$F(RTN("INTERFACE")," "),40)
72 S RTN("PRINT COMPLETE")=$S($P(RTN("NODE0"),"^",8):"Y",1:"N")
73 Q
74PRINT ;prints @ARY
75 N CNT,LINE S (QUIT,CNT)=0
76 S COUNT=0 F S COUNT=$O(@ARY@(COUNT)) Q:QUIT!('COUNT) S IBY="" F S IBY=$O(@ARY@(COUNT,IBY)) Q:QUIT!(IBY="") D
77 .S IBX="" F S IBX=$O(@ARY@(COUNT,IBY,IBX)) Q:QUIT!(IBX="") D
78 ..S LINE=0 F S LINE=$O(@ARY@(COUNT,IBY,IBX,LINE)) Q:'LINE W !,$E($G(@ARY@(COUNT,IBY,IBX,LINE)),1,IOM) S CNT=LINE
79 ..F Q:(CNT>SCRNSIZE) W ! S CNT=CNT+1
80 ..S QUIT=$$PAUSE
81 Q
82PAUSE() ;pauses after each field discription is displayed
83 N ANS
84 R ANS:DTIME
85 Q $S('$T:1,ANS["^":1,1:0)
86SETARY ;writes data field description to @ARY
87 N PIECE,DATA,LINE
88 S COUNT=COUNT+1
89 S @ARY@(COUNT,IBY,IBX,1)="Name of Data Field: "_FLD("NAME")_" Multiple Subfields With Data: "_FLD("MULTIPLE SF")
90 S LINE="Row: "_(IBY+1)_" Column: "_(IBX+1)_" Length: "_$S(WP:$P(FLD("NODE0"),"^",14)_" Lines Allocated On Form: "_$P(FLD("NODE0"),"^",12),1:$P(SUBFLD("NODE0"),"^",8))
91 S @ARY@(COUNT,IBY,IBX,2)=LINE_$S(LIST:" Number On List: "_$P(FLD("NODE0"),"^",5)_" Last On List To Print?: "_$S($P(FLD("NODE0"),"^",4):"Y",1:"N"),1:"")
92 S @ARY@(COUNT,IBY,IBX,3)="Package Interface: "_RTN("INTERFACE")_" Print Overflowed Data?: "_RTN("PRINT COMPLETE")
93 I 'WP S DATA="",PIECE=$P(SUBFLD("NODE0"),"^",9) S:'PIECE PIECE=1 S:RTN DATA=$$DATANAME^IBDFU1B(RTN,PIECE) D
94 .S @ARY@(COUNT,IBY,IBX,4)="Label"_$S($P(SUBFLD("NODE0"),"^",3)["I":" (not displayed): ",1:": ")_$P(SUBFLD("NODE0"),"^")_" Data: "_DATA
95 I WP,RTN S @ARY@(COUNT,IBY,IBX,4)=$G(^IBE(357.6,RTN,1,1,0)),@ARY@(COUNT,IBY,IBX,5)=$G(^IBE(357.6,RTN,1,2,0))
96 Q
Note: See TracBrowser for help on using the repository browser.