VPSDDCU ;WOIFO/KC - DD clean up;1/15/15 11:26
;;1.0;VA POINT OF SERVICE (KIOSKS);**3**;Jan 15, 2015;Build 64
;;Per VHA Directive 2004-038, this routine should not be modified.
;
QUIT
;
; Remove fields that are obsolute
REMOVE ;
S DIK="^DD(853.54,",DA=30,DA(1)=853.54
D ^DIK
S DIK="^DD(853.54,",DA=31,DA(1)=853.54
D ^DIK
S DIK="^DD(853.54,",DA=32,DA(1)=853.54
D ^DIK
S DIK="^DD(853.52,",DA=12,DA(1)=853.52
D ^DIK
S DIK="^DD(853.52,",DA=13,DA(1)=853.52
D ^DIK
S DIK="^DD(853.52,",DA=14,DA(1)=853.52
D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPSDDCU 546 printed Dec 13, 2024@02:43:01 Page 2
VPSDDCU ;WOIFO/KC - DD clean up;1/15/15 11:26
+1 ;;1.0;VA POINT OF SERVICE (KIOSKS);**3**;Jan 15, 2015;Build 64
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; Remove fields that are obsolute
REMOVE ;
+1 SET DIK="^DD(853.54,"
SET DA=30
SET DA(1)=853.54
+2 DO ^DIK
+3 SET DIK="^DD(853.54,"
SET DA=31
SET DA(1)=853.54
+4 DO ^DIK
+5 SET DIK="^DD(853.54,"
SET DA=32
SET DA(1)=853.54
+6 DO ^DIK
+7 SET DIK="^DD(853.52,"
SET DA=12
SET DA(1)=853.52
+8 DO ^DIK
+9 SET DIK="^DD(853.52,"
SET DA=13
SET DA(1)=853.52
+10 DO ^DIK
+11 SET DIK="^DD(853.52,"
SET DA=14
SET DA(1)=853.52
+12 DO ^DIK
+13 QUIT
