VPSDDCU.m

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 ---VPSDDCU   546     printed  Apr 09, 2024@21:45:44                                                                                                                                                                                                      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