DDXP2.m

DDXP2 ;SFISC/DPC-SELECTED FIELDS FOR EXPORT ;10/11/94  14:34

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

EN1 ;

 N Y,D,DICS D ^DICRW I Y=-1 G QUIT

 S Q="""",C=",",DC=0,L=1,DI=DIC,DALL(1)=1 W !

 D ^DIP2

 I $D(DDXPFDTM) S DIE="^DIPT(",DA=DDXPFDTM,DR="8///7" D ^DIE

QUIT ;

 K C,DA,DALL,DC,DI,DIE,DIC,DR,DTOUT,DUOUT,L,Q

 Q

VALALL ;

 W !,$C(7),"SORRY.  When choosing export fields, you cannot use ALL to select all fields.",!

 S Y=0 K X

 Q

VAL1 ;validates raw user input -- X contains user input

 S DDXPNG=0

 F DDXPCK=";C",";D",";L",";N",";R",";S",";T",";W",";X" D

 . I X[DDXPCK S DDXPNG=1 W !!,$C(7),"SORRY.  You cannot add "_DDXPCK_" to the export field specifications.",!

 . Q

 F DDXPCK="+","#","*","&","!" D

 . I $E(X)=DDXPCK S DDXPNG=1 W !!,$C(7),"SORRY.  You cannot choose the "_DDXPCK_" statistical operator when selecting fields for export.",!

 . Q

 I $E(X,$L(X))=":" S DDXPNG=1 W !!,$C(7),"SORRY.  You cannot jump to another file when selecting fields for export.",!

 I X[";""" S DDXPNG=1 W !!,$C(7),"SORRY.  You cannot enter a custom heading when selecting fields for export."

 K:DDXPNG X K DDXPNG,DDXPCK

 Q

VAL2 ;validates found field -- Y(0) contains 0-node of field DD

 S DDXPNG=0

 S %=+$P(Y(0),U,2) I '% G VAL2OUT

 I $P($G(^DD(%,.01,0)),U,2)["W" S DDXPNG=1 W !!,$C(7),"SORRY.  You cannot choose a word processing field for export.",!

VAL2OUT K:DDXPNG Y(0) K %,DDXPNG

 Q

VAL3 ;validates expression returned from DICOMP -- S contains expression

 S DDXPNG=0

 I S[";W"!(S[";m") S DDXPNG=1 W !!,$C(7),"SORRY.  That response is not acceptable when selecting fields for export.",!

 K:DDXPNG S K DDXPNG

 Q

DDXP2     ;SFISC/DPC-SELECTED FIELDS FOR EXPORT ;10/11/94  14:34

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

EN1       ;

 +1        NEW Y,D,DICS

           DO ^DICRW

           IF Y=-1

               GOTO QUIT

 +2        SET Q=""""

           SET C=","

           SET DC=0

           SET L=1

           SET DI=DIC

           SET DALL(1)=1

           WRITE !

 +3        DO ^DIP2

 +4        IF $DATA(DDXPFDTM)

               SET DIE="^DIPT("

               SET DA=DDXPFDTM

               SET DR="8///7"

               DO ^DIE

QUIT      ;

 +1        KILL C,DA,DALL,DC,DI,DIE,DIC,DR,DTOUT,DUOUT,L,Q

 +2        QUIT 

VALALL    ;

 +1        WRITE !,$CHAR(7),"SORRY.  When choosing export fields, you cannot use ALL to select all fields.",!

 +2        SET Y=0

           KILL X

 +3        QUIT 

VAL1      ;validates raw user input -- X contains user input

 +1        SET DDXPNG=0

 +2        FOR DDXPCK=";C",";D",";L",";N",";R",";S",";T",";W",";X"

               Begin DoDot:1

 +3                IF X[DDXPCK

                       SET DDXPNG=1

                       WRITE !!,$CHAR(7),"SORRY.  You cannot add "_DDXPCK_" to the export field specifications.",!

 +4                QUIT 

               End DoDot:1

 +5        FOR DDXPCK="+","#","*","&","!"

               Begin DoDot:1

 +6                IF $EXTRACT(X)=DDXPCK

                       SET DDXPNG=1

                       WRITE !!,$CHAR(7),"SORRY.  You cannot choose the "_DDXPCK_" statistical operator when selecting fields for export.",!

 +7                QUIT 

               End DoDot:1

 +8        IF $EXTRACT(X,$LENGTH(X))=":"

               SET DDXPNG=1

               WRITE !!,$CHAR(7),"SORRY.  You cannot jump to another file when selecting fields for export.",!

 +9        IF X[";"""

               SET DDXPNG=1

               WRITE !!,$CHAR(7),"SORRY.  You cannot enter a custom heading when selecting fields for export."

 +10       IF DDXPNG

               KILL X

           KILL DDXPNG,DDXPCK

 +11       QUIT 

VAL2      ;validates found field -- Y(0) contains 0-node of field DD

 +1        SET DDXPNG=0

 +2        SET %=+$PIECE(Y(0),U,2)

           IF '%

               GOTO VAL2OUT

 +3        IF $PIECE($GET(^DD(%,.01,0)),U,2)["W"

               SET DDXPNG=1

               WRITE !!,$CHAR(7),"SORRY.  You cannot choose a word processing field for export.",!

VAL2OUT    IF DDXPNG

               KILL Y(0)

           KILL %,DDXPNG

 +1        QUIT 

VAL3      ;validates expression returned from DICOMP -- S contains expression

 +1        SET DDXPNG=0

 +2        IF S[";W"!(S[";m")

               SET DDXPNG=1

               WRITE !!,$CHAR(7),"SORRY.  That response is not acceptable when selecting fields for export.",!

 +3        IF DDXPNG

               KILL S

           KILL DDXPNG

 +4        QUIT