source: FOIAVistA/tag/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFU1C.m@ 636

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1IBDFU1C ;ALB/CJM - ENCOUNTER FORM (sets various parameters);Jan 5, 1995
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;utilities
4 ;
5FORMDSCR(IBFORM) ;
6 ;IBFORM=ien of form - sets the IBFORM array with form parameterss - should be passed by reference
7 ;returns 1=ok, 0=failure
8 ;
9 Q:'IBFORM 0
10 N NODE,MODE,SUB
11 S NODE=$G(^IBE(357,IBFORM,0))
12 Q:NODE="" 0
13 S IBFORM("NAME")=$P(NODE,"^")
14 S IBFORM("WIDTH")=$P(NODE,"^",9) S:'IBFORM("WIDTH") IBFORM("WIDTH")=133
15 S IBFORM("PAGE_HT")=$P(NODE,"^",10) S:'IBFORM("PAGE_HT") IBFORM("PAGE_HT")=80
16 S IBFORM("PAGES")=$P(NODE,"^",11) S:'IBFORM("PAGES") IBFORM("PAGES")=1
17 S IBFORM("HT")=IBFORM("PAGE_HT")*IBFORM("PAGES")
18 S IBFORM("TOOLKIT")=$P(NODE,"^",7)
19 S IBFORM("COMPILED")=0 I +$P(NODE,"^",5),+$P(NODE,"^",13) S IBFORM("COMPILED")=1
20 ;S IBFORM("COMPILED")=+$P(NODE,"^",5)
21 S IBFORM("SCAN")=$P(NODE,"^",12)
22 S IBFORM("SCAN","ICR")=$S(IBFORM("SCAN"):$P(NODE,"^",6),1:0)
23 S IBFORM("TYPE")=$P(NODE,"^",13)
24 ;
25 S MODE=$P(NODE,"^",2)
26 S IBFORM("PRINT_MODE")=$S(MODE=1:"DUPLEX_LONG",MODE=2:"DUPLEX_SHORT",1:"SIMPLEX")
27 ;
28 ;pages to be scanned
29 I IBFORM("SCAN") S SUB=0 F S SUB=$O(^IBE(357,IBFORM,2,SUB)) Q:'SUB S NODE=$G(^IBE(357,IBFORM,2,SUB,0)) I +NODE,$P(NODE,"^",2) S IBFORM("SCAN",+NODE)=1
30 Q 1
31 ;
32FORMSIZE(IBFORM) ;pass IBFORM by reference
33 ;returns 0=failure, 1=success
34 N NODE
35 S NODE=$G(^IBE(357,IBFORM,0))
36 Q:NODE="" 0
37 S IBFORM("WIDTH")=$P(NODE,"^",9) S:'IBFORM("WIDTH") IBFORM("WIDTH")=133
38 S IBFORM("PAGE_HT")=$P(NODE,"^",10) S:'IBFORM("PAGE_HT") IBFORM("PAGE_HT")=80
39 S IBFORM("PAGES")=$P(NODE,"^",11) S:'IBFORM("PAGES") IBFORM("PAGES")=1
40 S IBFORM("HT")=IBFORM("PAGE_HT")*IBFORM("PAGES")
41 Q 1
42 ;
43ARRAYS(IBFORM,IBARRAY) ;decide what arrays will be used to contain the form
44 ;pass IBFORM,IBARRAY by reference
45 ;
46 ;non-toolkit forms are compiled
47 I 'IBFORM("TOOLKIT") D
48 .S IBARRAY("UNDERLINES")="^IBE(357,""AU"",IBFORM)"
49 .S IBARRAY("CONTROLS")="^IBE(357,""AC"",IBFORM)"
50 .S IBARRAY("GRAPHICS")="^IBE(357,""AG"",IBFORM)"
51 .S IBARRAY("BOXES")="^IBE(357,""AB"",IBFORM)"
52 .S IBARRAY("BUBBLES")=$S(IBFORM("TYPE"):"^IBD(357.95,""AC"",IBFORM(""TYPE""))",1:"^TMP(""IBDF"",$J,""FORM"",""BUBBLES"")")
53 .S IBARRAY("HAND_PRINT")=$S(IBFORM("TYPE"):"^IBD(357.95,""AD"",IBFORM(""TYPE""))",1:"^TMP(""IBDF"",$J,""FORM"",""HAND PRINT"")")
54 .;
55 .;if using compiled version, use a copy of the text portion so as to not change it
56 .I IBFORM("COMPILED") D
57 ..N IBROW,TEXT
58 ..S IBARRAY("TEXT")="^TMP(""IBDF"",$J,""FORM"")"
59 ..S TEXT="^IBE(357,""AT"",IBFORM)"
60 ..S IBROW="" F S IBROW=$O(@TEXT@(IBROW)) Q:IBROW="" S @IBARRAY("TEXT")@(IBROW)=$G(@TEXT@(IBROW))
61 .;
62 .I 'IBFORM("COMPILED") S IBARRAY("TEXT")="^IBE(357,""AT"",IBFORM)"
63 ;
64 ;toolkit forms don't have compiled versions
65 I IBFORM("TOOLKIT") D
66 .S IBARRAY("CONTROLS")="^TMP(""IBDF"",$J,""FORM"",""CTRL"")"
67 .S IBARRAY("UNDERLINES")="^TMP(""IBDF"",$J,""FORM"",""UNDRLN"")"
68 .S IBARRAY("GRAPHICS")="^TMP(""IBDF"",$J,""FORM"",""GRPHC"")"
69 .S IBARRAY("BOXES")="^TMP(""IBDF"",$J,""FORM"",""BOXES"")"
70 .S IBARRAY("BUBBLES")="^TMP(""IBDF"",$J,""FORM"",""BUBBLES"")"
71 .S IBARRAY("HAND_PRINT")="^TMP(""IBDF"",$J,""FORM"",""HAND PRINT"")"
72 .S IBARRAY("TEXT")="^TMP(""IBDF"",$J,""FORM"")"
73 S IBARRAY("OVERFLOW")="^TMP(""IBDF"",$J,""OVERFLOW"")"
74 Q
75 ;
76PRNTPRMS(IBPRINT,WITHDATA,ENTIRE,RECMPILE,WRITE) ;
77 ;sets pararameters in the IBPRINT array that controll printing - pass IBPRINT by reference
78 ;WITHDATA - whether to fill in the form with data
79 ;ENTIRE - whether to print the non-data parts
80 ;RECMPILE - whether blocks should be compiled, even if already compiled
81 ;WRITE - only applies if RECMPILE - whether to print the block
82 ;
83 S IBPRINT("WITH_DATA")=WITHDATA
84 S IBPRINT("ENTIRE")=ENTIRE
85 S IBPRINT("COMPILING_BLOCKS")=RECMPILE
86 S IBPRINT("WRITE_IF_COMPILING")=WRITE ;if IBPRINT("COMPILING_BLOCKS"),this =0 if the form isn't being printed, =1 if the form is being printed
87 Q
Note: See TracBrowser for help on using the repository browser.