source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF5C.m@ 1008

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

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1IBDF5C ;ALB/CJM - ENCOUNTER FORM (creating a new block) ;MARCH 22,1993
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3NEWBLOCK ;adds a new block, expects IBFORM to be defined
4 N IBBLK,TOP,BOT
5 S VALMBCK="R"
6 S IBBLK=$$CREATE()
7 I IBBLK D
8 .D TOPNBOT^IBDFU5(IBBLK,.TOP,.BOT)
9 .D IDXFORM^IBDF5A(TOP,BOT)
10 Q
11CREATE() ;creates the new block and allows the user to edit it
12 ;INPUTS: expects IBFORM to be defined
13 ; expects IBTKBLK to be defined - IBTKBLK=1 means add to tk
14 ;returns IBBLK
15 N NAME,IBBLK,NODE,IBDFDONE,IBBG,IBLFT,DLAYGO
16 S IBBG=1,IBLFT=5
17 S VALMBCK="R"
18 I '$G(IBTKBLK) S IBBG=+$G(VALMBG),IBLFT=+$G(VALMLFT)
19 S NAME=$$NEWNAME Q:NAME=-1 ""
20 K DIC,DIE,DD,DO,DINUM S DIC="^IBE(357.1,",DIC(0)="FL",X=NAME,DLAYGO=357.1
21 D FILE^DICN K DIC,DIE,DA
22 S IBBLK=+Y
23 I 'IBBLK D
24 .W !,"Unable to create a new block!" K DIC,DIE D PAUSE^IBDFU5
25 I IBBLK D
26 .;delete everything in the block - it should be empty
27 .D DLTCNTNT^IBDFU3(IBBLK,357.1)
28 .;set the current position of the block to the upper left-hand corner of the screen as the default
29 .S $P(^IBE(357.1,IBBLK,0),"^",4,5)=(IBBG-1)_"^"_(IBLFT-5)
30 .;now let the user edit the new block - header,name,outline,etc.
31 .K DIE,DA S DIE=357.1,DA=IBBLK,DR="[IBDF NEW EMPTY BLOCK]",DIE("NO^")="BACKOUTOK" D ^DIE K DIC,DIE,DR,DA
32 .I 'IBDFDONE S DIK="^IBE(357.1,",DA=IBBLK K DA(1) D ^DIK K DIK,DA Q
33 Q IBBLK
34NEWNAME() ;
35 K DIR S DIR(0)="357.1,.01A",DIR("A")="New Block Name: ",DIR("B")=""
36 D ^DIR K DIR I $D(DIRUT) Q -1
37 Q Y
38REDRAW ;redraws the ;entire form
39 S VALMBCK="R"
40 D UNCMPALL^IBDF19(IBFORM)
41 D IDXFORM^IBDF5A()
42 Q
43COPYBLK ;copies a block from another form,whether in the toolkit or not, expects IBFORM=current work form to be defined
44 N IBBLK,TOP,BOT,NEWBLOCK
45 S IBBLK=$$SELECT2^IBDF13("")
46 I IBBLK S NEWBLOCK=$$COPYBLK^IBDFU2(IBBLK,IBFORM,357.1,357.1,$$CURY^IBDFU4,$$CURX^IBDFU4,0,"",1) I NEWBLOCK D
47 .D RE^VALM4
48 .D POS^IBDFU4(NEWBLOCK)
49 .D TOPNBOT^IBDFU5(NEWBLOCK,.TOP,.BOT)
50 .D IDXFORM^IBDF5A(TOP,BOT)
51 S VALMBCK="R"
52 Q
53 ;
54VIEW ;toggles between viewing form with data and without data
55 N STARTVAL
56 S STARTVAL=IBPRINT("WITH_DATA")
57 I 'IBPRINT("WITH_DATA") D
58 .D FULL^VALM1
59 .S DFN=$$PATIENT
60 .I DFN S IBPRINT("WITH_DATA")=1 I '$G(IBAPPT) D NOW^%DTC S IBAPPT=% K %,%H,%I,X
61 E I IBPRINT("WITH_DATA") S IBPRINT("WITH_DATA")=0
62 ;
63 ;this action could be called at the form level or the block level - action depends on which
64 I '$G(IBBLK) D
65 .I STARTVAL'=IBPRINT("WITH_DATA") D JUSTDATA^IBDF2A(IBPRINT("WITH_DATA")) K ^TMP("IB",$J,"INTERFACES")
66 I $G(IBBLK) D UNCMPBLK^IBDF19(IBBLK),IDXBLOCK^IBDFU4
67 S VALMBCK="R"
68 Q
69 ;
70PATIENT() ;asks for a patient, returns the DFN
71 K DIR S DIR(0)="P^2:EM",DIR("A")="Test with what Patient"
72 D ^DIR K DIR I $D(DIRUT)!(+Y<1) Q 0
73 Q +Y
Note: See TracBrowser for help on using the repository browser.