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
