ACDVSRV2.m

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

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

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

 ;Variable ACDHEAD(3) is used to restrict the server to acting only

 ;on its own entries in the ^ACDVTMP global. This means then multiple

 ;servers may all be running at the same time.

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

 ;

EN ;EP

 ;//^ACDVSRV1

 ;

 ;

 ;Check to see if all incoming ASUFAC belonging to the server nodes

 ;are in the location file. If not, set flag and quit.

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

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

 ;

 S ACDUSER="" F  S ACDUSER=$O(^ACDVTMP(ACDUSER)) Q:ACDUSER=""  I $P(ACDUSER,"*")=ACDHEAD(3) F ACDV=0:0 S ACDV=$O(^ACDVTMP(ACDUSER,ACDV)) Q:'ACDV  D:$D(^(ACDV,"P")) L I $D(^ACDVTMP(ACDUSER,ACDV,"V")) S ACD("V")=^("V") D FILEV,L

 I $D(^ACDV1TMP) K ^ACDV1TMP ;   kill of scratch global  SAC EXEMPTION (2.3.2.3  killing of unsubscripted globals is prohibited)

 Q

L ;Get data from link files

 I $D(^ACDVTMP(ACDUSER,ACDV,"P")) D P Q

 I $D(^ACDVTMP(ACDUSER,ACDV,"IIF")) D IIF Q

 I $D(^ACDVTMP(ACDUSER,ACDV,"TDC")) D TDC Q

 I $D(^ACDVTMP(ACDUSER,ACDV,"CS")) D CS Q

 Q

IIF ;Get entry to file into ^ACDIIF

 F ACDDA=0:0 S ACDDA=$O(^ACDVTMP(ACDUSER,ACDV,"IIF",ACDDA)) Q:'ACDDA  S ACD("IIF")=^(ACDDA) D FILEIIF

 Q

TDC ;Get entry to file into ^ACDTDC

 F ACDDA=0:0 S ACDDA=$O(^ACDVTMP(ACDUSER,ACDV,"TDC",ACDDA)) Q:'ACDDA  S ACD("TDC")=^(ACDDA) D FILETDC

 Q

CS ;Get entry to file into ^ACDCS

 F ACDDA=0:0 S ACDDA=$O(^ACDVTMP(ACDUSER,ACDV,"CS",ACDDA)) Q:'ACDDA  S ACD("CS")=^(ACDDA) D FILECS

 Q

P ;Get entry to file into ^ACDPD

 S ACD("P")=^ACDVTMP(ACDUSER,ACDV,"P") D FILEP

 Q

FILEIIF ;File entry into ^ACDIIF

 S DIC="^ACDIIF(",X=$P(ACD("IIF"),U),DIC(0)="L" D FILE^ACDFMC

 S ^ACDIIF(+Y,0)=ACD("IIF"),^("BWP")=ACDBWP

 S ACDIIF=+Y

 F ACDRUG=0:0 S ACDRUG=$O(^ACDVTMP(ACDUSER,ACDV,"IIF",ACDDA,"DRUG",ACDRUG)) Q:'ACDRUG  D

 .S DA(1)=ACDIIF,DIC="^ACDIIF("_DA(1)_",2,",DIC(0)="L",X=ACDRUG S:'$D(@(DIC_"0)")) @(DIC_"0)")="^9002170.05PA" D FILE^ACDFMC

 .K ^ACDVTMP(ACDUSER,ACDV,"IIF",ACDDA,"DRUG",ACDRUG)

 S DA=ACDIIF,DIK="^ACDIIF(" D IX1^DIK

 K ^ACDVTMP(ACDUSER,ACDV,"IIF",ACDDA)

 Q

FILETDC ;File entry into ^ACDTDC

 S DIC="^ACDTDC(",X=$P(ACD("TDC"),U),DIC(0)="L" D FILE^ACDFMC

 S ^ACDTDC(+Y,0)=ACD("TDC"),^("BWP")=ACDBWP

 S ACDTDC=+Y

 F ACDRUG=0:0 S ACDRUG=$O(^ACDVTMP(ACDUSER,ACDV,"TDC",ACDDA,"DRUG",ACDRUG)) Q:'ACDRUG  D

 .S DA(1)=ACDTDC,DIC="^ACDTDC("_DA(1)_",2,",DIC(0)="L",X=ACDRUG S:'$D(@(DIC_"0)")) @(DIC_"0)")="^9002171.02PA" D FILE^ACDFMC

 .K ^ACDVTMP(ACDUSER,ACDV,"TDC",ACDDA,"DRUG",ACDRUG)

 S DA=ACDTDC,DIK="^ACDTDC(" D IX1^DIK

 K ^ACDVTMP(ACDUSER,ACDV,"TDC",ACDDA)

 Q

FILECS ;File entry into ^ACDCS

 S DIC="^ACDCS(",X=$P(ACD("CS"),U),DIC(0)="L" D FILE^ACDFMC

 S ^ACDCS(+Y,0)=ACD("CS"),^("BWP")=ACDBWP

 S ACDCS=+Y

 K ^ACDVTMP(ACDUSER,ACDV,"CS",ACDDA)

 S DA=ACDCS,DIK="^ACDCS(" D IX1^DIK

 Q

FILEV ;File visit into ^ACDVIS

 S DIC="^ACDVIS(",X=$P(ACD("V"),U),DIC(0)="L" D FILE^ACDFMC

 S ^ACDVIS(+Y,0)=ACD("V")

 S ACDBWP=+Y

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

 I '$D(^ACDF5PI(ACDPG,0)) S DIC="^ACDF5PI(",DIC(0)="L",X=ACDPG,DINUM=X D FILE^ACDFMC

 S DIE="^ACDVIS(",DA=ACDBWP,DR="99.99///^S X=ACDPG" D DIE^ACDFMC

 S DA=ACDBWP,DIK="^ACDVIS(" D IX1^DIK

 K ^ACDVTMP(ACDUSER,ACDV,"V")

 Q

FILEP ;File entry into ^ACDPD

 S DIC="^ACDPD(",X=$P(ACD("P"),U),DIC(0)="L" D FILE^ACDFMC

 S ^ACDPD(+Y,0)=ACD("P")

 S ACDP=+Y

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

 I '$D(^ACDF5PI(ACDPG,0)) S DIC="^ACDF5PI(",DIC(0)="L",X=ACDPG,DINUM=X D FILE^ACDFMC

 S DIE="^ACDPD(",DA=ACDP,DR="3///^S X=ACDPG" D DIE^ACDFMC

 F ACDAY=0:0 S ACDAY=$O(^ACDVTMP(ACDUSER,ACDV,"P","DAY",ACDAY)) Q:'ACDAY  S ACD("P")=^(ACDAY) D

 .S DA(1)=ACDP,DIC="^ACDPD("_DA(1)_",1,",DIC(0)="L",X=ACDAY S:'$D(@(DIC_"0)")) @(DIC_"0)")="^9002170.75A" D FILE^ACDFMC S ^ACDPD(ACDP,1,+Y,0)=ACD("P")

 .K ^ACDVTMP(ACDUSER,ACDV,"P","DAY",ACDAY)

 S DA=ACDP,DIK="^ACDPD(" D IX1^DIK

 K ^ACDVTMP(ACDUSER,ACDV,"P")

 Q

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

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

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

 +3       ;Variable ACDHEAD(3) is used to restrict the server to acting only

 +4       ;on its own entries in the ^ACDVTMP global. This means then multiple

 +5       ;servers may all be running at the same time.

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

 +7       ;

EN        ;EP

 +1       ;//^ACDVSRV1

 +2       ;

 +3       ;

 +4       ;Check to see if all incoming ASUFAC belonging to the server nodes

 +5       ;are in the location file. If not, set flag and quit.

 +6        KILL ACDQUIT

           SET ACDUSER=""

           FOR 

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

               IF ACDUSER=""

                   QUIT 

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

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

                       SET ACDQUIT=1

                       QUIT 

 +7        IF $DATA(ACDQUIT)

               SET ^ACDV1TMP=1

               QUIT 

 +8       ;

 +9        SET ACDUSER=""

           FOR 

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

               IF ACDUSER=""

                   QUIT 

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

                   FOR ACDV=0:0

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

                       IF 'ACDV

                           QUIT 

                       IF $DATA(^(ACDV,"P"))

                           DO L

                       IF $DATA(^ACDVTMP(ACDUSER,ACDV,"V"))

                           SET ACD("V")=^("V")

                           DO FILEV

                           DO L

 +10      ;   kill of scratch global  SAC EXEMPTION (2.3.2.3  killing of unsubscripted globals is prohibited)

           IF $DATA(^ACDV1TMP)

               KILL ^ACDV1TMP

 +11       QUIT 

L         ;Get data from link files

 +1        IF $DATA(^ACDVTMP(ACDUSER,ACDV,"P"))

               DO P

               QUIT 

 +2        IF $DATA(^ACDVTMP(ACDUSER,ACDV,"IIF"))

               DO IIF

               QUIT 

 +3        IF $DATA(^ACDVTMP(ACDUSER,ACDV,"TDC"))

               DO TDC

               QUIT 

 +4        IF $DATA(^ACDVTMP(ACDUSER,ACDV,"CS"))

               DO CS

               QUIT 

 +5        QUIT 

IIF       ;Get entry to file into ^ACDIIF

 +1        FOR ACDDA=0:0

               SET ACDDA=$ORDER(^ACDVTMP(ACDUSER,ACDV,"IIF",ACDDA))

               IF 'ACDDA

                   QUIT 

               SET ACD("IIF")=^(ACDDA)

               DO FILEIIF

 +2        QUIT 

TDC       ;Get entry to file into ^ACDTDC

 +1        FOR ACDDA=0:0

               SET ACDDA=$ORDER(^ACDVTMP(ACDUSER,ACDV,"TDC",ACDDA))

               IF 'ACDDA

                   QUIT 

               SET ACD("TDC")=^(ACDDA)

               DO FILETDC

 +2        QUIT 

CS        ;Get entry to file into ^ACDCS

 +1        FOR ACDDA=0:0

               SET ACDDA=$ORDER(^ACDVTMP(ACDUSER,ACDV,"CS",ACDDA))

               IF 'ACDDA

                   QUIT 

               SET ACD("CS")=^(ACDDA)

               DO FILECS

 +2        QUIT 

P         ;Get entry to file into ^ACDPD

 +1        SET ACD("P")=^ACDVTMP(ACDUSER,ACDV,"P")

           DO FILEP

 +2        QUIT 

FILEIIF   ;File entry into ^ACDIIF

 +1        SET DIC="^ACDIIF("

           SET X=$PIECE(ACD("IIF"),U)

           SET DIC(0)="L"

           DO FILE^ACDFMC

 +2        SET ^ACDIIF(+Y,0)=ACD("IIF")

           SET ^("BWP")=ACDBWP

 +3        SET ACDIIF=+Y

 +4        FOR ACDRUG=0:0

               SET ACDRUG=$ORDER(^ACDVTMP(ACDUSER,ACDV,"IIF",ACDDA,"DRUG",ACDRUG))

               IF 'ACDRUG

                   QUIT 

               Begin DoDot:1

 +5                SET DA(1)=ACDIIF

                   SET DIC="^ACDIIF("_DA(1)_",2,"

                   SET DIC(0)="L"

                   SET X=ACDRUG

                   IF '$DATA(@(DIC_"0)"))

                       SET @(DIC_"0)")="^9002170.05PA"

                   DO FILE^ACDFMC

 +6                KILL ^ACDVTMP(ACDUSER,ACDV,"IIF",ACDDA,"DRUG",ACDRUG)

               End DoDot:1

 +7        SET DA=ACDIIF

           SET DIK="^ACDIIF("

           DO IX1^DIK

 +8        KILL ^ACDVTMP(ACDUSER,ACDV,"IIF",ACDDA)

 +9        QUIT 

FILETDC   ;File entry into ^ACDTDC

 +1        SET DIC="^ACDTDC("

           SET X=$PIECE(ACD("TDC"),U)

           SET DIC(0)="L"

           DO FILE^ACDFMC

 +2        SET ^ACDTDC(+Y,0)=ACD("TDC")

           SET ^("BWP")=ACDBWP

 +3        SET ACDTDC=+Y

 +4        FOR ACDRUG=0:0

               SET ACDRUG=$ORDER(^ACDVTMP(ACDUSER,ACDV,"TDC",ACDDA,"DRUG",ACDRUG))

               IF 'ACDRUG

                   QUIT 

               Begin DoDot:1

 +5                SET DA(1)=ACDTDC

                   SET DIC="^ACDTDC("_DA(1)_",2,"

                   SET DIC(0)="L"

                   SET X=ACDRUG

                   IF '$DATA(@(DIC_"0)"))

                       SET @(DIC_"0)")="^9002171.02PA"

                   DO FILE^ACDFMC

 +6                KILL ^ACDVTMP(ACDUSER,ACDV,"TDC",ACDDA,"DRUG",ACDRUG)

               End DoDot:1

 +7        SET DA=ACDTDC

           SET DIK="^ACDTDC("

           DO IX1^DIK

 +8        KILL ^ACDVTMP(ACDUSER,ACDV,"TDC",ACDDA)

 +9        QUIT 

FILECS    ;File entry into ^ACDCS

 +1        SET DIC="^ACDCS("

           SET X=$PIECE(ACD("CS"),U)

           SET DIC(0)="L"

           DO FILE^ACDFMC

 +2        SET ^ACDCS(+Y,0)=ACD("CS")

           SET ^("BWP")=ACDBWP

 +3        SET ACDCS=+Y

 +4        KILL ^ACDVTMP(ACDUSER,ACDV,"CS",ACDDA)

 +5        SET DA=ACDCS

           SET DIK="^ACDCS("

           DO IX1^DIK

 +6        QUIT 

FILEV     ;File visit into ^ACDVIS

 +1        SET DIC="^ACDVIS("

           SET X=$PIECE(ACD("V"),U)

           SET DIC(0)="L"

           DO FILE^ACDFMC

 +2        SET ^ACDVIS(+Y,0)=ACD("V")

 +3        SET ACDBWP=+Y

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

 +5        IF '$DATA(^ACDF5PI(ACDPG,0))

               SET DIC="^ACDF5PI("

               SET DIC(0)="L"

               SET X=ACDPG

               SET DINUM=X

               DO FILE^ACDFMC

 +6        SET DIE="^ACDVIS("

           SET DA=ACDBWP

           SET DR="99.99///^S X=ACDPG"

           DO DIE^ACDFMC

 +7        SET DA=ACDBWP

           SET DIK="^ACDVIS("

           DO IX1^DIK

 +8        KILL ^ACDVTMP(ACDUSER,ACDV,"V")

 +9        QUIT 

FILEP     ;File entry into ^ACDPD

 +1        SET DIC="^ACDPD("

           SET X=$PIECE(ACD("P"),U)

           SET DIC(0)="L"

           DO FILE^ACDFMC

 +2        SET ^ACDPD(+Y,0)=ACD("P")

 +3        SET ACDP=+Y

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

 +5        IF '$DATA(^ACDF5PI(ACDPG,0))

               SET DIC="^ACDF5PI("

               SET DIC(0)="L"

               SET X=ACDPG

               SET DINUM=X

               DO FILE^ACDFMC

 +6        SET DIE="^ACDPD("

           SET DA=ACDP

           SET DR="3///^S X=ACDPG"

           DO DIE^ACDFMC

 +7        FOR ACDAY=0:0

               SET ACDAY=$ORDER(^ACDVTMP(ACDUSER,ACDV,"P","DAY",ACDAY))

               IF 'ACDAY

                   QUIT 

               SET ACD("P")=^(ACDAY)

               Begin DoDot:1

 +8                SET DA(1)=ACDP

                   SET DIC="^ACDPD("_DA(1)_",1,"

                   SET DIC(0)="L"

                   SET X=ACDAY

                   IF '$DATA(@(DIC_"0)"))

                       SET @(DIC_"0)")="^9002170.75A"

                   DO FILE^ACDFMC

                   SET ^ACDPD(ACDP,1,+Y,0)=ACD("P")

 +9                KILL ^ACDVTMP(ACDUSER,ACDV,"P","DAY",ACDAY)

               End DoDot:1

 +10       SET DA=ACDP

           SET DIK="^ACDPD("

           DO IX1^DIK

 +11       KILL ^ACDVTMP(ACDUSER,ACDV,"P")

 +12       QUIT