1 | IBDE1 ;ALB/CJM - ENCOUNTER FORM - (IMP/EXP UTILITY ACTIONS) ;AUG 12,1993
|
---|
2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;**14**;APR 24, 1997
|
---|
3 | ;
|
---|
4 | ADD ;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 | ;
|
---|
14 | DELETE ;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
|
---|
21 | EDIT ;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
|
---|
30 | IMPORT ;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
|
---|
49 | VIEW ;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
|
---|
58 | VIEWHDR ;
|
---|
59 | S VALMHDR(1)="Export Notes For "_$P($G(^IBE(358,FORM,0)),"^")_" Form"
|
---|
60 | Q
|
---|
61 | TEXT ;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 | ;
|
---|
70 | INITS ;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
|
---|
98 | DIFROM ;
|
---|
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
|
---|
110 | BLOCKS ;
|
---|
111 | S SCREEN="B"
|
---|
112 | D EN^VALM("IBDE IMP/EXP TK BLOCKS")
|
---|
113 | S VALMBCK="R",VALMCNT=FORMCNT,SCREEN="F"
|
---|
114 | Q
|
---|