ACDPSRV2.m

ACDPSRV2 ;IHS/ADC/EDE/KML - BUILD ENTRIES FROM IMPORTED GLOBAL ACDPTMP; 

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

 ;;

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

 ;Build CDMIS data files on area/HQ machine from the ^ACDPTMP global

 ;that has just been imported to the area/HQ machine

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

EN ;EP

 ;//^ACDPSRV1

 ;Check for existence of data

 I '$D(^ACDPTMP) Q

 ;

 ;Validate incomming ASUFAC's are in the area location file

 ;ACDUSER is in the form 'DUZ(2)^PROGRAM ASSOCIATED WITH VISIT'

 K ACDQUIT S ACDUSER="" F  S ACDUSER=$O(^ACDPTMP(ACDUSER)) Q:ACDUSER=""  I $P(ACDUSER,"*")=ACDHEAD(3),'$O(^AUTTLOC("C",$P(ACDUSER,"*",2),0)) S ACDQUIT=1 Q

 ;

 I $D(ACDQUIT) S ^ACDP1TMP=1 Q

 ;

 ;

RBL ;

 ;Rebuild program data here.

 S ACDUSER="" F  S ACDUSER=$O(^ACDPTMP(ACDUSER)) Q:ACDUSER=""  I $P(ACDUSER,"*")=ACDHEAD(3) D

 .S ACDA=$O(^AUTTLOC("C",$P(ACDUSER,"*",2),0))

 .;

 .;Delete original entry if it exists

 .S DA=ACDA,DIK="^ACDQAN(" D ^DIK

 .L +^ACDQAN(ACDA):0 ;    lock not needed/done for verification only

 .; locking non-existent entry, users locked out

 .;

 .S %Y="^ACDQAN("_ACDA_","

 .S %X="^ACDPTMP("""_ACDUSER_""","

 .D %XY^%RCR

 .;

 .;Reset .01 because it is dinumed

 .S $P(^ACDQAN(ACDA,0),U)=ACDA

 .K ^ACDPTMP(ACDUSER)

 .L -^ACDQAN(ACDA)

 .Q

 ;

RDX ;

 ;Re-index all entries for B index

 K ^ACDQAN("B")

 S DIK(1)=".01^B"

 S DIK="^ACDQAN("

 D ENALL^DIK

 ;

 I $D(^ACDP1TMP) W !!,"Since this import is finished, now killing the ^ACDP1TMP global flag." K ^ACDP1TMP ;    kill of scratch global  SAC EXEMPTION (2.3.2.3  KILLING of unsubscripted globals is prohibited)

K ;

ACDPSRV2  ;IHS/ADC/EDE/KML - BUILD ENTRIES FROM IMPORTED GLOBAL ACDPTMP; 

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

 +2       ;;

 +3       ;******************************************************************

 +4       ;Build CDMIS data files on area/HQ machine from the ^ACDPTMP global

 +5       ;that has just been imported to the area/HQ machine

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

EN        ;EP

 +1       ;//^ACDPSRV1

 +2       ;Check for existence of data

 +3        IF '$DATA(^ACDPTMP)

               QUIT 

 +4       ;

 +5       ;Validate incomming ASUFAC's are in the area location file

 +6       ;ACDUSER is in the form 'DUZ(2)^PROGRAM ASSOCIATED WITH VISIT'

 +7        KILL ACDQUIT

           SET ACDUSER=""

           FOR 

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

               IF ACDUSER=""

                   QUIT 

               IF $PIECE(ACDUSER,"*")=ACDHEAD(3)

                   IF '$ORDER(^AUTTLOC("C",$PIECE(ACDUSER,"*",2),0))

                       SET ACDQUIT=1

                       QUIT 

 +8       ;

 +9        IF $DATA(ACDQUIT)

               SET ^ACDP1TMP=1

               QUIT 

 +10      ;

 +11      ;

RBL       ;

 +1       ;Rebuild program data here.

 +2        SET ACDUSER=""

           FOR 

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

               IF ACDUSER=""

                   QUIT 

               IF $PIECE(ACDUSER,"*")=ACDHEAD(3)

                   Begin DoDot:1

 +3                    SET ACDA=$ORDER(^AUTTLOC("C",$PIECE(ACDUSER,"*",2),0))

 +4       ;

 +5       ;Delete original entry if it exists

 +6                    SET DA=ACDA

                       SET DIK="^ACDQAN("

                       DO ^DIK

 +7       ;    lock not needed/done for verification only

                       LOCK +^ACDQAN(ACDA):0

 +8       ; locking non-existent entry, users locked out

 +9       ;

 +10                   SET %Y="^ACDQAN("_ACDA_","

 +11                   SET %X="^ACDPTMP("""_ACDUSER_""","

 +12                   DO %XY^%RCR

 +13      ;

 +14      ;Reset .01 because it is dinumed

 +15                   SET $PIECE(^ACDQAN(ACDA,0),U)=ACDA

 +16                   KILL ^ACDPTMP(ACDUSER)

 +17                   LOCK -^ACDQAN(ACDA)

 +18                   QUIT 

                   End DoDot:1

 +19      ;

RDX       ;

 +1       ;Re-index all entries for B index

 +2        KILL ^ACDQAN("B")

 +3        SET DIK(1)=".01^B"

 +4        SET DIK="^ACDQAN("

 +5        DO ENALL^DIK

 +6       ;

 +7       ;    kill of scratch global  SAC EXEMPTION (2.3.2.3  KILLING of unsubscripted globals is prohibited)

           IF $DATA(^ACDP1TMP)

               WRITE !!,"Since this import is finished, now killing the ^ACDP1TMP global flag."

               KILL ^ACDP1TMP

K         ;