ACDPIMP1.m

ACDPIMP1 ;IHS/ADC/EDE/KML - build entries from imported global; 

 ;;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

 ;//ACDPIMP

 ;Check for existence of data

 I '$D(^ACDPTMP) W !,"No data to import..." Q

 ;

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

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

 ;

 W !! K ACDQUIT S ACDUSER="" F  S ACDUSER=$O(^ACDPTMP(ACDUSER)) Q:ACDUSER=""  W !,"Checking for the existence of ASUFAC: ",$P(ACDUSER,"*",2)," in your location file." I '$O(^AUTTLOC("C",$P(ACDUSER,"*",2),0)) S ACDQUIT=1 W *7," Missing.",!

 I $D(ACDQUIT) W !!,"Aborted...Contact your site manager immediately.." S ^ACDP1TMP=1 Q

 E  W !!,"All facility codes exist. Proceeding with rebuild...",!

 ;

 ;

RBL ;

 ;Rebuild program data here.

 S ACDUSER=""  F  S ACDUSER=$O(^ACDPTMP(ACDUSER)) Q:ACDUSER=""  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

 .L -^ACDQAN(ACDA)

 ;

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 ;

 K ^ACDPTMP ;       kill of scratch global

 Q

ACDPIMP1  ;IHS/ADC/EDE/KML - build entries from imported global; 

 +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       ;//ACDPIMP

 +2       ;Check for existence of data

 +3        IF '$DATA(^ACDPTMP)

               WRITE !,"No data to import..."

               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       ;

 +8        WRITE !!

           KILL ACDQUIT

           SET ACDUSER=""

           FOR 

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

               IF ACDUSER=""

                   QUIT 

               WRITE !,"Checking for the existence of ASUFAC: ",$PIECE(ACDUSER,"*",2)," in your location file."

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

                   SET ACDQUIT=1

                   WRITE *7," Missing.",!

 +9        IF $DATA(ACDQUIT)

               WRITE !!,"Aborted...Contact your site manager immediately.."

               SET ^ACDP1TMP=1

               QUIT 

 +10      IF '$TEST

               WRITE !!,"All facility codes exist. Proceeding with rebuild...",!

 +11      ;

 +12      ;

RBL       ;

 +1       ;Rebuild program data here.

 +2        SET ACDUSER=""

           FOR 

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

               IF ACDUSER=""

                   QUIT 

               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               LOCK -^ACDQAN(ACDA)

               End DoDot:1

 +17      ;

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         ;

 +1       ;       kill of scratch global

           KILL ^ACDPTMP

 +2        QUIT