DIEQ ;SFISC/XAK,YJK - HELP DURING INPUT ;14MAR2016
;;22.2;VA FileMan;**2,7,5,10**;Jan 05, 2016;Build 11
;;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.
;;GFT;**4,3,59,999,1004,1024
;
BN S D=$P(DQ(DQ),U,4) S:DP+1 D=DIFLD
S DZ=X D EN1 G B^DIED
QQ ;
I DV,DV["*",$D(^DD(+DV,.01,0)) S DQ(DQ)=$P(DQ(DQ),U,1,4)_U_$P(^(0),U,5,99)
EN1 ;N DDH,DST,A1 S DDH=0 G M:DV I DP<0 D HP G P ;p7
N DST,A1 S DDH=0 G M:DV I DP<0 D HP G P
HELP I X="?"!(X["BAD") S X=$$HELP^DIALOGZ(DP,D),A1="T" D N:X]"" I '$G(DISORT),$D(^DD(DP,D,12)) S X=^(12) D N ;HELP MESSAGE
D H G:'$D(DZ) Q
;
P I DV["P" K DO S DIC=U_DU,D="B",DIC(0)="M"_$E("L",DV'["'") G AST:DV["*"&('$G(DISORT)) D DQ^DICQ D % G Q
VP S DU=DP S:DV DU=+DO(2),D=.01 I DV["V" D V G Q
D I DV["D" S %(0)=0,%("X")=$P(DQ(DQ),U,5,9) I DV'["t" D DT^DIEH1($P($P(%("X"),"%DT=""",2),""""),1) ;ONCE WAS A CALL TO HELP^%DTC ;p5
;.I %("X")="" S %("X")=$$GETMETH^DIETLIBF(DU,D,"INPUT TRANSFORM") ;p5
S I DV["S" D:'$G(DISORT) SETSCR^DIR(DU,D) S A1="T",DST=$$EZBLD^DIALOG(8068)_" " D DS D K DIC("S")
.N A,A1,A2
.S A=$P(DQ(DQ),U,3) I DV["t" S DG=$$GETPROP^DIETLIBF(DU,D,"SET OF CODES") I DG]"" S A=DG
.I $G(DUZ("LANG"))>1,A=$P(^DD(DP,D,0),U,3) S A=$$SETIN^DIALOGZ_";" ;NAKED
.F DG=1:1 S Y=$P(A,";",DG) Q:Y="" S D=$P(Y,":",2),Y=$P(Y,":") I 1 X:$D(DIC("S")) DIC("S") I S A2="",$P(A2," ",15-($L(Y)+7))=" ",DST=" "_Y_A2_" "_D D DS
Q K DO,DST,A1 S:$D(DIE) DIC=DIE S D=0 I $D(DDH)>10 D LIST^DDSU ;p10
D:DV UDA
Q
;
;
;
N F Q:X="" F %=$L(X," "):-1:1 I $L($P(X," ",1,%))<75 S DST=$P(X," ",1,%) D DS D:X'="" N1 Q
S X=DZ
Q
;
N1 S X=$P(X," ",%+1,$L(X," ")) Q
;
DS S:'$D(A1) A1="T" S DDH=$G(DDH)+1,DDH(DDH,A1)=$S(A1="X":"",1:" ")_DST K A1,DST Q
;
HP I $D(DQ(DQ,3)) S A1="T",DST=DQ(DQ,3) D DS
I $D(DQ(DQ,4)) S A1="X",DST=DQ(DQ,4) D DS
Q
;
% S %=$G(DIC("V")) K DIC S:%]"" DIC("V")=% Q
;
AST S:$D(X)[0 X="?" X $P(DQ(DQ),U,5,99) K DIC G Q
D ^DIC K DIC,DICS,DICW G Q
;
M ;COME HERE FROM EN1 ABOVE WHEN WE'RE IN A MULTIPLE FIELD
K DO S DZ=X,DIC=DIE_DA_","_$S(+$P(DC,U,3)=$P(DC,U,3):$P(DC,U,3),1:$C(34)_$P(DC,U,3)_$C(34))_",",D="B",DIC(0)="LM",DZ(1)=0
I '$D(@(DIC_"0)")) S DO=U_$P(DC,U,2) D DO2^DIC1
D:'$D(DO) DO^DIC1
D DDA,DQ^DICQ D % G Q:'$D(DZ)!(DV["S") S X=DZ G P
;
H I '$G(DISORT) D Q:'$D(DZ)
. I $G(DV)["t" S DST=$$XHELP^DIETLIBF(DP,D)
. E S DST=$G(^DD(DP,D,4))
. I DST'?."^" S A1="X" D DS,LIST^DDSU
I $G(X)?1"??".E,X'["BAD" D
. N DIDG,DG,DDD,DD,DIY,DIZ,DUOUT
. S DIDG=$P($G(^DD(DP,D,21,0)),U,3)
. K DDSQ
. I '$D(DDS) S DDD=5,DD="",DIY=99,DIZ=21 I $G(DIPGM)'="DICQ1" N DIPGM S DIPGM="DIEQ" D Z^DDSU
. F DG=1:1 Q:'$D(^DD(DP,D,21,DG,0)) Q:+DIDG&(DG>DIDG) D Q:$D(DDSQ)
. . I '($G(DDH)#15) D LIST^DDSU I $G(DTOUT)!($G(DUOUT)) S DDSQ=1
. . Q:$D(DDSQ)
. . S DDH=$G(DDH)+1,DDH(DDH,"T")=^DD(DP,D,21,DG,0) ;S DST=^DD(DP,D,21,DG,0) D DS Q ;GRAB DESCRIPTION NODE BY NODE
. I '$D(DDSQ) Q:$D(DDH)'>10 D LIST^DDSU
. I $D(DDSQ) K DDSQ,DDH
. Q
Q
;
BK S DDH=$G(DDH)+1,DDH(DDH,"T")=" " Q
;
V S DDH=+$G(DDH),A1="T",DST=$$EZBLD^DIALOG(8071) D DS
EGP F Y=0:0 S Y=$O(^DD(DU,D,"V",Y)) Q:Y'>0 I $D(^(Y,0)) S Y(0)=^(0) X:$D(DIC("V")) DIC("V") I I $D(^DIC(+Y(0),0)) S Y(1)=$P(Y(0),U,4),Y(2)=$$FILENAME^DIALOGZ(+Y(0)),DST=$$EZBLD^DIALOG(8072,.Y) K Y(1),Y(2) D DS ;**CCO/NI V-P FILE NAMES
D BK S DST=$$EZBLD^DIALOG(8073) D DS S DU="" D BK I DZ'?1"??".E K X,DZ Q
D T^DIEQ1 K X,DZ Q
;
DDA N T,%
S T=$T
F %=+$O(DA(" "),-1):-1:1 K DA(%+1) S:$D(DA(%))#2 DA(%+1)=DA(%)
K DA(1) S:$D(DA)#2 DA(1)=DA
I T
Q
;
UDA N T,%
S T=$T
S DA=$G(DA(1)) ;K DA(1)
F %=2:1:+$O(DA(" "),-1) I $D(DA(%))#2 S DA(%-1)=DA(%) K DA(%)
I T
Q
;
;#8071 Enter one of the following
;#8072 |Prefix|.EntryName to select a |filename|
;#8073 To see the entries in any particular file type <Prefix.?>
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIEQ 4027 printed Sep 23, 2025@20:23:22 Page 2
DIEQ ;SFISC/XAK,YJK - HELP DURING INPUT ;14MAR2016
+1 ;;22.2;VA FileMan;**2,7,5,10**;Jan 05, 2016;Build 11
+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 ;;GFT;**4,3,59,999,1004,1024
+7 ;
BN SET D=$PIECE(DQ(DQ),U,4)
if DP+1
SET D=DIFLD
+1 SET DZ=X
DO EN1
GOTO B^DIED
QQ ;
+1 IF DV
IF DV["*"
IF $DATA(^DD(+DV,.01,0))
SET DQ(DQ)=$PIECE(DQ(DQ),U,1,4)_U_$PIECE(^(0),U,5,99)
EN1 ;N DDH,DST,A1 S DDH=0 G M:DV I DP<0 D HP G P ;p7
+1 NEW DST,A1
SET DDH=0
if DV
GOTO M
IF DP<0
DO HP
GOTO P
HELP ;HELP MESSAGE
IF X="?"!(X["BAD")
SET X=$$HELP^DIALOGZ(DP,D)
SET A1="T"
if X]""
DO N
IF '$GET(DISORT)
IF $DATA(^DD(DP,D,12))
SET X=^(12)
DO N
+1 DO H
if '$DATA(DZ)
GOTO Q
+2 ;
P IF DV["P"
KILL DO
SET DIC=U_DU
SET D="B"
SET DIC(0)="M"_$EXTRACT("L",DV'["'")
if DV["*"&('$GET(DISORT))
GOTO AST
DO DQ^DICQ
DO %
GOTO Q
VP SET DU=DP
if DV
SET DU=+DO(2)
SET D=.01
IF DV["V"
DO V
GOTO Q
D ;ONCE WAS A CALL TO HELP^%DTC ;p5
IF DV["D"
SET %(0)=0
SET %("X")=$PIECE(DQ(DQ),U,5,9)
IF DV'["t"
DO DT^DIEH1($PIECE($PIECE(%("X"),"%DT=""",2),""""),1)
+1 ;.I %("X")="" S %("X")=$$GETMETH^DIETLIBF(DU,D,"INPUT TRANSFORM") ;p5
S IF DV["S"
if '$GET(DISORT)
DO SETSCR^DIR(DU,D)
SET A1="T"
SET DST=$$EZBLD^DIALOG(8068)_" "
DO DS
Begin DoDot:1
+1 NEW A,A1,A2
+2 SET A=$PIECE(DQ(DQ),U,3)
IF DV["t"
SET DG=$$GETPROP^DIETLIBF(DU,D,"SET OF CODES")
IF DG]""
SET A=DG
+3 ;NAKED
IF $GET(DUZ("LANG"))>1
IF A=$PIECE(^DD(DP,D,0),U,3)
SET A=$$SETIN^DIALOGZ_";"
+4 FOR DG=1:1
SET Y=$PIECE(A,";",DG)
if Y=""
QUIT
SET D=$PIECE(Y,":",2)
SET Y=$PIECE(Y,":")
IF 1
if $DATA(DIC("S"))
XECUTE DIC("S")
IF $TEST
SET A2=""
SET $PIECE(A2," ",15-($LENGTH(Y)+7))=" "
SET DST=" "_Y_A2_" "_D
DO DS
End DoDot:1
KILL DIC("S")
Q ;p10
KILL DO,DST,A1
if $DATA(DIE)
SET DIC=DIE
SET D=0
IF $DATA(DDH)>10
DO LIST^DDSU
+1 if DV
DO UDA
+2 QUIT
+3 ;
+4 ;
+5 ;
N FOR
if X=""
QUIT
FOR %=$LENGTH(X," "):-1:1
IF $LENGTH($PIECE(X," ",1,%))<75
SET DST=$PIECE(X," ",1,%)
DO DS
if X'=""
DO N1
QUIT
+1 SET X=DZ
+2 QUIT
+3 ;
N1 SET X=$PIECE(X," ",%+1,$LENGTH(X," "))
QUIT
+1 ;
DS if '$DATA(A1)
SET A1="T"
SET DDH=$GET(DDH)+1
SET DDH(DDH,A1)=$SELECT(A1="X":"",1:" ")_DST
KILL A1,DST
QUIT
+1 ;
HP IF $DATA(DQ(DQ,3))
SET A1="T"
SET DST=DQ(DQ,3)
DO DS
+1 IF $DATA(DQ(DQ,4))
SET A1="X"
SET DST=DQ(DQ,4)
DO DS
+2 QUIT
+3 ;
% SET %=$GET(DIC("V"))
KILL DIC
if %]""
SET DIC("V")=%
QUIT
+1 ;
AST if $DATA(X)[0
SET X="?"
XECUTE $PIECE(DQ(DQ),U,5,99)
KILL DIC
GOTO Q
+1 DO ^DIC
KILL DIC,DICS,DICW
GOTO Q
+2 ;
M ;COME HERE FROM EN1 ABOVE WHEN WE'RE IN A MULTIPLE FIELD
+1 KILL DO
SET DZ=X
SET DIC=DIE_DA_","_$SELECT(+$PIECE(DC,U,3)=$PIECE(DC,U,3):$PIECE(DC,U,3),1:$CHAR(34)_$PIECE(DC,U,3)_$CHAR(34))_","
SET D="B"
SET DIC(0)="LM"
SET DZ(1)=0
+2 IF '$DATA(@(DIC_"0)"))
SET DO=U_$PIECE(DC,U,2)
DO DO2^DIC1
+3 if '$DATA(DO)
DO DO^DIC1
+4 DO DDA
DO DQ^DICQ
DO %
if '$DATA(DZ)!(DV["S")
GOTO Q
SET X=DZ
GOTO P
+5 ;
H IF '$GET(DISORT)
Begin DoDot:1
+1 IF $GET(DV)["t"
SET DST=$$XHELP^DIETLIBF(DP,D)
+2 IF '$TEST
SET DST=$GET(^DD(DP,D,4))
+3 IF DST'?."^"
SET A1="X"
DO DS
DO LIST^DDSU
End DoDot:1
if '$DATA(DZ)
QUIT
+4 IF $GET(X)?1"??".E
IF X'["BAD"
Begin DoDot:1
+5 NEW DIDG,DG,DDD,DD,DIY,DIZ,DUOUT
+6 SET DIDG=$PIECE($GET(^DD(DP,D,21,0)),U,3)
+7 KILL DDSQ
+8 IF '$DATA(DDS)
SET DDD=5
SET DD=""
SET DIY=99
SET DIZ=21
IF $GET(DIPGM)'="DICQ1"
NEW DIPGM
SET DIPGM="DIEQ"
DO Z^DDSU
+9 FOR DG=1:1
if '$DATA(^DD(DP,D,21,DG,0))
QUIT
if +DIDG&(DG>DIDG)
QUIT
Begin DoDot:2
+10 IF '($GET(DDH)#15)
DO LIST^DDSU
IF $GET(DTOUT)!($GET(DUOUT))
SET DDSQ=1
+11 if $DATA(DDSQ)
QUIT
+12 ;S DST=^DD(DP,D,21,DG,0) D DS Q ;GRAB DESCRIPTION NODE BY NODE
SET DDH=$GET(DDH)+1
SET DDH(DDH,"T")=^DD(DP,D,21,DG,0)
End DoDot:2
if $DATA(DDSQ)
QUIT
+13 IF '$DATA(DDSQ)
if $DATA(DDH)'>10
QUIT
DO LIST^DDSU
+14 IF $DATA(DDSQ)
KILL DDSQ,DDH
+15 QUIT
End DoDot:1
+16 QUIT
+17 ;
BK SET DDH=$GET(DDH)+1
SET DDH(DDH,"T")=" "
QUIT
+1 ;
V SET DDH=+$GET(DDH)
SET A1="T"
SET DST=$$EZBLD^DIALOG(8071)
DO DS
EGP ;**CCO/NI V-P FILE NAMES
FOR Y=0:0
SET Y=$ORDER(^DD(DU,D,"V",Y))
if Y'>0
QUIT
IF $DATA(^(Y,0))
SET Y(0)=^(0)
if $DATA(DIC("V"))
XECUTE DIC("V")
IF $TEST
IF $DATA(^DIC(+Y(0),0))
SET Y(1)=$PIECE(Y(0),U,4)
SET Y(2)=$$FILENAME^DIALOGZ(+Y(0))
SET DST=$$EZBLD^DIALOG(8072,.Y)
KILL Y(1),Y(2)
DO DS
+1 DO BK
SET DST=$$EZBLD^DIALOG(8073)
DO DS
SET DU=""
DO BK
IF DZ'?1"??".E
KILL X,DZ
QUIT
+2 DO T^DIEQ1
KILL X,DZ
QUIT
+3 ;
DDA NEW T,%
+1 SET T=$TEST
+2 FOR %=+$ORDER(DA(" "),-1):-1:1
KILL DA(%+1)
if $DATA(DA(%))#2
SET DA(%+1)=DA(%)
+3 KILL DA(1)
if $DATA(DA)#2
SET DA(1)=DA
+4 IF T
+5 QUIT
+6 ;
UDA NEW T,%
+1 SET T=$TEST
+2 ;K DA(1)
SET DA=$GET(DA(1))
+3 FOR %=2:1:+$ORDER(DA(" "),-1)
IF $DATA(DA(%))#2
SET DA(%-1)=DA(%)
KILL DA(%)
+4 IF T
+5 QUIT
+6 ;
+7 ;#8071 Enter one of the following
+8 ;#8072 |Prefix|.EntryName to select a |filename|
+9 ;#8073 To see the entries in any particular file type <Prefix.?>
