ACDAUTO2.m

ACDAUTO2 ;IHS/ADC/EDE/KML - update 'CS' entries duplicated from an original; 

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

 ;;

EN ;EP

 ;//ACDDIC

 ;

 ;Check for 'adding additional client services'

 Q:$G(DR)'="[ACD 1 (ACS)]"

 Q:'$G(ACDVISP)

 ;

 ;Check for original or duplicate

 Q:$P($G(^ACDVIS(ACDVISP,0)),U,9)

 ;

 ;List duplicates for user to see.

 F ACDUP=0:0 S ACDUP=$O(^ACDVIS("ADUP",ACDVISP,ACDUP)) Q:'ACDUP  D

 .S ACDUP(ACDUP)=""

 Q:'$O(ACDUP(0))

 W !!,"The following visits were duplicated from this original visit."

 F ACDUP=0:0 S ACDUP=$O(ACDUP(ACDUP)) Q:'ACDUP  W !,ACDUP

 W !!,*7,*7,"Shall I update them now with any changes you just made to",!,"the original visit?",!!

 S DIR(0)="S^1:YES;2:NO" D ^DIR

ACDAUTO2  ;IHS/ADC/EDE/KML - update 'CS' entries duplicated from an original; 

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

 +2       ;;

EN        ;EP

 +1       ;//ACDDIC

 +2       ;

 +3       ;Check for 'adding additional client services'

 +4        IF $GET(DR)'="[ACD 1 (ACS)]"

               QUIT 

 +5        IF '$GET(ACDVISP)

               QUIT 

 +6       ;

 +7       ;Check for original or duplicate

 +8        IF $PIECE($GET(^ACDVIS(ACDVISP,0)),U,9)

               QUIT 

 +9       ;

 +10      ;List duplicates for user to see.

 +11       FOR ACDUP=0:0

               SET ACDUP=$ORDER(^ACDVIS("ADUP",ACDVISP,ACDUP))

               IF 'ACDUP

                   QUIT 

               Begin DoDot:1

 +12               SET ACDUP(ACDUP)=""

               End DoDot:1

 +13       IF '$ORDER(ACDUP(0))

               QUIT 

 +14       WRITE !!,"The following visits were duplicated from this original visit."

 +15       FOR ACDUP=0:0

               SET ACDUP=$ORDER(ACDUP(ACDUP))

               IF 'ACDUP

                   QUIT 

               WRITE !,ACDUP

 +16       WRITE !!,*7,*7,"Shall I update them now with any changes you just made to",!,"the original visit?",!!

 +17       SET DIR(0)="S^1:YES;2:NO"

           DO ^DIR