SD53108P ;ALB/SWO CHECK OPTION SDACS CGATLIST;3.12.97
;;5.3;Scheduling,**108**;MAR 26,1997
EN ;FIND OPTION "SDACS CGATLIST"
D BMES^XPDUTL("Beginning cleanup of Option text")
S U="^",A1=$O(^DIC(19,"B","SDACS CGATLIST","")) I A1="" D G EX
. D BMES^XPDUTL("Option NOT found - no action necessary")
S A2=$G(^DIC(19,A1,0)) G:A2="" EX
S A3="capture stop code workload. Refer to the User manual, Volume II,",A4="Appendix, for further documentation."
I A3=$G(^DIC(19,A1,1,6,0))&(A4=$G(^DIC(19,A1,1,7,0))) D
. D BMES^XPDUTL("Correcting text in option: SDACS CGATLIST")
. S $P(^DIC(19,A1,1,0),U,3)=6,$P(^(0),U,4)=6
. S ^DIC(19,A1,1,6,0)=$E(A3,1,27)
. K ^DIC(19,A1,1,7,0)
E D
. D BMES^XPDUTL("Text previously modified. Site will need to update description manually.")
EX ;CLEAN UP
K A1,A2,A3,A4,U
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53108P 825 printed Dec 13, 2024@02:44:46 Page 2
SD53108P ;ALB/SWO CHECK OPTION SDACS CGATLIST;3.12.97
+1 ;;5.3;Scheduling,**108**;MAR 26,1997
EN ;FIND OPTION "SDACS CGATLIST"
+1 DO BMES^XPDUTL("Beginning cleanup of Option text")
+2 SET U="^"
SET A1=$ORDER(^DIC(19,"B","SDACS CGATLIST",""))
IF A1=""
Begin DoDot:1
+3 DO BMES^XPDUTL("Option NOT found - no action necessary")
End DoDot:1
GOTO EX
+4 SET A2=$GET(^DIC(19,A1,0))
if A2=""
GOTO EX
+5 SET A3="capture stop code workload. Refer to the User manual, Volume II,"
SET A4="Appendix, for further documentation."
+6 IF A3=$GET(^DIC(19,A1,1,6,0))&(A4=$GET(^DIC(19,A1,1,7,0)))
Begin DoDot:1
+7 DO BMES^XPDUTL("Correcting text in option: SDACS CGATLIST")
+8 SET $PIECE(^DIC(19,A1,1,0),U,3)=6
SET $PIECE(^(0),U,4)=6
+9 SET ^DIC(19,A1,1,6,0)=$EXTRACT(A3,1,27)
+10 KILL ^DIC(19,A1,1,7,0)
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 DO BMES^XPDUTL("Text previously modified. Site will need to update description manually.")
End DoDot:1
EX ;CLEAN UP
+1 KILL A1,A2,A3,A4,U
+2 QUIT