DIWE5 ;SFISC/GFT-WP, AUX FUNCTIONS ;15NOV2012
;;22.2;VA FileMan;**24**;Jan 05, 2016;Build 3
;;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.
;
;**CCO/NI ENTIRE ROUTINE CHANGED
LNQ ;
W !,$$EZBLD^DIALOG(8150),"("_($G(I)'=6)_$P("-"_DWLC,U,DWLC>1)_")" ;**CCO/NI; $G() around 'I' -p24
I $G(DWL) D
.W !?9,$$EZBLD^DIALOG(8151,DWL) ;**CCI/NI
.I DWL>2 W !?9,$$EZBLD^DIALOG(8152,DWL) ;**CCO/NI
.I DWLC>DWL W !?9,$$EZBLD^DIALOG(8153,DWL+1) ;**CCI/NI
W ! Q
;
WL W !,"INITIALS:",! S X=$P(DIC,"(",1) Q:$D(@X)<9 S X=$O(@(X_"(0)"))-1,I=0 F S X=$O(^(X)) Q:X="" W X,!
S X=-1 Q
NL W !,"TEXT NAMES:",! S %T2="",I=0 F S %T2=$O(@(DW_")")) Q:%T2="" W %T2,?20,^(%T2,0),!
K %T2 Q
;
F ;
W !!,"Line WIDTH: "_DWLW_"//" R X:DTIME S DWLW=$S(X<10:DWLW,X>255:DWLW,1:X\1)
W !,"PACK "_$S(DWPK:"ON",1:"OFF")_"//" R X:DTIME S DWPK=$S(X="ON":1,1:0)
Q
X ;FILE TRANSFER
D:'$D(DISYS) OS^DII
D Q:X="" S DIWL=X,(%,%B)="" X ^DD("OS",DISYS,"EOFF")
.N DIR,DIRUT,DIROUT,DTOUT,DUOUT
.W ! S DIR("A")=$$EZBLD^DIALOG(8156) ;MAX STRING LENGTH
.S DIR("B")=75,DIR(0)="N^3:245:0" D ^DIR K DIR I $D(DIRUT) S X="" Q
.W !! D BLD^DIALOG(8155),MSG^DIALOG("WM") Q ; Long messge about 30-sec timeout
ENT I '$D(DIWL) S DIWL=245
A R X#245:30 E I '$L(X) D S:$L(%B) X ^DD("OS",DISYS,"EON") W !!,$$EZBLD^DIALOG(8157),! Q
S:X="" X=" " I X?.ANP S Y=X G D
S I=0,Y=""
C S I=I+1 I $E(X,I,999)?.ANP S Y=Y_$E(X,I,999) G D
S %=$E(X,I),%0=$A(%)
I %?1C S %="" I %0=9 S %=$E(" ",1,9-($L(Y)-($L(Y)\9*9)))
S Y=Y_% D S:$L(Y)>DIWL I ":27:13:"[(":"_%0_":") D S
G C
D D S G D:$L(Y)'<DIWL S %B=Y,Y="" G A
S S:$L(%B) %B=%B_$S($E(Y)=" ":"",1:" ") S %=%B_Y,%2=$L(%) Q:'%2 S Y=""
I %2>DIWL F %1=DIWL:-1 I %1<$S(DIWL-12>0:DIWL-12,1:4)!(" -"[$E(%,%1)) S Y=$E(%,%1+1+$S($E(%,%1+1)=" ":1,1:0),999),%=$E(%,1,%1-$S($E(%,%1)=" ":1,1:0)) Q
S %B="",DWLC=DWLC+1,@(DIC_"DWLC,0)")=%
Q
TQ ;
D G Z^DIWE3
.N DIP S DIP(1)=J,DIP(2)=I
.D BLD^DIALOG(9183),MSG^DIALOG("WH") ;**CCO/NI
;
IQ ;
I $D(DC) W:$D(^DD(+$P(DC,U,2),.01,3)) !?4,^(3),! X:$D(^(4)) ^(4) F %=0:0 S %=$O(^DD(+$P(DC,U,2),.01,21,%)) Q:%'>0 W !,^(%,0)
W !! D BLD^DIALOG(9180),MSG^DIALOG("WH") ;**CCO/NI
W !,$C(7),$$EZBLD^DIALOG(9181) S %=2 D YN^DICN Q:%-1 ;**CCO/NI
W !?5,$$EZBLD^DIALOG(9182) ;**CCO/NI
FN S %=15 F S %=$O(^DD("FUNC",%)) Q:%>97 I $D(^(%,10)) W !," |"_$P(^(0),U,1)_$P("(ARGUMENT)",U,$S('$D(^(3)):1,1:^(3)'=0))_"|",?25 W:$D(^(9)) ^(9)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIWE5 2636 printed Dec 13, 2024@02:54:58 Page 2
DIWE5 ;SFISC/GFT-WP, AUX FUNCTIONS ;15NOV2012
+1 ;;22.2;VA FileMan;**24**;Jan 05, 2016;Build 3
+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 ;
+7 ;**CCO/NI ENTIRE ROUTINE CHANGED
LNQ ;
+1 ;**CCO/NI; $G() around 'I' -p24
WRITE !,$$EZBLD^DIALOG(8150),"("_($GET(I)'=6)_$PIECE("-"_DWLC,U,DWLC>1)_")"
+2 IF $GET(DWL)
Begin DoDot:1
+3 ;**CCI/NI
WRITE !?9,$$EZBLD^DIALOG(8151,DWL)
+4 ;**CCO/NI
IF DWL>2
WRITE !?9,$$EZBLD^DIALOG(8152,DWL)
+5 ;**CCI/NI
IF DWLC>DWL
WRITE !?9,$$EZBLD^DIALOG(8153,DWL+1)
End DoDot:1
+6 WRITE !
QUIT
+7 ;
WL WRITE !,"INITIALS:",!
SET X=$PIECE(DIC,"(",1)
if $DATA(@X)<9
QUIT
SET X=$ORDER(@(X_"(0)"))-1
SET I=0
FOR
SET X=$ORDER(^(X))
if X=""
QUIT
WRITE X,!
+1 SET X=-1
QUIT
NL WRITE !,"TEXT NAMES:",!
SET %T2=""
SET I=0
FOR
SET %T2=$ORDER(@(DW_")"))
if %T2=""
QUIT
WRITE %T2,?20,^(%T2,0),!
+1 KILL %T2
QUIT
+2 ;
F ;
+1 WRITE !!,"Line WIDTH: "_DWLW_"//"
READ X:DTIME
SET DWLW=$SELECT(X<10:DWLW,X>255:DWLW,1:X\1)
+2 WRITE !,"PACK "_$SELECT(DWPK:"ON",1:"OFF")_"//"
READ X:DTIME
SET DWPK=$SELECT(X="ON":1,1:0)
+3 QUIT
X ;FILE TRANSFER
+1 if '$DATA(DISYS)
DO OS^DII
+2 Begin DoDot:1
+3 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT
+4 ;MAX STRING LENGTH
WRITE !
SET DIR("A")=$$EZBLD^DIALOG(8156)
+5 SET DIR("B")=75
SET DIR(0)="N^3:245:0"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET X=""
QUIT
+6 ; Long messge about 30-sec timeout
WRITE !!
DO BLD^DIALOG(8155)
DO MSG^DIALOG("WM")
QUIT
End DoDot:1
if X=""
QUIT
SET DIWL=X
SET (%,%B)=""
XECUTE ^DD("OS",DISYS,"EOFF")
ENT IF '$DATA(DIWL)
SET DIWL=245
A READ X#245:30
IF '$TEST
IF '$LENGTH(X)
if $LENGTH(%B)
DO S
XECUTE ^DD("OS",DISYS,"EON")
WRITE !!,$$EZBLD^DIALOG(8157),!
QUIT
+1 if X=""
SET X=" "
IF X?.ANP
SET Y=X
GOTO D
+2 SET I=0
SET Y=""
C SET I=I+1
IF $EXTRACT(X,I,999)?.ANP
SET Y=Y_$EXTRACT(X,I,999)
GOTO D
+1 SET %=$EXTRACT(X,I)
SET %0=$ASCII(%)
+2 IF %?1C
SET %=""
IF %0=9
SET %=$EXTRACT(" ",1,9-($LENGTH(Y)-($LENGTH(Y)\9*9)))
+3 SET Y=Y_%
if $LENGTH(Y)>DIWL
DO S
IF ":27:13:"[(":"_%0_":")
DO S
+4 GOTO C
D DO S
if $LENGTH(Y)'<DIWL
GOTO D
SET %B=Y
SET Y=""
GOTO A
S if $LENGTH(%B)
SET %B=%B_$SELECT($EXTRACT(Y)=" ":"",1:" ")
SET %=%B_Y
SET %2=$LENGTH(%)
if '%2
QUIT
SET Y=""
+1 IF %2>DIWL
FOR %1=DIWL:-1
IF %1<$SELECT(DIWL-12>0:DIWL-12,1:4)!(" -"[$EXTRACT(%,%1))
SET Y=$EXTRACT(%,%1+1+$SELECT($EXTRACT(%,%1+1)=" ":1,1:0),999)
SET %=$EXTRACT(%,1,%1-$SELECT($EXTRACT(%,%1)=" ":1,1:0))
QUIT
+2 SET %B=""
SET DWLC=DWLC+1
SET @(DIC_"DWLC,0)")=%
+3 QUIT
TQ ;
+1 Begin DoDot:1
+2 NEW DIP
SET DIP(1)=J
SET DIP(2)=I
+3 ;**CCO/NI
DO BLD^DIALOG(9183)
DO MSG^DIALOG("WH")
End DoDot:1
GOTO Z^DIWE3
+4 ;
IQ ;
+1 IF $DATA(DC)
if $DATA(^DD(+$PIECE(DC,U,2),.01,3))
WRITE !?4,^(3),!
if $DATA(^(4))
XECUTE ^(4)
FOR %=0:0
SET %=$ORDER(^DD(+$PIECE(DC,U,2),.01,21,%))
if %'>0
QUIT
WRITE !,^(%,0)
+2 ;**CCO/NI
WRITE !!
DO BLD^DIALOG(9180)
DO MSG^DIALOG("WH")
+3 ;**CCO/NI
WRITE !,$CHAR(7),$$EZBLD^DIALOG(9181)
SET %=2
DO YN^DICN
if %-1
QUIT
+4 ;**CCO/NI
WRITE !?5,$$EZBLD^DIALOG(9182)
FN SET %=15
FOR
SET %=$ORDER(^DD("FUNC",%))
if %>97
QUIT
IF $DATA(^(%,10))
WRITE !," |"_$PIECE(^(0),U,1)_$PIECE("(ARGUMENT)",U,$SELECT('$DATA(^(3)):1,1:^(3)'=0))_"|",?25
if $DATA(^(9))
WRITE ^(9)
