DDXP2 ;SFISC/DPC-SELECTED FIELDS FOR EXPORT ;10/11/94 14:34
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDXP2 1908 printed Oct 16, 2024@18:44:43 Page 2
DDXP2 ;SFISC/DPC-SELECTED FIELDS FOR EXPORT ;10/11/94 14:34
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
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
