source: FOIAVistA/tag/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKND.m@ 628

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