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

AEDPAT.m

Go to the documentation of this file.
  1. AEDPAT ; EDITS FOR PATIENT FILE [ 04/15/85 1:25 PM ]
  1. ;
  1. NAME ; NAMES OF PEOPLE
  1. F L=1:1:$L(X) Q:'$D(X) S %Z=$F(X," ",L),%ZZ=$F(X,",,") S:($E(X,%Z-2)=",")!($E(X,%Z)'?.AN)!(%Z>$L(X)) X=$E(X,1,%Z-2)_$E(X,%Z,99),L=L-1 S:%ZZ X=$E(X,1,%ZZ-2)_$E(X,%ZZ,99) K:X?.E1"," X
  1. Q
  1. ;
  1. VI1301 ;
  1. S IHSX=X,X1=$P(DO,U,3),X2=+60,X=""
  1. D C^%DTC
  1. S IHSY=X,X=IHSX
  1. I X>IHSY K X Q
  1. S IHSX=X,X1=$P(DO,U,3),X2=+1,X=""
  1. D C^%DTC
  1. S IHSY=X,X=IHSX
  1. K:X<IHSY X
  1. Q
  1. Q
  1. EX01 ;
  1. S DR=1101,DIC=9001
  1. D ^IUDICLK
  1. Q:$D(LKERR)
  1. K:LKDATA'="F"&(X="PELVIC EXAM")
  1. Q
  1. SK02 ;
  1. S DR=.03,DIC=9001.6144,DRENT=0
  1. D ^IUDICLK
  1. Q:$D(LKERR)
  1. K:X'="P"&(LKDATA>10) X
  1. Q
  1. SK03 ;
  1. S DR=.02,DIC=9001.6144,DRENT=0
  1. D ^IUDICLK
  1. Q:$D(LKERR)
  1. K:X>10&(LKDATA'="P") X
  1. Q
  1. END ;