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

CIAUDIC.m

Go to the documentation of this file. 
  1. CIAUDIC ;MSC/IND/DKM - Encapsulated FileMan API;15-Feb-2007 10:32;DKM
  1.  ;;1.2;CIA UTILITIES;;Mar 20, 2007
  1.  ;;Copyright 2000-2006, Medsphere Systems Corporation
  1.  ;=================================================================
  1.  ; Parameterized routine to add/edit/extract an entry in a
  1.  ; FileMan file.  Encapsulates global structure info so no
  1.  ; need to specify this directly.
  1.  ; Inputs:
  1.  ;    %CIADIC = Global root, file number, or bookmark
  1.  ;    %CIACMD = n    : IEN of entry to process
  1.  ;             0    : Process last IEN referenced
  1.  ;             +n   : Move down to subfile n
  1.  ;             -    : Move up to parent file
  1.  ;             @n   : Delete IEN #n (or last referenced if missing)
  1.  ;             =x;y : Lookup y at current level using options in x
  1.  ;             ?x;y ; Lookup y using CIAULKP utility with options in x
  1.  ;             >x;y : Read fields specified in y using options in x
  1.  ;             <x;y : Write fields specified in y using options in x
  1.  ;             ~x;y : Same as <, but creates new entry
  1.  ;             %n   : Force DINUM to n
  1.  ; Outputs:
  1.  ;     Returns in the first piece the IEN of the entry or...
  1.  ;      0 = Entry was deleted
  1.  ;     -1 = Entry was rejected
  1.  ;     -2 = Entry locked by another process
  1.  ;     -3 = Unexpected error
  1.  ;=================================================================
  1. ENTRY(%CIADIC,%CIACMD) ;
  1.  S %CIADIC(0)=+$G(DUZ)
  1.  N DUZ,DIC,DINUM,DIE,DIQ,DIQUIET,DIK,%CIAX,%CIAIEN,%CIAARG,%CIAN1,%CIAN2,%CIAZ,X,Y
  1.  N DA,DC,DD,DG,DH,DK,DL,DO,DQ,DR,DU,DV,DW,DY
  1.  S DUZ=%CIADIC(0),DUZ(0)="@",@$$TRAP^CIAUOS("ERROR^CIAUDIC"),%CIACMD=$G(%CIACMD),%CIAIEN="",DIQUIET=1
  1.  ; Build the bookmark if a global reference or file # passed
  1.  I %CIADIC'[U D
  1.  .S:%CIADIC'=+%CIADIC %CIADIC=+$O(^DIC("B",%CIADIC,0))
  1.  .S %CIADIC=$$ROOT^DILFD(%CIADIC)_U_U_%CIADIC
  1.  I $P(%CIADIC,U,4)="" D
  1.  .S %CIAZ=U_$P(%CIADIC,U,2),%CIAZ=$E(%CIAZ,1,$L(%CIAZ)-1),%CIAZ=%CIAZ_$S(%CIAZ["(":")",1:"")
  1.  .S $P(%CIADIC,U,4)=$P(@%CIAZ@(0),U,2)
  1.  F %CIAN1=1:1:$L(%CIACMD,"|") S %CIAARG=$P(%CIACMD,"|",%CIAN1),%CIAZ=$E(%CIAARG) D  Q:%CIAIEN<0
  1.  .S %CIAN2=$F("-+=@><~?%",%CIAZ)
  1.  .S:%CIAN2 %CIAN2=%CIAN2-1,%CIAARG=$E(%CIAARG,2,999)
  1.  .D DA,@%CIAN2
  1.  .S:%CIAIEN>0 $P(%CIADIC,U,3)=%CIAIEN
  1.  S $P(%CIADIC,U)=%CIAIEN
  1.  Q %CIADIC
  1.  ; Set IEN
  1. 0 S:%CIAARG'<0 %CIAIEN=$S($D(@%CIADIC(2)@(+%CIAARG)):+%CIAARG,1:0),$P(%CIADIC,U,3)=%CIAIEN
  1.  Q
  1.  ; Move up to parent file
  1. 1 N %CIAX,%CIAY
  1.  S $P(%CIADIC,U,4)=$P($P(%CIADIC,U,4),"|",2,999)
  1.  S %CIAY=$P(%CIADIC,U,2),%CIAX=$L(%CIAY,"|"),$P(%CIADIC,U,2)=$P(%CIAY,"|",1,%CIAX-1)
  1.  S %CIAIEN=+$P(%CIAY,"|",%CIAX),$P(%CIADIC,U,3)=%CIAIEN
  1.  D DA
  1.  Q
  1.  ; Move down to subfile
  1. 2 N %CIAX,%CIAY,%CIAZ
  1.  I $P(%CIADIC,U,3)'>0 S %CIAIEN=-1 Q
  1.  S %CIAY=+$P(%CIADIC,U,4)
  1.  S:%CIAARG'=+%CIAARG %CIAARG=+$O(^DD(%CIAY,"B",%CIAARG,0)),%CIAARG=+$P($G(^DD(%CIAY,%CIAARG,0)),U,2)
  1.  S %CIAX=+%CIAARG,%CIAZ=+$O(^DD(%CIAY,"SB",%CIAX,0)),%CIAZ=$P($P(^DD(%CIAY,%CIAZ,0),U,4),";"),%CIAX=$P(^(0),U,2)
  1.  S:%CIAZ'=+%CIAZ %CIAZ=""""_%CIAZ_""""
  1.  S $P(%CIADIC,U,4)=%CIAX_"|"_$P(%CIADIC,U,4),$P(%CIADIC,U,2)=$P(%CIADIC,U,2)_"|"_$P(%CIADIC,U,3)_","_%CIAZ_","
  1.  S %CIAIEN="",$P(%CIADIC,U,3)=""
  1.  D DA
  1.  Q
  1.  ; Lookup an entry
  1. 3 N X,Y
  1.  I %CIAARG[";" S DIC(0)=$P(%CIAARG,";"),%CIAARG=$P(%CIAARG,";",2,999)
  1.  E  S DIC(0)="XMF"
  1.  S DIC=%CIADIC(1),X=%CIAARG
  1.  D ^DIC
  1.  S %CIAIEN=+Y
  1.  Q
  1.  ; Delete an entry
  1. 4 N X,Y
  1.  S:%CIAARG DA=%CIAARG
  1.  S DIK=%CIADIC(1),%CIAIEN=0
  1.  D ^DIK
  1.  Q
  1.  ; Extract data
  1. 5 N %CIAZ,%CIAZ1,%CIAX,%CIAY
  1.  I '%CIAIEN S %CIAIEN=-1 Q
  1.  S DR=""
  1.  F %CIAX=2:1:$L(%CIAARG,";") D
  1.  .S %CIAY=$P(%CIAARG,";",%CIAX)
  1.  .I %CIAY["=" S %CIAZ=$$FLD($P(%CIAY,"=",2)),%CIAZ1(%CIAZ,$P(%CIAY,"="))="",%CIAY=%CIAZ
  1.  .S DR=DR_$S($L(DR):";",1:"")_%CIAY
  1.  S DIC=%CIADIC(1),DIQ(0)=$P(%CIAARG,";")
  1.  S:DIQ(0)="" DIQ(0)="E"
  1.  K ^UTILITY("DIQ1",$J)
  1.  D
  1.  .N X,Y
  1.  .D EN^DIQ1
  1.  F %CIAX=0:0 S %CIAX=$O(%CIAZ1(%CIAX)),%CIAZ="" Q:'%CIAX  D
  1.  .F  S %CIAZ=$O(%CIAZ1(%CIAX,%CIAZ)),%CIAZ1="" Q:%CIAZ=""  D
  1.  ..F %CIAY="E","I" D
  1.  ...S:$D(^UTILITY("DIQ1",$J,+$P(%CIADIC,U,4),%CIAIEN,%CIAX,%CIAY)) %CIAZ1=%CIAZ1_$S($L(%CIAZ1):U,1:"")_^(%CIAY)
  1.  ..S @%CIAZ=%CIAZ1
  1.  Q
  1.  ; Edit existing entry
  1. 6 S DIC(0)=$P(%CIAARG,";"),DIC("P")=$P($P(%CIADIC,U,4),"|"),%CIAARG=$P(%CIAARG,";",2,999)
  1.  I %CIAIEN'>0 S %CIAIEN=-1 Q
  1.  S DIE=%CIADIC(1),DR=%CIAARG
  1.  L +@%CIADIC(2)@(%CIAIEN):$S(DIC(0)["!":9999999,1:0)
  1.  E  S %CIAIEN=-2 Q
  1.  D ^DIE
  1.  L -@%CIADIC(2)@(%CIAIEN)
  1.  S %CIAIEN=+$G(DA)
  1.  Q
  1.  ; Create new entry
  1. 7 N X,Y,DD,DO,DLAYGO
  1.  S DIC=%CIADIC(1),DIC(0)=$P(%CIAARG,";")_"L",DIC("P")=$P($P(%CIADIC,U,4),"|"),Y=$P(%CIAARG,";",2),%CIAARG=DIC(0)_";"_$P(%CIAARG,";",3,999),DLAYGO=DIC("P")\1
  1.  I +Y'=.01 S %CIAIEN=-1 Q
  1.  S X=$P(Y,"/",4)
  1.  S:X="" X=$P(Y,"/",5)
  1.  X:$E(X)=U $E(X,2,999)
  1.  I $P(^DD(+DIC("P"),.01,0),U,2)["W" D
  1.  .D WP
  1.  E  D ^DIC:DIC(0)'["U",FILE^DICN:DIC(0)["U"
  1.  S %CIAIEN=+Y
  1.  I %CIAIEN>0,$P(%CIAARG,";",2,99)'="" D DA,6
  1.  K DINUM
  1.  Q
  1. 8 ; Lookup entry
  1.  N %CIAOPT,%CIAP,CIAFN
  1.  S %CIAOPT=$P(%CIAARG,";"),%CIAARG=$P(%CIAARG,";",2,999),CIAFN=+$P(%CIADIC,U,4)
  1.  S %CIAP=+$P(%CIADIC,U,4),%CIAP=$P($G(^DD(%CIAP,.01,0)),U)
  1.  S:$L(%CIAP) %CIAP=%CIAP_": "
  1.  S %CIAIEN=$$ENTRY^CIAULKP(%CIADIC(2),%CIAOPT,%CIAP,"",%CIAARG,"","",$X,$Y,"","","HLP^CIAUDIC")
  1.  Q
  1.  ; Force DINUM
  1. 9 S DINUM=%CIAARG
  1.  Q
  1. HLP W $G(^DD(+CIAFN,.01,3)),!
  1.  Q
  1.  ; Word processing field (special case of #7)
  1. WP N %CIAZ,%CIAZ1
  1.  I X="@" D
  1.  .K @%CIADIC(2)
  1.  .S Y=0
  1.  E  D
  1.  .S %CIAZ=$G(@%CIADIC(2)@(0)),Y=$G(DINUM,1+$O(^($C(1)),-1))
  1.  .S %CIAZ1=+$P(%CIAZ,U,4),%CIAZ=+$P(%CIAZ,U,3)
  1.  .S:Y>%CIAZ %CIAZ=Y
  1.  .S:'$D(^(Y)) %CIAZ1=%CIAZ1+1
  1.  .S ^(0)=U_U_%CIAZ_U_%CIAZ1_U_$G(DT),^(Y,0)=X
  1.  Q:$P(^DD(+DIC("P"),.01,0),U,2)'["a"
  1.  S %CIAIEN=Y
  1.  D DA,WPAUDIT^CCCODAUD(+DIC("P"),.DA,X,"")
  1.  Q
  1.  ; Trap unexpected error
  1. ERROR S $P(%CIADIC,U)=-3
  1.  Q %CIADIC
  1.  ; Return field #
  1. FLD(X) Q $S(X=+X:X,1:+$O(^DD(+$P(%CIADIC,U,4),"B",X,0)))
  1.  ; Set up DA array
  1. DA N %CIAZ,%CIAZ1,%CIAZ2
  1.  K DA
  1.  S:'$G(%CIAIEN) %CIAIEN=$P(%CIADIC,U,3)
  1.  S %CIAZ=$P(%CIADIC,U,2),%CIAZ2=$L(%CIAZ,"|"),DA=%CIAIEN
  1.  F %CIAZ1=2:1:%CIAZ2 S DA(%CIAZ2-%CIAZ1+1)=+$P(%CIAZ,"|",%CIAZ1)
  1.  S %CIADIC(1)=U_$TR($P(%CIADIC,U,2),"|"),%CIADIC(2)=$E(%CIADIC(1),1,$L(%CIADIC(1))-1),%CIADIC(2)=%CIADIC(2)_$S(%CIADIC(2)["(":")",1:"")
  1.  Q