ACDCKIN.m

ACDCKIN ;IHS/ADC/EDE/KML - CHECK FOR DUP INIT CONTACT BY COMPONENT;

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

 ;*************************************************************

 ;DA is defined at ^ACDVIS(DA,0) DO NOT change DA value!!

 ;ACDDFNP is client pointer

 ;ACDCOMC is component pointer

 ;*****************************************************************

EN ;EP

 ;//[ACD1 (ADD)]

 K ACDCKIN

 F ACDDA=0:0 S ACDDA=$O(^ACDVIS("D",ACDDFNP,ACDDA)) Q:'ACDDA  I ACDDA'=DA S ACDN0=^ACDVIS(ACDDA,0) I $P(ACDN0,U,2)=ACDCOMC,$P(ACDN0,U,4)="IN" G WARN

 Q

WARN ;Issue warning message

 S ACDCKIN=1,ACDONCE=1

 W !!,*7,*7,"** Warning, this client has at least one previous 'initial ??' contact",!?3,"for component code: ",$P(^ACDCOMP(ACDCOMC,0),U)

 K ACDDFNP,ACDCOMC,ACDN0

ACDCKIN   ;IHS/ADC/EDE/KML - CHECK FOR DUP INIT CONTACT BY COMPONENT;

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

 +2       ;*************************************************************

 +3       ;DA is defined at ^ACDVIS(DA,0) DO NOT change DA value!!

 +4       ;ACDDFNP is client pointer

 +5       ;ACDCOMC is component pointer

 +6       ;*****************************************************************

EN        ;EP

 +1       ;//[ACD1 (ADD)]

 +2        KILL ACDCKIN

 +3        FOR ACDDA=0:0

               SET ACDDA=$ORDER(^ACDVIS("D",ACDDFNP,ACDDA))

               IF 'ACDDA

                   QUIT 

               IF ACDDA'=DA

                   SET ACDN0=^ACDVIS(ACDDA,0)

                   IF $PIECE(ACDN0,U,2)=ACDCOMC

                       IF $PIECE(ACDN0,U,4)="IN"

                           GOTO WARN

 +4        QUIT 

WARN      ;Issue warning message

 +1        SET ACDCKIN=1

           SET ACDONCE=1

 +2        WRITE !!,*7,*7,"** Warning, this client has at least one previous 'initial ??' contact",!?3,"for component code: ",$PIECE(^ACDCOMP(ACDCOMC,0),U)

 +3        KILL ACDDFNP,ACDCOMC,ACDN0