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

AUM111R1.m

Go to the documentation of this file.
  1. AUM111R1 ;IHS/SD/RNB - ICD 9 CODES FOR FY 2012 ; [ 09/09/2010 8:30 AM ]
  1. ;;12.0;TABLE MAINTENANCE;;SEP 27,2011
  1. ;
  1. ADDFAIL D RSLT($J("",5)_$$M(0)_"ADD FAILED => "_L)
  1. Q
  1. DASH D RSLT(""),RSLT($$REPEAT^XLFSTR("-",$S($G(IOM):IOM-10,1:70))),RSLT("")
  1. Q
  1. DIE ;EP
  1. NEW @($P($T(SVARS^AUM111RL),";",3))
  1. LOCK +(@(DIE_DA_")")):10 E D RSLT($J("",5)_$$M(0)_"Entry '"_DIE_DA_"' IS LOCKED. NOTIFY PROGRAMMER.") S Y=1 Q
  1. D ^DIE LOCK -(@(DIE_DA_")")) KILL DA,DIE,DR
  1. Q
  1. DIK NEW @($P($T(SVARS^AUM111RL),";",3)) D ^DIK KILL DIK
  1. Q
  1. FILE NEW @($P($T(SVARS^AUM111RL),";",3)) K DD,DO S DIC(0)="L" D FILE^DICN KILL DIC
  1. Q
  1. M(%) Q $S(%=0:"ERROR : ",%=1:"NOT ADDED : ",1:"")
  1. MODOK D RSLT($J("",5)_"Changed : "_L)
  1. Q
  1. RSLT(%) S ^(0)=$G(^TMP("AUM2104",$J,0))+1,^(^(0))=% D MES(%)
  1. Q
  1. MES(%) NEW @($P($T(SVARS^AUM111RL),";",3)) D MES^XPDUTL(%)
  1. Q
  1. IXDIC(DIC,DIC0,D,X,DLAYGO,DINUM) ;EP
  1. NEW @($P($T(SVARS^AUM111RL),";",3))
  1. S DIC(0)=DIC0
  1. KILL DIC0
  1. I '$G(DLAYGO) KILL DLAYGO
  1. ;;I X[" " S X(1)=X,X=$P(X," ",1) ;X=+$G(X)
  1. I X[" " S X(1)=X
  1. D IX^DIC
  1. Q Y
  1. IXDIC2(DIC,DIC0,D,X,DLAYGO,DINUM) ;EP
  1. NEW @($P($T(SVARS^AUM111RL),";",3))
  1. S DIC(0)=DIC0
  1. KILL DIC0
  1. I '$G(DLAYGO) KILL DLAYGO
  1. I X[" " S X(1)=X
  1. D IX^DIC
  1. Q Y
  1. IXDIC3(DIC,DIC0,D,X,DLAYGO,DINUM) ;EP
  1. NEW @($P($T(SVARS^AUM111RL),";",3))
  1. S DIC(0)=DIC0
  1. KILL DIC0
  1. I '$G(DLAYGO) KILL DLAYGO
  1. I X[" " S X(1)=X,X=$P(X," ",1) ;X=+$G(X)
  1. D IX^DIC
  1. Q Y