ACDVSAV2.m

ACDVSAV2 ;IHS/ADC/EDE/KML - BROKE UP ACDVSAVE;

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

 ;

V ;EP-V node

 ;//^ACDVSAVE

 S ACDVHIT=0

 Q:ACDPGM'=$G(^ACDVIS(ACDV,"BWP"))  ;  quit if not signon site

 I '$D(^ACDVIS(ACDV,0)) Q

 I $P(^ACDVIS(ACDV,0),U,25) Q

 I '$D(^ACDVIS(ACDV,"BWP")) Q

 S ACDBWP=^ACDVIS(ACDV,"BWP"),ACDBWP=$P(^ACDF5PI(ACDBWP,0),U),ACD6PGM=$P(^AUTTLOC(ACDBWP,0),U,10)

 S ACDUSER=$P(^AUTTLOC($P(^AUTTSITE(1,0),U),0),U,10)_"*"_ACD6PGM

 ;

 S ACD("V")=^ACDVIS(ACDV,0)

 S DIE="^ACDVIS(",DA=ACDV,DR="25///T" D DIE^ACDFMC

 S ^ACDVTMP(ACDUSER,ACDV,"V")=ACD("V")

 S ACDVHIT=1

 Q

CLN ;EP-Make pass to clean incomplete entries

 ;//^ACDVSAVE

 W !!,"Deleting incomplete visit data extracts."

 S ACDUSER="" F  S ACDUSER=$O(^ACDVTMP(ACDUSER)) Q:ACDUSER=""  F ACDV=0:0 S ACDV=$O(^ACDVTMP(ACDUSER,ACDV)) Q:'ACDV  I '$D(^(ACDV,"TDC")),'$D(^("IIF")),'$D(^("CS")) K ^ACDVTMP(ACDUSER,ACDV)

 Q

ACDVSAV2  ;IHS/ADC/EDE/KML - BROKE UP ACDVSAVE;

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

 +2       ;

V         ;EP-V node

 +1       ;//^ACDVSAVE

 +2        SET ACDVHIT=0

 +3       ;  quit if not signon site

           IF ACDPGM'=$GET(^ACDVIS(ACDV,"BWP"))

               QUIT 

 +4        IF '$DATA(^ACDVIS(ACDV,0))

               QUIT 

 +5        IF $PIECE(^ACDVIS(ACDV,0),U,25)

               QUIT 

 +6        IF '$DATA(^ACDVIS(ACDV,"BWP"))

               QUIT 

 +7        SET ACDBWP=^ACDVIS(ACDV,"BWP")

           SET ACDBWP=$PIECE(^ACDF5PI(ACDBWP,0),U)

           SET ACD6PGM=$PIECE(^AUTTLOC(ACDBWP,0),U,10)

 +8        SET ACDUSER=$PIECE(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),0),U,10)_"*"_ACD6PGM

 +9       ;

 +10       SET ACD("V")=^ACDVIS(ACDV,0)

 +11       SET DIE="^ACDVIS("

           SET DA=ACDV

           SET DR="25///T"

           DO DIE^ACDFMC

 +12       SET ^ACDVTMP(ACDUSER,ACDV,"V")=ACD("V")

 +13       SET ACDVHIT=1

 +14       QUIT 

CLN       ;EP-Make pass to clean incomplete entries

 +1       ;//^ACDVSAVE

 +2        WRITE !!,"Deleting incomplete visit data extracts."

 +3        SET ACDUSER=""

           FOR 

               SET ACDUSER=$ORDER(^ACDVTMP(ACDUSER))

               IF ACDUSER=""

                   QUIT 

               FOR ACDV=0:0

                   SET ACDV=$ORDER(^ACDVTMP(ACDUSER,ACDV))

                   IF 'ACDV

                       QUIT 

                   IF '$DATA(^(ACDV,"TDC"))

                       IF '$DATA(^("IIF"))

                           IF '$DATA(^("CS"))

                               KILL ^ACDVTMP(ACDUSER,ACDV)

 +4        QUIT