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

DID1.m

Go to the documentation of this file.
  1. DID1 ;SFISC/XAK,JLT,GFT - STD DD LIST ;25OCT2016
  1. ;;22.2;VA FileMan;**2,19**;Jan 05, 2016;Build 2
  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;**7,76,105,152,999,1003,1004,1021,1039,1044,1046,1053**
  1. ;
  1. S DJ(Z)=D0,DDL1=14,DDL2=32 G B
  1. ;
  1. L S DJ(Z)=0
  1. A S DJ(Z)=$O(^DD(F(Z),DJ(Z))) I DJ(Z)'>0 S:DJ(Z)="" DJ(Z)=-1 W !! S Z=Z-1 Q
  1. B S N=^DD(F(Z),DJ(Z),0) K DDF I $D(DIGR),Z<2!(DJ(Z)-.01) X DIGR E G ND
  1. D HD:$Y+$L(X)+6>IOSL Q:M=U
  1. I $P(N,U,2)["W" S X="" G TYPE ;p19 subdd of WP, skip LABEL & WP, they were displayed at top level
  1. W !!,F(Z),",",DJ(Z)
  1. LABEL W ?(Z+Z+12),$P(N,U),?DDL2+4," "_$P(N,U,4)
  1. F X=0:0 S X=$O(^DD(F(Z),DJ(Z),.008,X)) Q:'X S W=$P($G(^(X,0)),U) I W]"",$D(^DI(.85,X,0)) S I=$P(^(0),U,2)_": " W !?(Z+Z+12-$L(I)),I,W ;DISPLAY FOREIGN LABELS
  1. S X=$P(N,U,2)
  1. WP I X,$D(^DD(+X,.01,0)) S W=$P(^(0),U,2) I W["W" D S X=""
  1. .D WPW("WORD-PROCESSING #"_+X) D:W["L" WPW("(NOWRAP)")
  1. .D:W["X"!(W["x") WPW("(IGNORE ""|"")") D:W["I" WPW("(UNEDITABLE)") D:$G(^("AUDIT"))]"" WPW("(AUDITED)")
  1. .Q
  1. F W="BOOLEAN","COMPUTED","FREE TEXT","SET","DATE","NUMBER","POINTER","K","VARIABLE POINTER","m","p" I X[$E(W) D VP^DIDX:$E(W)="V" S:W="K" W="MUMPS" S:W="p" W="POINTER" S:W="m" W="MULTIPLE" W ?40," "_W G ND:M=U
  1. TYPE S W=+$P(X,"t",2) I W,$D(^DI(.81,W,0)) S W=" ("_$P(^(0),U)_" Data Type)" D W D G ND:M=U
  1. .N X,Y F X=0:0 S X=$O(^DD(F(Z),DJ(Z),101,X)) Q:'X I $D(^DI(.86,X,0)) W !?DDL1,"PROPERTY: ",?DDL2,$P(^(0),U) D Q:M=U
  1. ..I $G(^DD(F(Z),DJ(Z),101,X,31))]"" S Y=^(31) X:$G(^DI(.86,X,41))=1 ^DD("DD") S W=" (Value = "_Y_")" D W
  1. .F X=0:0 S X=$O(^DD(F(Z),DJ(Z),201,X)) Q:'X S Y=$G(^(X,31)) I Y]"",$D(^DI(.87,X,0)) W !?DDL1,$P(^(0),U),": ",Y
  1. I +X S W=" Multiple" S W=W_" #"_+X D W G ND:M=U
  1. I X["V" S I=0 F S I=$O(^DD(F(Z),D0,"V",I)) Q:I'>0 S %Y=$P(^(I,0),U) I $D(^DIC(%Y,0)),$D(@(^(0,"GL")_"0)")) S ^UTILITY($J,"P",$E($P(^(0),U),1,30),0)=%Y,^(F(Z),DJ(Z))=0
  1. I 'X D
  1. P .N Y,NM S:X["P" Y=U_$P(N,U,3),NM=+$P(X,"P",2) I X["C" S NM=+$P(X,"p",2) I NM S Y=$G(^DIC(NM,0,"GL"))
  1. .Q:'$D(Y) N PF I Y[U,$D(@(Y_"0)")) S W=" TO "_$P(^(0),U)_" FILE (#"_NM_")",PF=$E($P(^(0),U),1,30)
  1. .E S PF="UNDEFINED FILE"_$S(NM:" (#"_NM_")",1:""),W=" ***** TO AN "_PF_$S(Y[U:", STORED IN "_$$CREF^DILF(Y),1:"")_" *******",PF="}"_PF,NM="" W:($L(W)+$X)'<IOM !
  1. .S ^UTILITY($J,"P",PF,0)=NM,^(F(Z),DJ(Z))=0
  1. .D W
  1. MP I X'["V" D RT^DIDX G:M=U ND
  1. S I X["S" D G ND:M=U
  1. .N N1,LANG
  1. .S N1=$P(N,U,3) F %1=1:1 S Y=$P(N1,";",%1) Q:Y="" W ! S W="'"_$P(Y,":")_"' FOR "_$P(Y,":",2)_"; " D W Q:M=U D
  1. ..F LANG=0:0 S LANG=$O(^DD(F(Z),DJ(Z),.007,LANG)) Q:'LANG I $D(^(LANG,0)) W " (",$P(^(0),";",%1),")"
  1. G RD:$D(DINM) I X["C" S W=$P(N,U,5,99) W !?DDL1,"MUMPS CODE: " D W G ND:M=U G RD
  1. I "Q"'[$P(N,U,5) W !?DDL1,"INPUT TRANSFORM:" S W=$P(N,U,5,99) D W G ND:M=U
  1. J S W=$P(N,U,2) I W'["N" S W=+$P(W,"J",2) I W W !?DDL1,"MAXIMUM LENGTH: " D W G ND:M=U
  1. OT I $D(^DD(F(Z),DJ(Z),2))#2 W !?DDL1,"OUTPUT TRANSFORM:" D D W G ND:M=U
  1. .I $P(^(0),U,2)'["O" S W="NOT EXECUTABLE!! -- SPECIFIER NEEDS AN ""O""!"
  1. .E S W=$S($D(^DD(F(Z),DJ(Z),2.1)):^(2.1),1:^(2))
  1. RD D ^DID2:$O(^DD(F(Z),DJ(Z),2.99))]"" G ND:M=U I 'X S W="" D G SUB:W,N ;p19 If WP, SUB will display Help & Desc. at subdd level
  1. .I X["I" S W="UNEDITABLE" W ! D W Q
  1. .S W=$$CHKWP(F(Z),DJ(Z)),X=$S(W:W,1:X) ;X=subdd for WP
  1. I $O(^DD(+X,0,"ID",""))]"" W !?DDL1,"IDENTIFIED BY:" S W="" F %=0:0 S %=$O(^DD(+X,0,"ID",%)) S:%>0 W=W_$P(^DD(+X,%,0),U)_"(#"_%_")"_$S($P(^(0),U,2)["R":"[R]",1:"")_", " I %'>0 S:W?.E1", " W=$E(W,1,$L(W)-2) D W G ND:M=U Q
  1. ;
  1. ;Print "WRITE" identifiers
  1. I '$D(DINM) S %=" " F S %=$O(^DD(+X,0,"ID",%)) Q:%="" D Q:M=U
  1. . N DIDLN,DIDPG
  1. . S DIDLN(1)=$G(^DD(+X,0,"ID",%)) Q:DIDLN(1)?."^"
  1. . S DIDLN(0)=""""_%_""": "
  1. . S DIDLN(0)=$J("",DDL2-DDL1-$L(DIDLN(0)))_DIDLN(0)
  1. . S DIDPG("H")="W """" D H^DIDH S:M=U PAGE(U)=1"
  1. . D WRPHI^DIKCP1(.DIDLN,IOM-1-DDL2,DDL1,DDL2-DDL1,1,.DIDPG)
  1. G:M=U ND
  1. ;
  1. I $D(^DD("KEY","B",+X)) D G:M=U ND
  1. . N DIDPG
  1. . S DIDPG("H")="W """" S DC=DC+1 D ^DIDH1 S:M=U PAGE(U)=1"
  1. . D PRINT^DIKKP(+X,"","L"_DDL1_"C"_(DDL2-DDL1),.DIDPG)
  1. I $D(^DD("IX","B",+X)) D G:M=U ND
  1. . N DIDPG
  1. . S DIDPG("H")="W """" S DC=DC+1 D ^DIDH1 S:M=U PAGE(U)=1"
  1. . D LIST^DIKCP(+X,"","L"_DDL1_"C"_(DDL2-DDL1),.DIDPG)
  1. SUB S Z=Z+1,DDL1=DDL1+2,DDL2=DDL2+2,F(Z)=+X
  1. D L
  1. N K DDN1 I X["X" S DDN1=1 W !,?DDL1,"NOTES:",?DDL2,"XXXX--CAN'T BE ALTERED EXCEPT BY PROGRAMMER" W ! G ND:M=U
  1. S W=0 I $O(^DD(F(Z),DJ(Z),5,W))'="",'$D(DDN1) W !?DDL1,"NOTES:"
  1. TR S W=$O(^DD(F(Z),DJ(Z),5,W)) S:W="" W=-1 G IX:W'>0 S I=^(W,0),%=+I I '$D(^DD(%,$P(I,U,2),0))!$D(W(I)) K ^DD(F(Z),DJ(Z),5,W) G TR
  1. S W(I)=0 S WS=W D WR^DIDH1 W ! S W=WS K WS G TR
  1. IX S F=0 F G ND:M=U S F=$O(^DD(F(Z),DJ(Z),1,F)) Q:F'>0 W !?DDL1,"CROSS-REFERENCE:" D IX1
  1. S:F="" F=-1
  1. I $D(^DD("IX","F",F(Z),DJ(Z))) D S:M=U DN=0
  1. . N DIDPG,DIDFLAG
  1. . S DIDPG("H")="W """" S DC=DC+1 D ^DIDH1 S:M=U PAGE(U)=1"
  1. . S DIDFLAG="L"_DDL1_"C"_(DDL2-DDL1)_"T1"
  1. . D PRINT^DIKCP(F(Z),DJ(Z),$E("R",$G(DIDRANGE))_"FS"_DIDFLAG_$E("N",$D(DINM)#2),.DIDPG) Q:M=U
  1. . D:'$G(DIDRANGE) LIST^DIKCP(F(Z),DJ(Z),"RS"_DIDFLAG,.DIDPG)
  1. ND S X="" G:M'=U A:Z>1
  1. Q
  1. IX1 S W=^(F,0)_" " K DDF W ?DDL2,W,! G ND:M=U D TP:$P(W,U,3)["TRIG" I '$D(DINM) S X=0 F %=0:0 S X=$O(^DD(F(Z),DJ(Z),1,F,X)) Q:X="" I X'="%D",X'="DT" S W=^(X) S:$L(W)<248 W=X_")= "_W K:X=3 DDF D W W ! G ND:M=U
  1. Q:'$D(^("%D"))
  1. ;
  1. N DIDI,DIDN,DIDZ,DIWF,DIWL,DIWR,X
  1. K ^UTILITY($J,"W")
  1. S DIWF="W",DIWL=DDL2+1,DIWR=IOM,DIDZ=Z
  1. S DIDN=$P($G(^DD(F(DIDZ),DJ(DIDZ),1,F,"%D",0)),U,3),DIDI=0
  1. F S DIDI=$O(^DD(F(DIDZ),DJ(DIDZ),1,F,"%D",DIDI)) Q:'DIDI!(DIDN&(DIDI>DIDN)) S X=^(DIDI,0) D ^DIWP I $D(DN),'DN S M=U Q
  1. I M'=U D ^DIWW I $D(DN),'DN S M=U
  1. I M'=U W !
  1. E K DIOEND
  1. S Z=DIDZ
  1. K ^UTILITY($J,"W")
  1. Q
  1. ;
  1. CHKWP(F,Z) ;F=file, Z=field - return subdd of WP or 0 ;p19
  1. N W,Y
  1. S W=$P($G(^DD(F,Z,0)),U,2) Q:'W 0
  1. S Y=$P($G(^DD(W,.01,0)),U,2)
  1. Q $S(Y["W":W,1:0)
  1. ;
  1. TP ;TRIGGER POINTER. SHOULD BE A DO-DOT UNDER IX1
  1. S X=+$P(^(0),U,4) I F(Z)-X,$D(^DIC(X,0))#2 S ^UTILITY($J,"P",$E($P(^(0),U,1),1,30),0)=X,^(F(Z),DJ(Z))=6
  1. Q
  1. ;
  1. WPW(X) ;word processing write
  1. W:$L(X)+$X+5>IOM !?18 W " ",X
  1. Q
  1. ;
  1. W F K=0:0 W:$D(DDF) ! S:(($L(W)+DDL2)>IOM) DDL2=32 W ?DDL2 S %Y=$E(W,IOM-$X,999) W $E(W,1,IOM-$X-1) Q:%Y="" S W=%Y,DDF=1
  1. K:'X DDF Q:$Y+6<IOSL
  1. HD S DC=DC+1 D ^DIDH Q