IBDE1.m

IBDE1 ;ALB/CJM - ENCOUNTER FORM - (IMP/EXP UTILITY ACTIONS) ;AUG 12,1993

 ;;3.0;AUTOMATED INFO COLLECTION SYS;**14**;APR 24, 1997

 ;

ADD ;adds a form to the work space

 N OLDFORM,NEWFORM

 D FULL^VALM1

 S VALMBCK="R"

 S OLDFORM=$$SLCTFORM^IBDFU4("") Q:'OLDFORM

 S NEWFORM=$$COPYFORM^IBDFU2C(OLDFORM,357,358,"",1)

 I NEWFORM K DIE,DR,DA S DIE="^IBE(358,",DA=NEWFORM,DR="1;" D ^DIE K DIE,DR,DA

 D IDXFORMS^IBDE

 Q

 ;

DELETE ;deletes a form from the work space

 N PICK,FORM

 D EN^VALM2($G(XQORNOD(0)))

 S PICK="" F  S PICK=$O(VALMY(PICK)) Q:'PICK  S FORM=+$G(@VALMAR@("IDX",PICK,PICK)) D:FORM DELETE^IBDFU2C(FORM,358,1)

 S VALMBCK="R"

 D IDXFORMS^IBDE

 Q

EDIT ;allows the export notes of a form to be edited

 N PICK,FORM

 D EN^VALM2($G(XQORNOD(0)))

 D FULL^VALM1

 S PICK="" F  S PICK=$O(VALMY(PICK)) Q:'PICK  S FORM=+$G(@VALMAR@("IDX",PICK,PICK)) D:FORM

 .K DIE,DR,DA S DIE="^IBE(358,",DR="1;",DA=FORM D ^DIE K DIE,DA,DR

 S VALMBCK="R"

 D IDXFORMS^IBDE

 Q

IMPORT ;allows the user to pick a form, then import it

 N PICK,FORM,NAME,NEWFORM,IBDVR,FORMVR

 D EN^VALM2($G(XQORNOD(0)))

 D FULL^VALM1

 S PICK="" F  S PICK=$O(VALMY(PICK)) Q:'PICK  S FORM=+$G(@VALMAR@("IDX",PICK,PICK)) D:FORM

 .S IBDVR=+$G(^DD(357,0,"VR")) S:IBDVR<2.1 IBDVR=3.0

 .S FORMVR=+$P($G(^IBE(358,FORM,0)),"^",17) S:FORMVR<2.1 FORMVR=2.0

 .I FORMVR<IBDVR W !!,"This form was created with version "_FORMVR_"." D

 ..; -- ask if want to continue, if not quit

 ..;

 .S NAME=$$NEWNAME^IBDFU2C($P($G(^IBE(358,FORM,0)),"^"))

 .Q:NAME=""

 .S NEWFORM=$$COPYFORM^IBDFU2C(FORM,358,357,NAME)

 .K DIE,DR,DA S DIE="^IBE(357,",DR=".07T;.04////1;",DA=NEWFORM D ^DIE K DIE,DA,DR

 .D:$G(NEWFORM) DELETE^IBDFU2C(FORM,358,0)

 S VALMBCK="R"

 D IDXFORMS^IBDE

 D UPDATE^IBDECLN(1) ;make sure everything is okay (with messages)

 Q

VIEW ;allows the export notes of a form to be edited

 N PICK,FORM,IBARY,IBHDRRTN

 D EN^VALM2($G(XQORNOD(0)),"S")

 S PICK="" F  S PICK=$O(VALMY(PICK)) Q:'PICK  S FORM=+$G(@VALMAR@("IDX",PICK,PICK)) D

 .S IBHDRRTN="D VIEWHDR^IBDE1"

 .S IBARY="^IBE(358,"_FORM_",1)"

 .D EN^VALM("IBDE TEXT DISPLAY")

 S VALMBCK="R"

 Q

VIEWHDR ;

 S VALMHDR(1)="Export Notes For "_$P($G(^IBE(358,FORM,0)),"^")_" Form"

 Q

TEXT ;entry code for the IBDF TEXT DISPLAY list template

 N NODE S NODE=""

 S:$D(IBARY) VALMAR=IBARY

 X:$D(IBHDRRTN) IBHDRRTN

 I $G(IBARY)'="" S NODE=$G(@IBARY@(0))

 S VALMCNT=$S($P(NODE,"^",4)>$P(NODE,"^",3):$P(NODE,"^",4),1:$P(NODE,"^",3))

 I '$G(VALMCNT) S VALMCNT=10

 Q

 ;

INITS ;executes inits to bring stuff into the imp/exp files

 N QUIT,RTN

 S QUIT=0

 S VALMBCK="R"

 I $G(DUZ(0))'["@" W !,"This action requires PROGRAMMER ACCESS!" D PAUSE^IBDFU5 Q

 D FULL^VALM1

 I BLKCNT!FORMCNT D

 .K DIR S DIR(0)="Y"

 .W !,"The work space must be cleared before the INITS are run. Is that okay?"

 .D ^DIR K DIR

 .I $D(DIRUT)!(Y=0) S QUIT=1

 D:'QUIT DLTALL^IBDE2

 ;

 ;ask for the init rtn

 F  Q:QUIT  D

 .S DIR(0)="FA^5:8",DIR("B")=$S($L($T(^IBDEINIT)):"IBDEINIT",1:"")

 .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."

 .S DIR("A",1)="What is the name of the init routine that contains the forms that you want to",DIR("A")="import? "

 .D ^DIR K DIR

 .I $D(DIRUT) S QUIT=1 Q

 .I '$L($T(^@Y)) W !!,"That routine does not exist!",! Q

 .S RTN=Y

 .S QUIT=$$MSG^IBDE1B

 .I 'QUIT D @("^"_RTN),IDXFORMS^IBDE,IDXBLKS^IBDE3 S VALMCNT=$S(SCREEN="F":FORMCNT,1:BLKCNT)

 .S QUIT=1

 I SCREEN="F" D HDR^IBDE

 I SCREEN="B" D HDR^IBDE3

 Q

DIFROM ;

 N QUIT S QUIT=0

 S VALMBCK=""

 I $G(DUZ(0))'["@" W !!,"Using the DIFROM action requires PROGRAMMER ACCESS!",! D PAUSE^IBDFU5 Q

 I 'BLKCNT,'FORMCNT D  Q

 .W !!,"There is nothing in the work space to export!"

 .D PAUSE^IBDFU5

 D FULL^VALM1

 S QUIT=$$MSG^IBDE1A

 I 'QUIT D ^DIFROM W !,"DONE",!,"************************"

 S VALMBCK="R"

 Q

BLOCKS ;

 S SCREEN="B"

 D EN^VALM("IBDE IMP/EXP TK BLOCKS")

 S VALMBCK="R",VALMCNT=FORMCNT,SCREEN="F"

 Q

IBDE1     ;ALB/CJM - ENCOUNTER FORM - (IMP/EXP UTILITY ACTIONS) ;AUG 12,1993

 +1       ;;3.0;AUTOMATED INFO COLLECTION SYS;**14**;APR 24, 1997

 +2       ;

ADD       ;adds a form to the work space

 +1        NEW OLDFORM,NEWFORM

 +2        DO FULL^VALM1

 +3        SET VALMBCK="R"

 +4        SET OLDFORM=$$SLCTFORM^IBDFU4("")

           IF 'OLDFORM

               QUIT 

 +5        SET NEWFORM=$$COPYFORM^IBDFU2C(OLDFORM,357,358,"",1)

 +6        IF NEWFORM

               KILL DIE,DR,DA

               SET DIE="^IBE(358,"

               SET DA=NEWFORM

               SET DR="1;"

               DO ^DIE

               KILL DIE,DR,DA

 +7        DO IDXFORMS^IBDE

 +8        QUIT 

 +9       ;

DELETE    ;deletes a form from the work space

 +1        NEW PICK,FORM

 +2        DO EN^VALM2($GET(XQORNOD(0)))

 +3        SET PICK=""

           FOR 

               SET PICK=$ORDER(VALMY(PICK))

               IF 'PICK

                   QUIT 

               SET FORM=+$GET(@VALMAR@("IDX",PICK,PICK))

               IF FORM

                   DO DELETE^IBDFU2C(FORM,358,1)

 +4        SET VALMBCK="R"

 +5        DO IDXFORMS^IBDE

 +6        QUIT 

EDIT      ;allows the export notes of a form to be edited

 +1        NEW PICK,FORM

 +2        DO EN^VALM2($GET(XQORNOD(0)))

 +3        DO FULL^VALM1

 +4        SET PICK=""

           FOR 

               SET PICK=$ORDER(VALMY(PICK))

               IF 'PICK

                   QUIT 

               SET FORM=+$GET(@VALMAR@("IDX",PICK,PICK))

               IF FORM

                   Begin DoDot:1

 +5                    KILL DIE,DR,DA

                       SET DIE="^IBE(358,"

                       SET DR="1;"

                       SET DA=FORM

                       DO ^DIE

                       KILL DIE,DA,DR

                   End DoDot:1

 +6        SET VALMBCK="R"

 +7        DO IDXFORMS^IBDE

 +8        QUIT 

IMPORT    ;allows the user to pick a form, then import it

 +1        NEW PICK,FORM,NAME,NEWFORM,IBDVR,FORMVR

 +2        DO EN^VALM2($GET(XQORNOD(0)))

 +3        DO FULL^VALM1

 +4        SET PICK=""

           FOR 

               SET PICK=$ORDER(VALMY(PICK))

               IF 'PICK

                   QUIT 

               SET FORM=+$GET(@VALMAR@("IDX",PICK,PICK))

               IF FORM

                   Begin DoDot:1

 +5                    SET IBDVR=+$GET(^DD(357,0,"VR"))

                       IF IBDVR<2.1

                           SET IBDVR=3.0

 +6                    SET FORMVR=+$PIECE($GET(^IBE(358,FORM,0)),"^",17)

                       IF FORMVR<2.1

                           SET FORMVR=2.0

 +7                    IF FORMVR<IBDVR

                           WRITE !!,"This form was created with version "_FORMVR_"."

                           Begin DoDot:2

 +8       ; -- ask if want to continue, if not quit

 +9       ;

                           End DoDot:2

 +10                   SET NAME=$$NEWNAME^IBDFU2C($PIECE($GET(^IBE(358,FORM,0)),"^"))

 +11                   IF NAME=""

                           QUIT 

 +12                   SET NEWFORM=$$COPYFORM^IBDFU2C(FORM,358,357,NAME)

 +13                   KILL DIE,DR,DA

                       SET DIE="^IBE(357,"

                       SET DR=".07T;.04////1;"

                       SET DA=NEWFORM

                       DO ^DIE

                       KILL DIE,DA,DR

 +14                   IF $GET(NEWFORM)

                           DO DELETE^IBDFU2C(FORM,358,0)

                   End DoDot:1

 +15       SET VALMBCK="R"

 +16       DO IDXFORMS^IBDE

 +17      ;make sure everything is okay (with messages)

           DO UPDATE^IBDECLN(1)

 +18       QUIT 

VIEW      ;allows the export notes of a form to be edited

 +1        NEW PICK,FORM,IBARY,IBHDRRTN

 +2        DO EN^VALM2($GET(XQORNOD(0)),"S")

 +3        SET PICK=""

           FOR 

               SET PICK=$ORDER(VALMY(PICK))

               IF 'PICK

                   QUIT 

               SET FORM=+$GET(@VALMAR@("IDX",PICK,PICK))

               Begin DoDot:1

 +4                SET IBHDRRTN="D VIEWHDR^IBDE1"

 +5                SET IBARY="^IBE(358,"_FORM_",1)"

 +6                DO EN^VALM("IBDE TEXT DISPLAY")

               End DoDot:1

 +7        SET VALMBCK="R"

 +8        QUIT 

VIEWHDR   ;

 +1        SET VALMHDR(1)="Export Notes For "_$PIECE($GET(^IBE(358,FORM,0)),"^")_" Form"

 +2        QUIT 

TEXT      ;entry code for the IBDF TEXT DISPLAY list template

 +1        NEW NODE

           SET NODE=""

 +2        IF $DATA(IBARY)

               SET VALMAR=IBARY

 +3        IF $DATA(IBHDRRTN)

               XECUTE IBHDRRTN

 +4        IF $GET(IBARY)'=""

               SET NODE=$GET(@IBARY@(0))

 +5        SET VALMCNT=$SELECT($PIECE(NODE,"^",4)>$PIECE(NODE,"^",3):$PIECE(NODE,"^",4),1:$PIECE(NODE,"^",3))

 +6        IF '$GET(VALMCNT)

               SET VALMCNT=10

 +7        QUIT 

 +8       ;

INITS     ;executes inits to bring stuff into the imp/exp files

 +1        NEW QUIT,RTN

 +2        SET QUIT=0

 +3        SET VALMBCK="R"

 +4        IF $GET(DUZ(0))'["@"

               WRITE !,"This action requires PROGRAMMER ACCESS!"

               DO PAUSE^IBDFU5

               QUIT 

 +5        DO FULL^VALM1

 +6        IF BLKCNT!FORMCNT

               Begin DoDot:1

 +7                KILL DIR

                   SET DIR(0)="Y"

 +8                WRITE !,"The work space must be cleared before the INITS are run. Is that okay?"

 +9                DO ^DIR

                   KILL DIR

 +10               IF $DATA(DIRUT)!(Y=0)

                       SET QUIT=1

               End DoDot:1

 +11       IF 'QUIT

               DO DLTALL^IBDE2

 +12      ;

 +13      ;ask for the init rtn

 +14       FOR 

               IF QUIT

                   QUIT 

               Begin DoDot:1

 +15               SET DIR(0)="FA^5:8"

                   SET DIR("B")=$SELECT($LENGTH($TEXT(^IBDEINIT)):"IBDEINIT",1:"")

 +16               SET DIR("?",1)="In order for you to import forms from another site the other site must have"

                   SET DIR("?")="prepared and sent you inits created using the import/export facility."

 +17               SET DIR("A",1)="What is the name of the init routine that contains the forms that you want to"

                   SET DIR("A")="import? "

 +18               DO ^DIR

                   KILL DIR

 +19               IF $DATA(DIRUT)

                       SET QUIT=1

                       QUIT 

 +20               IF '$LENGTH($TEXT(^@Y))

                       WRITE !!,"That routine does not exist!",!

                       QUIT 

 +21               SET RTN=Y

 +22               SET QUIT=$$MSG^IBDE1B

 +23               IF 'QUIT

                       DO @("^"_RTN)

                       DO IDXFORMS^IBDE

                       DO IDXBLKS^IBDE3

                       SET VALMCNT=$SELECT(SCREEN="F":FORMCNT,1:BLKCNT)

 +24               SET QUIT=1

               End DoDot:1

 +25       IF SCREEN="F"

               DO HDR^IBDE

 +26       IF SCREEN="B"

               DO HDR^IBDE3

 +27       QUIT 

DIFROM    ;

 +1        NEW QUIT

           SET QUIT=0

 +2        SET VALMBCK=""

 +3        IF $GET(DUZ(0))'["@"

               WRITE !!,"Using the DIFROM action requires PROGRAMMER ACCESS!",!

               DO PAUSE^IBDFU5

               QUIT 

 +4        IF 'BLKCNT

               IF 'FORMCNT

                   Begin DoDot:1

 +5                    WRITE !!,"There is nothing in the work space to export!"

 +6                    DO PAUSE^IBDFU5

                   End DoDot:1

                   QUIT 

 +7        DO FULL^VALM1

 +8        SET QUIT=$$MSG^IBDE1A

 +9        IF 'QUIT

               DO ^DIFROM

               WRITE !,"DONE",!,"************************"

 +10       SET VALMBCK="R"

 +11       QUIT 

BLOCKS    ;

 +1        SET SCREEN="B"

 +2        DO EN^VALM("IBDE IMP/EXP TK BLOCKS")

 +3        SET VALMBCK="R"

           SET VALMCNT=FORMCNT

           SET SCREEN="F"

 +4        QUIT