36 lines
3.5 KiB
Mathematica
36 lines
3.5 KiB
Mathematica
|
SOWKND ;B'HAM ISC/SAB-POST INIT ROUTINE ; 09 Mar 93 / 1:27 PM [ 03/27/97 9:52 AM ]
|
||
|
|
VER ;;3.0; Social Work ;**10,45,49**;27 Apr 93
|
||
|
|
I $O(^DD(654,0)) W !!,"DELETING SW POSITIONS FILE (#654)",! S DIU=654,DIU(0)="DT" D EN^DIU2
|
||
|
|
F KEY="XMQ-SWA","XMQ-SWM","XMQ-SWK" I '$O(^DIC(19.1,"B",KEY,0)) W !!,"INSTALLING SECURITY KEY '"_KEY_"' FOR SOCIAL WORK DATA TRANSMISSION" S DIC="^DIC(19.1,",DIC(0)="L",X=KEY K DD,DO D FILE^DICN K DIC,X,KEY W !,"HOLDERS WILL HAVE TO BE ADDED"
|
||
|
|
I $O(^DIC(4.2,"B","Q-SWA.VA.GOV",0)) G EN0
|
||
|
|
W !!,"INSTALLING RELAY DOMAIN 'Q-SWA.VA.GOV' FOR SOCIAL WORK DATA TRANSMISSION..." S DIC="^DIC(4.2,",DIC(0)="L",X="Q-SWA.VA.GOV",DIC("DR")="1///S;1.5///XMQ-SWA;2///FOC-AUSTIN.VA.GOV;6.2///SWA;17" K DD,DO D FILE^DICN K DIC,X
|
||
|
|
EN0 I $O(^DIC(4.2,"B","Q-RHC.VA.GOV",0)) G EN1
|
||
|
|
W !!,"INSTALLING RELAY DOMAIN 'Q-RHC.VA.GOV' FOR SOCIAL WORK DATA TRANSMISSION..." S DIC="^DIC(4.2,",DIC(0)="L",X="Q-RHC.VA.GOV",DIC("DR")="1///S;1.5///XMQ-SWK;2///FOC-AUSTIN.VA.GOV;6.2///SWK;17" K DD,DO D FILE^DICN K DIC,X
|
||
|
|
EN1 I $O(^XMB(3.8,"B","SWS",0)) G EN
|
||
|
|
W !!,"INSTALLING MAIL GROUP 'SWA' TO RECEIVE SOCIAL WORK TRANSMISSION CONFIRMATION..." S DIC="^XMB(3.8,",DIC(0)="L",X="SWA",DIC("DR")="4///PU;7///y" K DD,DO D FILE^DICN K DIC,X W !,"MEMBERS WILL HAVE TO BE ADDED...",!
|
||
|
|
EN I $O(^DIC(4.2,"B","Q-SWM.VA.GOV",0)) G EN2
|
||
|
|
W !!,"INSTALLING RELAY DOMAIN 'Q-SWM.VA.GOV' FOR SOCIAL WORK DATA TRANSMISSION..." S DIC="^DIC(4.2,",DIC(0)="L",X="Q-SWM.VA.GOV",DIC("DR")="1///S;1.5///XMQ-SWM;2///FOC-AUSTIN.VA.GOV;6.2///SWM;17" K DD,DO D FILE^DICN K DIC,X
|
||
|
|
EN2 I $O(^XMB(3.8,"B","RHC",0)) G EN3
|
||
|
|
W !!,"INSTALLING MAIL GROUP 'RHC' TO RECEIVE SOCIAL WORK TRANSMISSION CONFIRMATION..." S DIC="^XMB(3.8,",DIC(0)="L",X="RHC",DIC("DR")="4///PU;7///y" K DD,DO D FILE^DICN K DIC,X W !,"MEMBERS WILL HAVE TO BE ADDED...",!
|
||
|
|
EN3 I $O(^XMB(3.8,"B","SWM",0)) G EN4
|
||
|
|
W !!,"INSTALLING MAIL GROUP 'SWM' TO RECEIVE SOCIAL WORK TRANSMISSION CONFIRMATION..." S DIC="^XMB(3.8,",DIC(0)="L",X="SWM",DIC("DR")="4///PU;7///y" K DD,DO D FILE^DICN K DIC,X W !,"MEMBERS WILL HAVE TO BE ADDED...",!
|
||
|
|
EN4 F I=0:0 S I=$O(^SOWK(652,I)) Q:'I S:'$D(^SOWK(652,I,1)) $P(^SOWK(652,I,1),"^",2)=0
|
||
|
|
I $O(CDC(0)) F CDC=0:0 Q:'$O(CDC(CDC)) S CDC=$O(CDC(CDC)),^SOWK(651,CDC,0)=CDC(CDC)
|
||
|
|
S (SWPT,SWSW,SWSITE,SHEMP)=0 F S SWPT=$O(^SOWK(650,"AC",SWPT)) Q:'SWPT F S SWSW=$O(^SOWK(650,"AC",SWPT,SWSW)) Q:'SWSW F S SWSITE=$O(^SOWK(650,"AC",SWPT,SWSW,SWSITE)) Q:'SWSITE D
|
||
|
|
.F S SHEMP=$O(^SOWK(650,"AC",SWPT,SWSW,SWSITE,SHEMP)) Q:'SHEMP I '$D(^SOWK(650,SHEMP,0)) K ^SOWK(650,"AC",SWPT,SWSW,SWSITE,SHEMP)
|
||
|
|
K SHEMP
|
||
|
|
S ^SOWK(650.1,1,"VER")=$P($T(VER),";",3),DIK="^SOWK(651,",DIK(1)="4^AC" D ENALL^DIK K DIK
|
||
|
|
QU K SWS,SWSITE,SWPT,CDC,Y,KEY,OC,DIU,HOC,HIR,HR,I,SOWKND,DIK,X
|
||
|
|
LOCK ;deletes SOWKNEW lock from all options and adds it to SOWKNEW and SOWKXREF
|
||
|
|
N XX,SOW,SOWK,OPT
|
||
|
|
S SOWK="SOW" F S SOWK=$O(^DIC(19,"B",SOWK)) Q:$E(SOWK,1,6)'["SOWK" S SOW=$O(^DIC(19,"B",SOWK,0)) D
|
||
|
|
.I $P(^DIC(19,SOW,0),U,6)="SOWKNEW" K DR,DIE,DA S DIE=19,DR="3///@",DA=SOW I DA D ^DIE K DR,DIE,DA
|
||
|
|
.I SOWK="SOWKDELETE",($P(^DIC(19,SOW,0),U,6)'="SOWKSITE") K DR,DIE,DA S DIE=19,DR="3///SOWKSITE",DA=SOW I DA D ^DIE K DR,DA,DIE
|
||
|
|
SOWKNEW ;
|
||
|
|
F XX="SOWKNEW","SOWKXREF" K DR,DIE,DA S DIE=19,DR="3///SOWKNEW",DA=$O(^DIC(19,"B",XX,0)) D ^DIE K DR,DIE,DA
|
||
|
|
ALL ;Clean-up of all other option locks
|
||
|
|
F XX="SOWKARS","SOWKCMR","SOWKHINC" K DR,DIE,DA S DIE=19,DR="3///@",DA=$O(^DIC(19,"B",XX,0)) I DA D ^DIE K DR,DIE,DA
|
||
|
|
OPTDEL ;deletes option SOWKDBPRN and SOWKALL
|
||
|
|
F OPT="SOWKALL","SOWKDBPRN" I $O(^DIC(19,"B",OPT,0)) S DA=$O(^DIC(19,"B",OPT,0)) S DIK="^DIC(19," D ^DIK K DIK,DA
|
||
|
|
Q
|