ACDDIFF.m

ACDDIFF ;IHS/ADC/EDE/KML - remove DIFF reason;

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

EN ;EP

 ;//^ACDDIC

 ;This program will remove the difference reason from the

 ;^ACDIIF file or the ^ACDTDC file when the actual placement

 ;and recommended placement have been set the same via a edit.

 Q:'$D(ACDVISP)

 S ACDDA=$O(^ACDIIF("C",ACDVISP,0)) I ACDDA D

 .D ^ACDWIIF

 .I ACDPLAA=ACDPLAR,ACDPLAA1=ACDPLAR1,ACDDIF'="NONE" S DIE="^ACDIIF(",DA=ACDDA,DR="19///@" D DIE^ACDFMC W !!,"   *** Deleting invalid difference code now.",*7,*7

 .Q

 S ACDDA=$O(^ACDTDC("C",ACDVISP,0)) I ACDDA D

 .D ^ACDWTDC

 .I ACDPLAA=ACDPLAR,ACDPLAA1=ACDPLAR1,ACDDIF'="NONE" S DIE="^ACDTDC(",DA=ACDDA,DR="16///@" D DIE^ACDFMC W !!,"   *** Deleting invalid difference code now.",*7,*7

 .Q

ACDDIFF   ;IHS/ADC/EDE/KML - remove DIFF reason;

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

EN        ;EP

 +1       ;//^ACDDIC

 +2       ;This program will remove the difference reason from the

 +3       ;^ACDIIF file or the ^ACDTDC file when the actual placement

 +4       ;and recommended placement have been set the same via a edit.

 +5        IF '$DATA(ACDVISP)

               QUIT 

 +6        SET ACDDA=$ORDER(^ACDIIF("C",ACDVISP,0))

           IF ACDDA

               Begin DoDot:1

 +7                DO ^ACDWIIF

 +8                IF ACDPLAA=ACDPLAR

                       IF ACDPLAA1=ACDPLAR1

                           IF ACDDIF'="NONE"

                               SET DIE="^ACDIIF("

                               SET DA=ACDDA

                               SET DR="19///@"

                               DO DIE^ACDFMC

                               WRITE !!,"   *** Deleting invalid difference code now.",*7,*7

 +9                QUIT 

               End DoDot:1

 +10       SET ACDDA=$ORDER(^ACDTDC("C",ACDVISP,0))

           IF ACDDA

               Begin DoDot:1

 +11               DO ^ACDWTDC

 +12               IF ACDPLAA=ACDPLAR

                       IF ACDPLAA1=ACDPLAR1

                           IF ACDDIF'="NONE"

                               SET DIE="^ACDTDC("

                               SET DA=ACDDA

                               SET DR="16///@"

                               DO DIE^ACDFMC

                               WRITE !!,"   *** Deleting invalid difference code now.",*7,*7

 +13               QUIT 

               End DoDot:1