ADEUPD8.m

ADEUPD8 ;IHS/OIT/ENM - ADE6.0 PATCH 18 [ 09/17/2008  3:43 PM ]

 ;;6.0;ADE;**18**;SEP 17, 2008

 ;

UPDATE(ADEFILE,ADEFLDS,ADEWPFLD,ADEIENST,ADETGRTN,ADESETX) ;EP

 N ADEFDA

 S ADENFLDS=$L(ADEFLDS,","),ADEDONE=0,ADERPEAT=0,ADEN="",ADETXT=0

 F ADEI=1:1 S ADEX=$P($T(@$P(ADETGRTN,"^")+ADEI^@$P(ADETGRTN,"^",2)),";;",2) S:ADEX="***END***" ADEDONE=1 D  Q:ADEDONE

 .I ADEX[U!ADEDONE D  K ADETEXT S ADETXT=0 Q

 ..F  D  Q:ADERPEAT<2

 ...S ADELSTN=ADEN D:ADESETX'="" @ADESETX D:ADELSTN]"" FILE D SETFDA Q

 .Q:$G(ADEWPFLD)=""

 .S ADETXT=ADETXT+1,ADETEXT(ADETXT)=ADEX

 K ADECURX,ADEDONE,ADEI,ADEI1,ADELSTN,ADEN,ADEEND,ADENFLDS,ADERPEAT,ADESVX,ADESTART,ADETXT,ADETEXT,ADEX,ADEX1

 Q

 ;

SETFDA ;EP

 ; Corresponds to values in X: the first is the field that is set with the first piece, etc.  If a value isn't used to set a field

 ; nothing should be entered for that piece; should be left empty e.g. ".01,02,,.09"

 F ADEI1=1:1:ADENFLDS S ADEFLD=$P(ADEFLDS,",",ADEI1) I ADEFLD'="" S ADEX1=$P(ADEX,U,ADEI1) S:ADEX1'="" ADEFDA(ADEFILE,ADEIENST,ADEFLD)=ADEX1

 S ADEN=$P(ADEX,U)

 Q

 ;

FILE ;EP

 D UPDATE^DIE(,"ADEFDA","ADEIEN","ADEEMSG")

 K ADEFDA,ADEEMSG

 ; get the IEN assigned

 I +$G(ADEIEN(1)),$G(ADETEXT(1))'="" D WP^DIE(ADEFILE,ADEIEN(1)_",",ADEWPFLD,,"ADETEXT","ADEEMSG")

 K ADEEMSG,ADEIEN

 Q

 ;

DELETES(ADETGRTN,ADESETX,ADEDIK)       ;EP

 F ADEI=1:1 S ADEX=$P($T(@$P(ADETGRTN,"^")+ADEI^@$P(ADETGRTN,"^",2)),";;",2) Q:ADEX="***END***"  D

 . D:ADESETX'="" @ADESETX

 . I ADEX'="" S DA=ADEX,DIE=ADEDIK,DR=".08////3080917" D ^DIE

 . Q

 Q

ADEUPD8   ;IHS/OIT/ENM - ADE6.0 PATCH 18 [ 09/17/2008  3:43 PM ]

 +1       ;;6.0;ADE;**18**;SEP 17, 2008

 +2       ;

UPDATE(ADEFILE,ADEFLDS,ADEWPFLD,ADEIENST,ADETGRTN,ADESETX) ;EP

 +1        NEW ADEFDA

 +2        SET ADENFLDS=$LENGTH(ADEFLDS,",")

           SET ADEDONE=0

           SET ADERPEAT=0

           SET ADEN=""

           SET ADETXT=0

 +3        FOR ADEI=1:1

               SET ADEX=$PIECE($TEXT(@$PIECE(ADETGRTN,"^")+ADEI^@$PIECE(ADETGRTN,"^",2)),";;",2)

               IF ADEX="***END***"

                   SET ADEDONE=1

               Begin DoDot:1

 +4                IF ADEX[U!ADEDONE

                       Begin DoDot:2

 +5                        FOR 

                               Begin DoDot:3

 +6                                SET ADELSTN=ADEN

                                   IF ADESETX'=""

                                       DO @ADESETX

                                   IF ADELSTN]""

                                       DO FILE

                                   DO SETFDA

                                   QUIT 

                               End DoDot:3

                               IF ADERPEAT<2

                                   QUIT 

                       End DoDot:2

                       KILL ADETEXT

                       SET ADETXT=0

                       QUIT 

 +7                IF $GET(ADEWPFLD)=""

                       QUIT 

 +8                SET ADETXT=ADETXT+1

                   SET ADETEXT(ADETXT)=ADEX

               End DoDot:1

               IF ADEDONE

                   QUIT 

 +9        KILL ADECURX,ADEDONE,ADEI,ADEI1,ADELSTN,ADEN,ADEEND,ADENFLDS,ADERPEAT,ADESVX,ADESTART,ADETXT,ADETEXT,ADEX,ADEX1

 +10       QUIT 

 +11      ;

SETFDA    ;EP

 +1       ; Corresponds to values in X: the first is the field that is set with the first piece, etc.  If a value isn't used to set a field

 +2       ; nothing should be entered for that piece; should be left empty e.g. ".01,02,,.09"

 +3        FOR ADEI1=1:1:ADENFLDS

               SET ADEFLD=$PIECE(ADEFLDS,",",ADEI1)

               IF ADEFLD'=""

                   SET ADEX1=$PIECE(ADEX,U,ADEI1)

                   IF ADEX1'=""

                       SET ADEFDA(ADEFILE,ADEIENST,ADEFLD)=ADEX1

 +4        SET ADEN=$PIECE(ADEX,U)

 +5        QUIT 

 +6       ;

FILE      ;EP

 +1        DO UPDATE^DIE(,"ADEFDA","ADEIEN","ADEEMSG")

 +2        KILL ADEFDA,ADEEMSG

 +3       ; get the IEN assigned

 +4        IF +$GET(ADEIEN(1))

               IF $GET(ADETEXT(1))'=""

                   DO WP^DIE(ADEFILE,ADEIEN(1)_",",ADEWPFLD,,"ADETEXT","ADEEMSG")

 +5        KILL ADEEMSG,ADEIEN

 +6        QUIT 

 +7       ;

DELETES(ADETGRTN,ADESETX,ADEDIK) ;EP

 +1        FOR ADEI=1:1

               SET ADEX=$PIECE($TEXT(@$PIECE(ADETGRTN,"^")+ADEI^@$PIECE(ADETGRTN,"^",2)),";;",2)

               IF ADEX="***END***"

                   QUIT 

               Begin DoDot:1

 +2                IF ADESETX'=""

                       DO @ADESETX

 +3                IF ADEX'=""

                       SET DA=ADEX

                       SET DIE=ADEDIK

                       SET DR=".08////3080917"

                       DO ^DIE

 +4                QUIT 

               End DoDot:1

 +5        QUIT