AG45P7 ; IHS/ADC/PDW -REGISTRATION V4.5 PATCH #7 ;
;;7.0;IHS PATIENT REGISTRATION;;MAR 28, 2003
D AGFAC,AGSET
W ! Q
AGFAC ;MODIFIY AGFAC INPUT TEMPLATE
S DA=$O(^DIE("B","AGFAC",0))
I 'DA W !,"AGFAC INPUT TEMPLATE NOT FOUND",! Q
S ^DIE(DA,"DR",1,9009061)=$P($T(TXT+1),";;",2)
W !,"AGFAC INPUT TEMPLATE MODIFIED",!
Q
AGSET ;MODIFY AGSETSITE OPTION
S DA=$O(^DIC(19,"B","AGSETSITE",0))
I 'DA W !,"AGSETSITE OPTION NOT FOUND",! Q
S ^DIC(19,DA,20)=$P($T(TXT+2),";;",2)
W !,"AGSETSITE OPTION MODIFIED.",!
Q
TXT ;TEXT FOR AGFAC TEMPLATE
;;.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;
;;S X="AGSETSITE" D HDR^AG S:'$D(AGSADUZ2) AGSADUZ2=DUZ(2) D SET^XBSITE K DIC
AG45P7 ; IHS/ADC/PDW -REGISTRATION V4.5 PATCH #7 ;
+1 ;;7.0;IHS PATIENT REGISTRATION;;MAR 28, 2003
+2 DO AGFAC
DO AGSET
+3 WRITE !
QUIT
AGFAC ;MODIFIY AGFAC INPUT TEMPLATE
+1 SET DA=$ORDER(^DIE("B","AGFAC",0))
+2 IF 'DA
WRITE !,"AGFAC INPUT TEMPLATE NOT FOUND",!
QUIT
+3 SET ^DIE(DA,"DR",1,9009061)=$PIECE($TEXT(TXT+1),";;",2)
+4 WRITE !,"AGFAC INPUT TEMPLATE MODIFIED",!
+5 QUIT
AGSET ;MODIFY AGSETSITE OPTION
+1 SET DA=$ORDER(^DIC(19,"B","AGSETSITE",0))
+2 IF 'DA
WRITE !,"AGSETSITE OPTION NOT FOUND",!
QUIT
+3 SET ^DIC(19,DA,20)=$PIECE($TEXT(TXT+2),";;",2)
+4 WRITE !,"AGSETSITE OPTION MODIFIED.",!
+5 QUIT
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;
+2 ;;S X="AGSETSITE" D HDR^AG S:'$D(AGSADUZ2) AGSADUZ2=DUZ(2) D SET^XBSITE K DIC