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

IBDFU3.m

Go to the documentation of this file.
  1. IBDFU3 ;ALB/CJM - ENCOUNTER FORM - BUILD FORM(deleting blocks) ;01/08/93
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**63**;APR 24, 1997;Build 80
  1. ;
  1. ;
  1. DLTBLK(BLOCK,FORM,FILE) ;deletes BLOCK (in FILE) if not part of the toolkit (unless IBTKBLK=1) and, if FORM is passed in, the block actually is on FORM
  1. N IBDX,IBDPI,IBDCS
  1. Q:('$G(BLOCK))
  1. Q:(FILE'=357.1)&(FILE'=358.1)
  1. N NODE,DIK,DA
  1. S NODE=$G(^IBE(FILE,BLOCK,0))
  1. K DA S DA=BLOCK,DIK="^IBE("_FILE_","
  1. ;don't delete it if part of the toolkit or doesn't belong to the form (messed up cross-references), unless IBTKBLK=1 (means deletion is during special option for editing the tk)
  1. G:$G(IBTKBLK) JUSTDOIT
  1. I ($P(NODE,"^",14)) D Q
  1. .S $P(^IBE(FILE,BLOCK,0),"^",2)=$O(^IBE(FILE\1,"B","TOOL KIT",""))
  1. .I $G(FORM)'="" K ^IBE(FILE,"C",FORM,BLOCK) D IX1^DIK
  1. I $G(FORM)'="",($P(NODE,"^",2)'=FORM) D Q
  1. .;don't delete it - instead re-index it and quit
  1. .K ^IBE(FILE,"C",FORM,BLOCK) D IX1^DIK
  1. JUSTDOIT ;
  1. ;delete its components
  1. D DLTCNTNT(BLOCK,FILE)
  1. ;delete the block (DIC,DA are newed)
  1. D ^DIK
  1. Q
  1. ;
  1. DLTCNTNT(BLOCK,FILE) ;delete everything in BLOCK, but not the block itself
  1. Q:('$G(BLOCK))!('$G(FILE))
  1. Q:(FILE'=357.1)&(FILE'=358.1)
  1. N LIST,FLD,LINE,TEXT,TARGET,DIK,DA
  1. ;delete selection lists from BLOCK
  1. S TARGET=$S(FILE[358:358.2,1:357.2)
  1. S LIST="" F S LIST=$O(^IBE(TARGET,"C",BLOCK,LIST)) Q:'LIST D DLTLIST(TARGET,BLOCK,LIST)
  1. ;delete data fields
  1. S TARGET=$S(FILE[358:358.5,1:357.5)
  1. S FLD="" F S FLD=$O(^IBE(TARGET,"C",BLOCK,FLD)) Q:'FLD D DLTFLD(TARGET,BLOCK,FLD)
  1. ;delete multiple choice fields
  1. S TARGET=$S(FILE[358:358.93,1:357.93)
  1. S FLD="" F S FLD=$O(^IBE(TARGET,"C",BLOCK,FLD)) Q:'FLD D DLTIFLD(TARGET,BLOCK,FLD)
  1. ;delete hand print fields
  1. S TARGET=$S(FILE[358:358.94,1:359.94)
  1. S FLD="" F S FLD=$O(^IBE(TARGET,"C",BLOCK,FLD)) Q:'FLD D DLTHFLD(TARGET,BLOCK,FLD)
  1. ;delete lines
  1. S TARGET=$S(FILE[358:358.7,1:357.7)
  1. S LINE="" F S LINE=$O(^IBE(TARGET,"C",BLOCK,LINE)) Q:'LINE D DLTLINE(TARGET,BLOCK,LINE)
  1. ;delete text areas
  1. S TARGET=$S(FILE[358:358.8,1:357.8)
  1. S TEXT="" F S TEXT=$O(^IBE(TARGET,"C",BLOCK,TEXT)) Q:'TEXT D DLTTEXT(TARGET,BLOCK,TEXT)
  1. Q
  1. ;
  1. DLTLIST(FILE,BLOCK,LIST) ;delete the LIST, its selections and groups
  1. Q:'$G(LIST)!'$G(BLOCK)!(($G(FILE)'=357.2)&($G(FILE)'=358.2))
  1. N GRP,SLCTN,DIK,DA,IBDX,IBDPI,IBDCS,IBDFLD
  1. S IBDPI=0,IBDCS="" I FILE=357.2 S IBDPI=$P(^IBE(357.2,LIST,0),U,11) I IBDPI?1.N S IBDX=^IBE(357.6,IBDPI,0),IBDCS=+$P(IBDX,U,22) ;Coding System
  1. S DIK="^IBE("_FILE_",",DA=LIST
  1. ;don't delete it if it does not belong to BLOCK - instead, reindex it and quit
  1. I $P($G(^IBE(FILE,LIST,0)),"^",2)'=BLOCK K ^IBE(FILE,"C",BLOCK,LIST) D IX1^DIK Q
  1. ;delete its contents(DIK,DA are newed)
  1. D DLISTCNT(LIST,FILE)
  1. ;delete the list
  1. D ^DIK
  1. Q
  1. DLISTCNT(LIST,FILE) ;delete the list's selections and groups
  1. N GRP,SLCTN,DIK,DA,GFILE,SFILE,IBDX,IBDCS,IBDPI
  1. Q:('$G(LIST))!('$G(FILE))
  1. Q:(FILE'=357.2)&(FILE'=358.2)
  1. S GFILE=$S(FILE[358:358.4,1:357.4)
  1. S SFILE=$S(FILE[358:358.3,1:357.3)
  1. ;now delete list's contents
  1. S GRP="" F S GRP=$O(^IBE(GFILE,"D",LIST,GRP)) Q:'GRP S DA=GRP D
  1. .I $P($G(^IBE(GFILE,GRP,0)),"^",3)=LIST D
  1. ..S DIK="^IBE("_GFILE_"," D ^DIK
  1. ..S SLCTN="",DIK="^IBE("_SFILE_"," F S SLCTN=$O(^IBE(SFILE,"D",GRP,SLCTN)) Q:'SLCTN S DA=SLCTN D
  1. ...I $P($G(^IBE(SFILE,SLCTN,0)),"^",4)=GRP D
  1. ....D ^DIK
  1. ...E K ^IBE(SFILE,"C",LIST,SLCTN) D IX1^DIK
  1. .;
  1. .E K ^IBE(GFILE,"D",LIST,GRP) D IX1^DIK
  1. S SLCTN="",DIK="^IBE("_SFILE_"," F S SLCTN=$O(^IBE(SFILE,"C",LIST,SLCTN)) Q:'SLCTN S DA=SLCTN D
  1. .I $P($G(^IBE(SFILE,SLCTN,0)),"^",3)=LIST D
  1. ..D ^DIK
  1. .E K ^IBE(SFILE,"C",LIST,SLCTN) D IX1^DIK
  1. Q
  1. ;
  1. DLTFLD(FILE,BLOCK,FLD) ;delete a display field
  1. Q:('$G(BLOCK))!('$G(FLD))!('$G(FILE))
  1. Q:(FILE'=357.5)&(FILE'=358.5)
  1. N DA,DIK
  1. S DIK="^IBE("_FILE_",",DA=FLD
  1. I $P($G(^IBE(FILE,FLD,0)),"^",2)=BLOCK D
  1. .D ^DIK
  1. E K ^IBE(FILE,"C",BLOCK,FLD) D IX1^DIK
  1. Q
  1. ;
  1. DLTIFLD(FILE,BLOCK,FLD) ;delete a multiple choice field
  1. Q:('$G(BLOCK))!('$G(FLD))!('$G(FILE))
  1. Q:(FILE'=357.93)&(FILE'=358.93)
  1. N DA,DIK
  1. S DIK="^IBE("_FILE_",",DA=FLD
  1. I $P($G(^IBE(FILE,FLD,0)),"^",8)=BLOCK D
  1. .D ^DIK
  1. E K ^IBE(FILE,"C",BLOCK,FLD) D IX1^DIK
  1. Q
  1. DLTHFLD(FILE,BLOCK,FLD) ;delete a hand print field
  1. Q:('$G(BLOCK))!('$G(FLD))!('$G(FILE))
  1. Q:(FILE'=359.94)&(FILE'=358.94)
  1. N DA,DIK
  1. S DIK="^IBE("_FILE_",",DA=FLD
  1. I $P($G(^IBE(FILE,FLD,0)),"^",8)=BLOCK D
  1. .D ^DIK
  1. E K ^IBE(FILE,"C",BLOCK,FLD) D IX1^DIK
  1. Q
  1. ;
  1. DLTTEXT(FILE,BLOCK,TEXT) ;delete the TEXT AREA
  1. Q:('$G(BLOCK))!('$G(TEXT))!('$G(FILE))
  1. Q:(FILE'=357.8)&(FILE'=358.8)
  1. N DA,DIK
  1. S DIK="^IBE("_FILE_",",DA=TEXT
  1. I $P($G(^IBE(FILE,TEXT,0)),"^",2)=BLOCK D
  1. .D ^DIK
  1. E K ^IBE(FILE,"C",BLOCK,TEXT) D IX1^DIK
  1. Q
  1. DLTLINE(FILE,BLOCK,LINE) ;delete the line
  1. Q:('$G(BLOCK))!('$G(LINE))!('$G(FILE))
  1. Q:(FILE'=357.7)&(FILE'=358.7)
  1. N DA,DIK
  1. S DIK="^IBE("_FILE_",",DA=LINE
  1. I $P($G(^IBE(FILE,LINE,0)),"^",6)=BLOCK D
  1. .D ^DIK
  1. E K ^IBE(FILE,"C",BLOCK,LINE) D IX1^DIK
  1. Q
  1. FASTEXIT ;just sets a flag signaling system should be exited
  1. S VALMBCK="Q"
  1. K DIR S DIR(0)="Y",DIR("A")="Exit Encounter Form Option",DIR("B")="NO" D ^DIR
  1. I $D(DIRUT)!(Y) S IBFASTXT=1
  1. K DIR
  1. Q