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

IBDF5B.m

Go to the documentation of this file. 
  1. IBDF5B ;ALB/CJM - ENCOUNTER FORM (edit a form - CONTINUED) ;07/27/93
  1.  ;;3.0;AUTOMATED INFO COLLECTION SYS;**63**;APR 24, 1997;Build 80
  1.  ;
  1.  ;
  1. EDITBLK ;allows the user to edit everything about the block
  1.  ;allows user to discard or save changes to the block
  1.  ;
  1.  ;If IBBLK and IBBLK2 are used to point to two copies, one copy for editing and the other in case 'undo' is needed
  1.  ; 
  1.  N IBBLK,IBVALMBG,TOP1,TOP2,BOT1,BOT2,IBBLK2,IBTKODR,IBJUNK,IFSAVE,WDATA
  1.  ;N IBMEMARY
  1.  ;
  1.  S IBVALMBG=VALMBG
  1.  D FULL^VALM1
  1.  S IBBLK=$$SLCTBLK^IBDFU8(IBFORM,IOSL,"HEADER") ;select the block
  1.  I IBBLK D
  1.  .D KILL^IBDFUA
  1.  .S (IBBLK2,IBTKODR,IBJUNK)=""
  1.  .S WDATA=IBPRINT("WITH_DATA")
  1.  .D COPYBLK(IBBLK,.IBBLK2,.IBBLK,.IBTKODR,.IBJUNK) I 'IBBLK S IBBLK=IBBLK2,IBBLK2="" Q  ;sets IBBLK to the work copy, IBBLK2 to the copy actually on the form
  1.  .D TOPNBOT^IBDFU5(IBBLK,.TOP1,.BOT1)
  1.  .D EN^VALM("IBDF FORM BLOCK EDIT") ;call list processor
  1.  .I IBBLK,IBBLK2 D
  1.  ..S IFSAVE=$$ASKSAVE
  1.  ..I IFSAVE D SAVECOPY(.IBBLK,.IBBLK2,IBTKODR) S IBBLK=IBBLK2,IBBLK2=""
  1.  ..I 'IFSAVE D DLTCOPY(IBBLK) S IBBLK=IBBLK2,IBBLK2=""
  1.  ..L -^IBE(357.1,IBBLK):1
  1.  .I '$G(IBFASTXT) D
  1.  ..S VALMBG=IBVALMBG
  1.  ..S IBPRINT("WITH_DATA")=WDATA
  1.  ..D TOPNBOT^IBDFU5(IBBLK,.TOP2,.BOT2)
  1.  ..S TOP1=$S(TOP1<TOP2:TOP1,1:TOP2),BOT1=$S(BOT1>BOT2:BOT1,1:BOT2)
  1.  ..D IDXFORM^IBDF5A(TOP1,BOT1)
  1.  K ^TMP("IBDF DELETE SELECTION OPTION",$J),^TMP("IBDF DELETED ALL SELECTIONS",$J),^TMP("IBDF ADDSLCTN",$J)
  1.  S VALMBCK="R"
  1.  Q
  1. DLTCOPY(WORKCOPY) ;deletes the block=WORKCOPY and unlocks it
  1.  D DLTBLK^IBDFU3(WORKCOPY,IBJUNK,357.1)
  1.  L -^IBE(357.1,WORKCOPY)
  1.  S WORKCOPY=""
  1.  Q
  1. SAVECOPY(WORKCOPY,FORMCOPY,IBTKODR) ;deletes the block=FORMCOPY,adds WORKCOPY to IBFORM
  1.  ;NOTE: upon completion WORKCOPY="",FORMCOPY points to what WORKCOPY initially did
  1.  N IBDN,IBDX,IBD9,IBD10,IBDBL
  1.  Q:('FORMCOPY)!('WORKCOPY)  ;something wrong!
  1.  ;
  1.  K DIE,DA,DR S DIE="^IBE(357.1,",DA=WORKCOPY,DR=".02////"_IBFORM
  1.  I IBTKODR S DR=DR_";.14////"_IBTKODR
  1.  D ^DIE K DIE,DR,DA
  1.  ;
  1.  ;In order to be able to update history, first check to see if there is any Selection List which is either ICD-9 or ICD-10
  1.  S (IBD9,IBD10)=0
  1.  ;FORMCOPY at this time is actually the Work Copy block, WORKCOPY is the new block
  1.  ;Check to see if any List contains ICD-9 or ICD-10 existed prior this change
  1.  S IBDN="" F  S IBDN=$O(^IBE(357.2,"C",FORMCOPY,IBDN)) Q:IBDN=""  S IBDX=$P($G(^IBE(357.2,IBDN,0)),U,11) I IBDX?1.N S IBDX=$E($P($G(^IBE(357.6,IBDX,0)),U,1),1,30) D
  1.  .I '$D(^TMP("IBDF DELETED ALL SELECTIONS",$J)),'$O(^IBE(357.3,"C",IBDN,"")) Q  ;Only log history fields if ICD-9 or ICD-10 codes are contained in block.
  1.  .I IBDX="DG SELECT ICD-9 DIAGNOSIS CODE" S IBD9=1
  1.  .I IBDX="DG SELECT ICD-10 DIAGNOSIS COD" S IBD10=1
  1.  ;
  1.  ;Now check for any Data Fields with ICD-9 or ICD-10 inputs
  1.  S IBDN=0 F  S IBDN=$O(^IBE(357.1,FORMCOPY,"B",IBDN)) Q:IBDN'?1.N  D
  1.  .S IBDX=$P(^IBE(357.1,FORMCOPY,"B",IBDN,0),U,3) I IBDX?1.N S IBDX=$E($P($G(^IBE(357.6,IBDX,0)),U,1),1,30) D
  1.  ..I IBDX="INPUT DIAGNOSIS CODE (ICD9)" S IBD9=1
  1.  ..I IBDX="INPUT DIAGNOSIS CODE (ICD10)" S IBD10=1
  1.  ;
  1.  D DLTBLK^IBDFU3(FORMCOPY,IBFORM,357.1)
  1.  D UNCMPL^IBDF19(IBFORM,0)
  1.  L -^IBE(357.1,FORMCOPY)
  1.  S FORMCOPY=WORKCOPY,WORKCOPY=""
  1.  ;
  1.  ;Check to see if any List contains ICD-9 or ICD-10 existed after the change
  1.  S IBDQUIT=0
  1.  S IBDN="" F  S IBDN=$O(^IBE(357.2,"C",FORMCOPY,IBDN)) Q:IBDN=""!(IBDQUIT)  S IBDX=$P($G(^IBE(357.2,IBDN,0)),U,11) I IBDX?1.N S IBDX=$E($P($G(^IBE(357.6,IBDX,0)),U,1),1,30) D
  1.  .I '$D(^TMP("IBDF DELETED ALL SELECTIONS",$J)),'$O(^IBE(357.3,"C",IBDN,"")) S IBDQUIT=1 Q  ;Only log history fields if ICD-9 or ICD-10 codes are contained in block.
  1.  .I IBDX="DG SELECT ICD-9 DIAGNOSIS CODE" S IBD9=1
  1.  .I IBDX="DG SELECT ICD-10 DIAGNOSIS COD" S IBD10=1
  1.  ;
  1.  Q:IBDQUIT  ;Do not update history fields if ICD-9 or ICD-10 codes are not contained within the block.
  1.  ;
  1.  ;Now check for any Data Fields with ICD-9 or ICD-10 inputs
  1.  S IBDN=0 F  S IBDN=$O(^IBE(357.1,FORMCOPY,"B",IBDN)) Q:IBDN'?1.N  D
  1.  .S IBDX=$P(^IBE(357.1,FORMCOPY,"B",IBDN,0),U,3) I IBDX?1.N S IBDX=$E($P($G(^IBE(357.6,IBDX,0)),U,1),1,30) D
  1.  ..I IBDX="INPUT DIAGNOSIS CODE (ICD9)" S IBD9=1
  1.  ..I IBDX="INPUT DIAGNOSIS CODE (ICD10)" S IBD10=1
  1.  ;
  1.  ;Now update history if ICD-9 or ICD-10 was present before or after the change
  1.  N IBDX
  1.  I IBD9 S IBDX=$$CSUPD357^IBDUTICD(IBFORM,1,"",$$NOW^XLFDT(),DUZ)
  1.  I IBD10 S IBDX=$$CSUPD357^IBDUTICD(IBFORM,30,"",$$NOW^XLFDT(),DUZ)
  1.  Q
  1.  ;
  1. COPYBLK(IBBLK,FORMCOPY,WORKCOPY,IBTKODR,IBJUNK) ;copies the IBBLK to the WORKCOPY, then puts sets FORMCOPY=IBBLK
  1.  ;IBJUNK set to the form="WORKCOPY", IBTKODR set to the original value of the field TOOL KIT ORDER
  1.  ;
  1.  N NODE
  1.  S WORKCOPY=IBBLK,FORMCOPY=""
  1.  Q:'IBBLK  ;no block to copy!
  1.  S NODE=$G(^IBE(357.1,IBBLK,0))
  1.  S IBTKODR=$P(NODE,"^",14)
  1.  ;find the form=WORKCOPY, used as a work area
  1.  S IBJUNK=+$O(^IBE(357,"B","WORKCOPY",""))
  1.  ;copy the block
  1.  S FORMCOPY=$$COPYBLK^IBDFU2(IBBLK,IBFORM,357.1,357.1)
  1.  I 'FORMCOPY W !,"Unable to edit the block!" D PAUSE^IBDFU5 S FORMCOPY=IBBLK Q
  1.  ;
  1.  ;make sure both copies are locked
  1.  ;the working copy on IBJUNK is locked so that the option does cleanup knows which blocks are in current use - others on IBJUNK can be deleted
  1.  L +^IBE(357.1,FORMCOPY):1
  1.  L +^IBE(357.1,WORKCOPY):1
  1.  ;
  1.  ;mark the working copy as not being in the tk and not on IBFORM
  1.  K DIE,DA,DR S DIE="^IBE(357.1,",DA=WORKCOPY,DR=".02////"_IBJUNK_";.14////0"
  1.  D ^DIE K DIE,DR,DA
  1.  Q
  1.  ;
  1. ASKSAVE() ;asks the user if changes to the block should be saved
  1.  ;returns 1 for yes, 0 for no
  1.  K DIR S DIR(0)="Y",DIR("A")="Save changes to the block",DIR("B")="YES"
  1.  D ^DIR K DIR
  1.  Q:$D(DIRUT) 0
  1.  Q Y
  1. DECIDE ;allows user to either save or discard changes to the block being edited
  1.  N WHAT
  1.  ;
  1.  S WHAT=$$DOWHAT
  1.  I WHAT="S" D
  1.  .D SAVECOPY(.IBBLK,.IBBLK2,IBTKODR),COPYBLK(IBBLK2,.IBBLK2,.IBBLK,.IBTKODR,.IBJUNK) S VALMBCK="" I 'IBBLK S IBBLK=IBBLK2,IBBLK2="" S VALMBCK="Q"
  1.  I WHAT="D" D
  1.  .D DLTCOPY(IBBLK) S IBBLK=IBBLK2,IBBLK2="" D COPYBLK(IBBLK,.IBBLK2,.IBBLK,.IBTKODR,.IBJUNK)
  1.  .I IBBLK S VALMBCK="R" D IDXBLOCK^IBDFU4
  1.  .I 'IBBLK S IBBLK=IBBLK2,IBBLK2="",VALMBCK="Q"
  1.  Q
  1.  ;
  1. DOWHAT() ;returns "D" for discard, "S" for save, "" for do nothing
  1.  K DIR S DIR(0)="SB^S:Save Changes;D:Discard Changes;",DIR("A")="Save or Discard the recent changes to the block?"
  1.  D ^DIR K DIR
  1.  Q:$D(DIRUT) ""
  1.  Q Y
  1.  ;
  1. PRINT ;prints the form
  1.  ;
  1.  N QUIT S QUIT=0
  1.  S VALMBCK=""
  1.  I $G(IBBLK),'$G(IBTKBLK) D  Q:QUIT
  1.  .W !,"Before printing the form any changes you have made must be saved.",!,"Is that okay?"
  1.  .K DIR S DIR(0)="Y" D ^DIR  K DIR I 'Y!$D(DIRUT) S QUIT=1 QUIT
  1.  .D SAVECOPY(.IBBLK,.IBBLK2,IBTKODR),COPYBLK(IBBLK2,.IBBLK2,.IBBLK,.IBTKODR,.IBJUNK) S VALMBCK="" I 'IBBLK S IBBLK=IBBLK2,IBBLK2="" S VALMBCK="Q",QUIT=1
  1.  D:'QUIT PRINT^IBDF1C(.IBFORM)
  1.  Q