source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDE1.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1IBDE1 ;ALB/CJM - ENCOUNTER FORM - (IMP/EXP UTILITY ACTIONS) ;AUG 12,1993
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**14**;APR 24, 1997
3 ;
4ADD ;adds a form to the work space
5 N OLDFORM,NEWFORM
6 D FULL^VALM1
7 S VALMBCK="R"
8 S OLDFORM=$$SLCTFORM^IBDFU4("") Q:'OLDFORM
9 S NEWFORM=$$COPYFORM^IBDFU2C(OLDFORM,357,358,"",1)
10 I NEWFORM K DIE,DR,DA S DIE="^IBE(358,",DA=NEWFORM,DR="1;" D ^DIE K DIE,DR,DA
11 D IDXFORMS^IBDE
12 Q
13 ;
14DELETE ;deletes a form from the work space
15 N PICK,FORM
16 D EN^VALM2($G(XQORNOD(0)))
17 S PICK="" F S PICK=$O(VALMY(PICK)) Q:'PICK S FORM=+$G(@VALMAR@("IDX",PICK,PICK)) D:FORM DELETE^IBDFU2C(FORM,358,1)
18 S VALMBCK="R"
19 D IDXFORMS^IBDE
20 Q
21EDIT ;allows the export notes of a form to be edited
22 N PICK,FORM
23 D EN^VALM2($G(XQORNOD(0)))
24 D FULL^VALM1
25 S PICK="" F S PICK=$O(VALMY(PICK)) Q:'PICK S FORM=+$G(@VALMAR@("IDX",PICK,PICK)) D:FORM
26 .K DIE,DR,DA S DIE="^IBE(358,",DR="1;",DA=FORM D ^DIE K DIE,DA,DR
27 S VALMBCK="R"
28 D IDXFORMS^IBDE
29 Q
30IMPORT ;allows the user to pick a form, then import it
31 N PICK,FORM,NAME,NEWFORM,IBDVR,FORMVR
32 D EN^VALM2($G(XQORNOD(0)))
33 D FULL^VALM1
34 S PICK="" F S PICK=$O(VALMY(PICK)) Q:'PICK S FORM=+$G(@VALMAR@("IDX",PICK,PICK)) D:FORM
35 .S IBDVR=+$G(^DD(357,0,"VR")) S:IBDVR<2.1 IBDVR=3.0
36 .S FORMVR=+$P($G(^IBE(358,FORM,0)),"^",17) S:FORMVR<2.1 FORMVR=2.0
37 .I FORMVR<IBDVR W !!,"This form was created with version "_FORMVR_"." D
38 ..; -- ask if want to continue, if not quit
39 ..;
40 .S NAME=$$NEWNAME^IBDFU2C($P($G(^IBE(358,FORM,0)),"^"))
41 .Q:NAME=""
42 .S NEWFORM=$$COPYFORM^IBDFU2C(FORM,358,357,NAME)
43 .K DIE,DR,DA S DIE="^IBE(357,",DR=".07T;.04////1;",DA=NEWFORM D ^DIE K DIE,DA,DR
44 .D:$G(NEWFORM) DELETE^IBDFU2C(FORM,358,0)
45 S VALMBCK="R"
46 D IDXFORMS^IBDE
47 D UPDATE^IBDECLN(1) ;make sure everything is okay (with messages)
48 Q
49VIEW ;allows the export notes of a form to be edited
50 N PICK,FORM,IBARY,IBHDRRTN
51 D EN^VALM2($G(XQORNOD(0)),"S")
52 S PICK="" F S PICK=$O(VALMY(PICK)) Q:'PICK S FORM=+$G(@VALMAR@("IDX",PICK,PICK)) D
53 .S IBHDRRTN="D VIEWHDR^IBDE1"
54 .S IBARY="^IBE(358,"_FORM_",1)"
55 .D EN^VALM("IBDE TEXT DISPLAY")
56 S VALMBCK="R"
57 Q
58VIEWHDR ;
59 S VALMHDR(1)="Export Notes For "_$P($G(^IBE(358,FORM,0)),"^")_" Form"
60 Q
61TEXT ;entry code for the IBDF TEXT DISPLAY list template
62 N NODE S NODE=""
63 S:$D(IBARY) VALMAR=IBARY
64 X:$D(IBHDRRTN) IBHDRRTN
65 I $G(IBARY)'="" S NODE=$G(@IBARY@(0))
66 S VALMCNT=$S($P(NODE,"^",4)>$P(NODE,"^",3):$P(NODE,"^",4),1:$P(NODE,"^",3))
67 I '$G(VALMCNT) S VALMCNT=10
68 Q
69 ;
70INITS ;executes inits to bring stuff into the imp/exp files
71 N QUIT,RTN
72 S QUIT=0
73 S VALMBCK="R"
74 I $G(DUZ(0))'["@" W !,"This action requires PROGRAMMER ACCESS!" D PAUSE^IBDFU5 Q
75 D FULL^VALM1
76 I BLKCNT!FORMCNT D
77 .K DIR S DIR(0)="Y"
78 .W !,"The work space must be cleared before the INITS are run. Is that okay?"
79 .D ^DIR K DIR
80 .I $D(DIRUT)!(Y=0) S QUIT=1
81 D:'QUIT DLTALL^IBDE2
82 ;
83 ;ask for the init rtn
84 F Q:QUIT D
85 .S DIR(0)="FA^5:8",DIR("B")=$S($L($T(^IBDEINIT)):"IBDEINIT",1:"")
86 .S DIR("?",1)="In order for you to import forms from another site the other site must have",DIR("?")="prepared and sent you inits created using the import/export facility."
87 .S DIR("A",1)="What is the name of the init routine that contains the forms that you want to",DIR("A")="import? "
88 .D ^DIR K DIR
89 .I $D(DIRUT) S QUIT=1 Q
90 .I '$L($T(^@Y)) W !!,"That routine does not exist!",! Q
91 .S RTN=Y
92 .S QUIT=$$MSG^IBDE1B
93 .I 'QUIT D @("^"_RTN),IDXFORMS^IBDE,IDXBLKS^IBDE3 S VALMCNT=$S(SCREEN="F":FORMCNT,1:BLKCNT)
94 .S QUIT=1
95 I SCREEN="F" D HDR^IBDE
96 I SCREEN="B" D HDR^IBDE3
97 Q
98DIFROM ;
99 N QUIT S QUIT=0
100 S VALMBCK=""
101 I $G(DUZ(0))'["@" W !!,"Using the DIFROM action requires PROGRAMMER ACCESS!",! D PAUSE^IBDFU5 Q
102 I 'BLKCNT,'FORMCNT D Q
103 .W !!,"There is nothing in the work space to export!"
104 .D PAUSE^IBDFU5
105 D FULL^VALM1
106 S QUIT=$$MSG^IBDE1A
107 I 'QUIT D ^DIFROM W !,"DONE",!,"************************"
108 S VALMBCK="R"
109 Q
110BLOCKS ;
111 S SCREEN="B"
112 D EN^VALM("IBDE IMP/EXP TK BLOCKS")
113 S VALMBCK="R",VALMCNT=FORMCNT,SCREEN="F"
114 Q
Note: See TracBrowser for help on using the repository browser.