| [613] | 1 | SOWKND ;B'HAM ISC/SAB-POST INIT ROUTINE ; 09 Mar 93 / 1:27 PM [ 03/27/97 9:52 AM ]
|
|---|
| 2 | VER ;;3.0; Social Work ;**10,45,49**;27 Apr 93
|
|---|
| 3 | I $O(^DD(654,0)) W !!,"DELETING SW POSITIONS FILE (#654)",! S DIU=654,DIU(0)="DT" D EN^DIU2
|
|---|
| 4 | 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"
|
|---|
| 5 | I $O(^DIC(4.2,"B","Q-SWA.VA.GOV",0)) G EN0
|
|---|
| 6 | 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
|
|---|
| 7 | EN0 I $O(^DIC(4.2,"B","Q-RHC.VA.GOV",0)) G EN1
|
|---|
| 8 | 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
|
|---|
| 9 | EN1 I $O(^XMB(3.8,"B","SWS",0)) G EN
|
|---|
| 10 | 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...",!
|
|---|
| 11 | EN I $O(^DIC(4.2,"B","Q-SWM.VA.GOV",0)) G EN2
|
|---|
| 12 | 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
|
|---|
| 13 | EN2 I $O(^XMB(3.8,"B","RHC",0)) G EN3
|
|---|
| 14 | 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...",!
|
|---|
| 15 | EN3 I $O(^XMB(3.8,"B","SWM",0)) G EN4
|
|---|
| 16 | 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...",!
|
|---|
| 17 | 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
|
|---|
| 18 | I $O(CDC(0)) F CDC=0:0 Q:'$O(CDC(CDC)) S CDC=$O(CDC(CDC)),^SOWK(651,CDC,0)=CDC(CDC)
|
|---|
| 19 | 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
|
|---|
| 20 | .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)
|
|---|
| 21 | K SHEMP
|
|---|
| 22 | S ^SOWK(650.1,1,"VER")=$P($T(VER),";",3),DIK="^SOWK(651,",DIK(1)="4^AC" D ENALL^DIK K DIK
|
|---|
| 23 | QU K SWS,SWSITE,SWPT,CDC,Y,KEY,OC,DIU,HOC,HIR,HR,I,SOWKND,DIK,X
|
|---|
| 24 | LOCK ;deletes SOWKNEW lock from all options and adds it to SOWKNEW and SOWKXREF
|
|---|
| 25 | N XX,SOW,SOWK,OPT
|
|---|
| 26 | 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
|
|---|
| 27 | .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
|
|---|
| 28 | .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
|
|---|
| 29 | SOWKNEW ;
|
|---|
| 30 | 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
|
|---|
| 31 | ALL ;Clean-up of all other option locks
|
|---|
| 32 | 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
|
|---|
| 33 | OPTDEL ;deletes option SOWKDBPRN and SOWKALL
|
|---|
| 34 | 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
|
|---|
| 35 | Q
|
|---|
