- DG53591C ;ALB/GN - DG*5.3*591 CLEANUP FOR PURGED DEPENDENT INCOME RESTORE; 3/17/04 12:26pm ; 8/2/04 3:50pm
- ;;5.3;Registration;**591,1015**;Aug 13, 1993;Build 21
- Q
- TEST ;
- S TESTING=1
- EN N DAT,DAT1,DAT2,DAT3,DA,DATA,GL,IEN
- S TESTING=+$G(TESTING)
- Q:'$D(^XTMP("DG53591A","DET R12"))
- M ^XTMP("DG53591A-SAVE","DET R12")=^XTMP("DG53591A","DET R12")
- S GL=$NA(^XTMP("DG53591A-SAVE","DET R12"))
- F S GL=$Q(@GL) Q:GL="" Q:$QS(GL,2)'="DET R12" D
- . K DA,DATA,EIN
- . S DAT=$P(@GL,":",3)
- . S DAT1=$P(DAT,"="),DAT2=$P(DAT,"=",2)
- . S DAT3=$P(DAT2," <")
- . S DA(1)=$P(DAT1,","),IEN=$P(DAT1,",",2)
- . Q:('DA(1))!('IEN)
- . S DATA(.01)=$P(DAT3,"^")
- . S DATA(.02)=$P(DAT3,"^",2)
- . S DATA(.03)=$P(DAT3,"^",3)
- . S DATA(.04)=$P(DAT3,"^",4)
- . I 'TESTING,$$ADD^DGENDBS(408.1275,.DA,.DATA,,IEN)
- Q
- DG53591C ;ALB/GN - DG*5.3*591 CLEANUP FOR PURGED DEPENDENT INCOME RESTORE; 3/17/04 12:26pm ; 8/2/04 3:50pm
- +1 ;;5.3;Registration;**591,1015**;Aug 13, 1993;Build 21
- +2 QUIT
- TEST ;
- +1 SET TESTING=1
- EN NEW DAT,DAT1,DAT2,DAT3,DA,DATA,GL,IEN
- +1 SET TESTING=+$GET(TESTING)
- +2 IF '$DATA(^XTMP("DG53591A","DET R12"))
- QUIT
- +3 MERGE ^XTMP("DG53591A-SAVE","DET R12")=^XTMP("DG53591A","DET R12")
- +4 SET GL=$NAME(^XTMP("DG53591A-SAVE","DET R12"))
- +5 FOR
- SET GL=$QUERY(@GL)
- IF GL=""
- QUIT
- IF $QSUBSCRIPT(GL,2)'="DET R12"
- QUIT
- Begin DoDot:1
- +6 KILL DA,DATA,EIN
- +7 SET DAT=$PIECE(@GL,":",3)
- +8 SET DAT1=$PIECE(DAT,"=")
- SET DAT2=$PIECE(DAT,"=",2)
- +9 SET DAT3=$PIECE(DAT2," <")
- +10 SET DA(1)=$PIECE(DAT1,",")
- SET IEN=$PIECE(DAT1,",",2)
- +11 IF ('DA(1))!('IEN)
- QUIT
- +12 SET DATA(.01)=$PIECE(DAT3,"^")
- +13 SET DATA(.02)=$PIECE(DAT3,"^",2)
- +14 SET DATA(.03)=$PIECE(DAT3,"^",3)
- +15 SET DATA(.04)=$PIECE(DAT3,"^",4)
- +16 IF 'TESTING
- IF $$ADD^DGENDBS(408.1275,.DA,.DATA,,IEN)
- End DoDot:1
- +17 QUIT