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

AG45P7.m

Go to the documentation of this file.
  1. AG45P7 ; IHS/ADC/PDW -REGISTRATION V4.5 PATCH #7 ;
  1. ;;7.0;IHS PATIENT REGISTRATION;;MAR 28, 2003
  1. D AGFAC,AGSET
  1. W ! Q
  1. AGFAC ;MODIFIY AGFAC INPUT TEMPLATE
  1. S DA=$O(^DIE("B","AGFAC",0))
  1. I 'DA W !,"AGFAC INPUT TEMPLATE NOT FOUND",! Q
  1. S ^DIE(DA,"DR",1,9009061)=$P($T(TXT+1),";;",2)
  1. W !,"AGFAC INPUT TEMPLATE MODIFIED",!
  1. Q
  1. AGSET ;MODIFY AGSETSITE OPTION
  1. S DA=$O(^DIC(19,"B","AGSETSITE",0))
  1. I 'DA W !,"AGSETSITE OPTION NOT FOUND",! Q
  1. S ^DIC(19,DA,20)=$P($T(TXT+2),";;",2)
  1. W !,"AGSETSITE OPTION MODIFIED.",!
  1. Q
  1. TXT ;TEXT FOR AGFAC TEMPLATE
  1. ;;.01;1:20;19;I $P(^AGFAC(DUZ(2),0),U,20)'="Y" S Y="@1";99;@1;I $P(^AUTTSITE(1,0),U)'=DA S Y="@2";200;201;@2;
  1. ;;S X="AGSETSITE" D HDR^AG S:'$D(AGSADUZ2) AGSADUZ2=DUZ(2) D SET^XBSITE K DIC