Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIL0

DIL0.m

Go to the documentation of this file.
  1. DIL0 ;SFISC/GFT - TURN PRINT FLDS INTO CODE ;4NOV2016
  1. ;;22.2;VA FileMan;**4**;Jan 05, 2016;Build 5
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;;GFT;**91,102,999,1005,1012,1056**
  1. ;CALLED FROM ^DIL
  1. D XDUY S %=$P(X,U,2) S:%["Cm"&(W[";W") %="w"_% G WP:%["W",M:%["m",STATS^DIL1:$D(DCL(DP_U_+W)),N:W[";N"
  1. I W[";W" D S D1=$S(%["C":Y,1:$P(" S Y=",U,Y'?1" ".E)_Y_" S X=Y") D W S Y=Y_D1_" D ^DIWP" Q
  1. .N %,DNP S DNP=1 D EN^DILL(DP,+W,1)
  1. D EN^DILL(DP,+W,1)
  1. DN ;
  1. I W[";X" D Q
  1. .S DE=$S(W[";C"!(W[";S"):DE,$A(Y)-32:" W ?0",1:"")
  1. .I $L(DE)+$L(Y)>250 D
  1. ..S %=Y,Y=DE,DE=% D PX^DIL S Y=DE
  1. .E S Y=DE_Y
  1. .I $D(DIWR(DM)) D DIWR
  1. DNW D H:DHD!$G(DIOSUBHD) I DG+DLN>IOM,DG K ^UTILITY("DIL",$J,DG) S DG='%*DM*2+2,DE=$P(W,";C",2),DG=$S(DE>0:DE-1,DE<0:IOM+DE,DG+DLN'>IOM!(W[";W"):DG,DLN>IOM:0,1:IOM-DLN),DE=" D T Q:'DN W ?"_DG D W^DIL,H:DHD!$G(DIOSUBHD)
  1. S DG=2+DLN+DG Q:$D(DNP) I $L(DE)+$L(Y)>250 S %=Y,Y=DE,DE=% D PX^DIL S Y=DE Q
  1. S Y=DE_Y Q
  1. ;
  1. H S V=$P(X,U),Z=99,I=$F(W,";""") I I>0 Q:$E(W,I-4,I)=";Z;""""" S I=$P(W,";""",2),V=$$CONVQQ^DILIBF($P(I,"""",1,$L(I,"""")-1)) ;V will be COLUMN HEADER
  1. XD S V=$P(V," ",2,99),D=$P(V," ") I D]"",$L(I)+$L(D)<DLN S I=I_" "_D G XD
  1. S ^UTILITY("DIL",$J,DG,Z)=$J(I,DRJ*DLN),V(Z)="",Z=Z-1 G HEAD
  1. ;
  1. XDUY ;
  1. I '$D(^DD(DP,+W,0)) S X="",DU=0,Y=0 Q
  1. S X=^(0),DU=$P(X,U,4),Y=$P(DU,";",2),DU=$P(DU,";") I W[";T",$D(^(.1)) S X=^(.1)_U_$P(X,U,2,99)
  1. EGP E S $P(X,U)=$$LABEL^DIALOGZ(DP,+W) ;**FIELD LABEL FOR OUTPUT HEADING
  1. S:+DU'=DU DU=""""_DU_""""
  1. I Y S Y="$P(X,U,"_Y_")" Q
  1. I Y="" S Y="D"_DM Q
  1. S Y=$E(Y,2,9) S:$P(Y,",",2)=+Y Y=+Y S Y="$E(X,"_Y_")" Q
  1. ;
  1. WR ;
  1. K DLN D W^DILL
  1. W S DRJ=0,DIWL=DIWL+1 I '$D(DLN) S %=IOM-DG,DLN=$S(%>20:%,1:IOM)-2
  1. S:W[";X" $P(X,U)="" D DNW S %=$P(DE,"W ?",2)+1,Y=DLN+%-1,DIO=2,%=" S DIWL="_%_",DIWR="_$S(IOM<Y:IOM,1:Y),Y=$P(DE," W ?")_% Q
  1. ;
  1. WP S DN=%["L"_U D WR ;COME HERE FOR A W-P TYPE FIELD
  1. S DIO=3,Y=%_" D ^DIWP",X=F(DM-1) I DHT<0 S I=$E(^UTILITY("DIPZ",$J,X),2,999) D WPX S ^UTILITY("DIPZ",$J,X)=" "_I Q
  1. I $D(^UTILITY($J,99,X)) S I=^(X) D WPX S ^UTILITY($J,99,X)=I Q
  1. WPX ;from DIPZ1
  1. S:DN I=^DD("FUNC",38,1)_" "_I ;'NOWRAP' FUNCTION
  1. I DE]"" S I=DE_" "_I ;GFT
  1. Q
  1. ;
  1. M S D1=" S DICMX=""D "_$E("L",%'["w")_"^DIWP"" "_$P(X,U,5,99) D WR S Y=Y_D1 Q
  1. ;
  1. N ;
  1. S DCL=DCL+1,DXS="Y",D=",Y=$$DITTO^DIO2("_DCL_",Y)",DITTO(DCL)="",I=""
  1. I %["C" S X=X_" S Y=X"_D_" S X=Y" G Z
  1. S Y=" S Y="_Y_D
  1. Z D EN^DILL(DP,+W) G DN
  1. ;
  1. DIWR ;CALLED FROM ^DIL
  1. G DIWR^DIPZ1:DHT I $D(DIWR(DM)),DX=DIWR(DM) S ^UTILITY($J,99,DX)="D A^DIWW" G K
  1. I $D(DIWR(DM)) F DX=DX+1:1 I '$D(^UTILITY($J,99,DX)) S ^(DX)="D ^DIWW" D DX^DIL(DX) G K
  1. D S ^UTILITY($J,99,I)="D ^DIWW "_^UTILITY($J,99,I)
  1. .F I=DM-1:-1:0 I $D(DIWR(I)) K DIWR(I) Q
  1. .I I S I=F(I)
  1. .E F I=1:1 Q:'$D(^UTILITY($J,99,I+1))
  1. K K DIWR(DM) Q