Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XPDIA2

XPDIA2.m

Go to the documentation of this file.
  1. XPDIA2 ;SFISC/RSD - Delete Options and cleanup pointers ;11/03/99 12:58
  1. ;;8.0;KERNEL;**68,131**;Jul 10, 1995
  1. Q
  1. OPT ;options
  1. N XPDI,XPDJ,XPDK,XPDM,XPDX,X
  1. ;XPDM=ien of the XMUSER option
  1. S X=$O(^DIC(19,"B","XMUSER",0)),XPDM=$S(X:X,1:"@"),XPDX=0
  1. ;loop thru all the options that are to be deleted
  1. F S XPDX=$O(^TMP($J,"XPDEL",XPDX)) Q:'XPDX D
  1. .;check that the following might reference this option, XPDX
  1. .;file 19, menu item, 10
  1. .S XPDI=0 F S XPDI=$O(^DIC(19,"AD",XPDX,XPDI)) Q:'XPDI D
  1. ..S XPDJ=0 F S XPDJ=$O(^DIC(19,"AD",XPDX,XPDI,XPDJ)) Q:'XPDJ D
  1. ...N XPDA S XPDA=XPDJ,XPDA(1)=XPDI
  1. ...D DIK("^DIC(19,"_XPDI_",10,",.XPDA,DUZ)
  1. .;file 19.081, field .01
  1. .S XPDI=0 F S XPDI=$O(^XUSEC(19,"B",XPDX,XPDI)) Q:'XPDI D DIK("^XUSEC(19,",XPDI,DUZ)
  1. .;file 19.2, field .01
  1. .S XPDI=0 F S XPDI=$O(^DIC(19.2,"B",XPDX,XPDI)) Q:'XPDI D DIK("^DIC(19.2,",XPDI,DUZ)
  1. .;file 200, secondary menu item, 203
  1. .S XPDI=0 F S XPDI=$O(^VA(200,"AD",XPDX,XPDI)) Q:'XPDI D
  1. ..S XPDJ=0 F S XPDJ=$O(^VA(200,"AD",XPDX,XPDI,XPDJ)) Q:'XPDJ D
  1. ...N XPDA S XPDA=XPDJ,XPDA(1)=XPDI
  1. ...D DIK("^VA(200,"_XPDI_",203,",.XPDA,DUZ)
  1. .Q
  1. ;
  1. ;loop thru New Person file
  1. S XPDI=0 F S XPDI=$O(^VA(200,XPDI)) Q:'XPDI D
  1. .K XPDK S X="XPDK(200,"""_XPDI_","")"
  1. .I $D(^VA(200,XPDI,201)) S XPDX=^(201) D
  1. ..;check primary option field 201
  1. ..S:$D(^TMP($J,"XPDEL",+XPDX)) @X@(201)=XPDM
  1. ..;check primary window field 201.1
  1. ..S:$D(^TMP($J,"XPDEL",+$P(XPDX,U,2))) @X@(201.1)="@"
  1. .;check last option accessed field 202.1
  1. .I $D(^VA(200,XPDI,202.1)),$D(^TMP($J,"XPDEL",+^(202.1))) S @X@(202.1)="@"
  1. .D:$D(XPDK) DIE(.XPDK,DUZ)
  1. .;loop thru delegated options field 19.5, this multiple is dinumed
  1. .S XPDJ=0 F S XPDJ=$O(^VA(200,XPDI,19.5,XPDJ)) Q:'XPDJ D:$D(^TMP($J,"XPDEL",XPDJ))
  1. ..N XPDA S XPDA=XPDJ,XPDA(1)=XPDI
  1. ..D DIK("^VA(200,"_XPDI_",19.5,",.XPDA,DUZ)
  1. .Q
  1. ;
  1. ;loop thru Kernel Site Parameter file
  1. S XPDI=0 F S XPDI=$O(^XTV(8989.3,XPDI)) Q:'XPDI D
  1. .;loop thru alpha/beta test options field 33, node ABOPT, multiple is dinumed
  1. .S XPDJ=0 F S XPDJ=$O(^XTV(8989.3,XPDI,"ABOPT",XPDJ)) Q:'XPDJ D:$D(^TMP($J,"XPDEL",XPDJ))
  1. ..N XPDA S XPDA=XPDJ,XPDA(1)=XPDI
  1. ..D DIK("^XTV(8989.3,"_XPDI_",""ABOPT"",",.XPDA,DUZ)
  1. .;loop thru option to audit field 19.1, node 19.1
  1. .S XPDJ=0 F S XPDJ=$O(^XTV(8989.3,XPDI,19.1,"B",XPDJ)) Q:'XPDJ D:$D(^TMP($J,"XPDEL",XPDJ))
  1. ..N XPDA S XPDK=$O(^XTV(8989.3,XPDI,19.1,"B",XPDJ,0)),XPDA=XPDK,XPDA(1)=XPDI
  1. ..D DIK("^XTV(8989.3,"_XPDI_",19.1,",.XPDA,DUZ)
  1. .Q
  1. ;
  1. ;loop thru Device File and check primary option field 201
  1. S XPDI=0 F S XPDI=$O(^%ZIS(1,XPDI)) Q:'XPDI D:$D(^TMP($J,"XPDEL",+$G(^(XPDI,201))))
  1. .K XPDK S XPDK(3.5,XPDI_",",201)="@" D DIE(.XPDK,DUZ)
  1. Q
  1. ;
  1. PRO ;protocols
  1. N XPDI,XPDJ,XPDK,XPDX,X
  1. S XPDX=0
  1. ;loop thru all the protocols that are to be deleted
  1. F S XPDX=$O(^TMP($J,"XPDEL",XPDX)) Q:'XPDX D
  1. .;check that the following might reference this protocol, XPDX
  1. .;file 101, menu item, 10
  1. .S XPDI=0 F S XPDI=$O(^ORD(101,"AD",XPDX,XPDI)) Q:'XPDI D
  1. ..S XPDJ=0 F S XPDJ=$O(^ORD(101,"AD",XPDX,XPDI,XPDJ)) Q:'XPDJ D
  1. ...N XPDA S XPDA=XPDJ,XPDA(1)=XPDI
  1. ...D DIK("^ORD(101,"_XPDI_",10,",.XPDA,DUZ)
  1. .;file 101, subscriber, 775
  1. .S XPDI=0 F S XPDI=$O(^ORD(101,"AB",XPDX,XPDI)) Q:'XPDI D
  1. ..S XPDJ=0 F S XPDJ=$O(^ORD(101,"AB",XPDX,XPDI,XPDJ)) Q:'XPDJ D
  1. ...N XPDA S XPDA=XPDJ,XPDA(1)=XPDI
  1. ...D DIK("^ORD(101,"_XPDI_",775,",.XPDA,DUZ)
  1. .;file 123.1, REQUEST ACTION TYPE, field 2
  1. .S XPDI=0 F S XPDI=$O(^GMR(123.1,"C",XPDX,XPDI)) Q:'XPDI D
  1. ..S X=$G(^GMR(123.1,XPDI,0)) Q:X=""
  1. ..K XPDK S XPDK(123.1,XPDI_",",2)="@"
  1. ..D DIE(.XPDK,DUZ)
  1. .Q
  1. ;
  1. ;loop thru New Person file
  1. S XPDI=0 F S XPDI=$O(^VA(200,XPDI)) Q:'XPDI D
  1. .K XPDK S X="XPDK(200,"""_XPDI_","")"
  1. .I $D(^VA(200,XPDI,100.1)) S XPDX=^(100.1) D
  1. ..;check PRIMARY OE/RR MENU, field 100.11
  1. ..S:$D(^TMP($J,"XPDEL",+XPDX)) @X@(100.11)="@"
  1. ..;check PRIMARY ORDER MENU, field 100.12
  1. ..S:$D(^TMP($J,"XPDEL",+$P(XPDX,U,2))) @X@(100.12)="@"
  1. .I $D(^VA(200,XPDI,100.2)) S XPDX=^(100.2) D
  1. ..;check DEFAULT RESULT REPORTING MENU, field 100.23
  1. ..S:$D(^TMP($J,"XPDEL",+$P(XPDX,U,3))) @X@(100.23)="@"
  1. ..;check PRIMARY PROFILE MENU, field 100.24
  1. ..S:$D(^TMP($J,"XPDEL",+$P(XPDX,U,4))) @X@(100.24)="@"
  1. .D:$D(XPDK) DIE(.XPDK,DUZ)
  1. Q
  1. ;
  1. DIK(DIK,DA,DUZ) ;delete
  1. S DUZ(0)="@" D ^DIK
  1. Q
  1. DIE(XPD,DUZ) ;
  1. ;XPD(file,DA_",",field)=XMUSER option or '@' to delete
  1. S DUZ(0)="@"
  1. D FILE^DIE("","XPD")
  1. Q