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

IBDF5C.m

Go to the documentation of this file. 
  1. IBDF5C ;ALB/CJM - ENCOUNTER FORM (creating a new block) ;MARCH 22,1993
  1.  ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
  1. NEWBLOCK ;adds a new block, expects IBFORM to be defined
  1.  N IBBLK,TOP,BOT
  1.  S VALMBCK="R"
  1.  S IBBLK=$$CREATE()
  1.  I IBBLK D
  1.  .D TOPNBOT^IBDFU5(IBBLK,.TOP,.BOT)
  1.  .D IDXFORM^IBDF5A(TOP,BOT)
  1.  Q
  1. CREATE() ;creates the new block and allows the user to edit it
  1.  ;INPUTS: expects IBFORM to be defined
  1.  ;        expects IBTKBLK to be defined - IBTKBLK=1 means add to tk
  1.  ;returns IBBLK
  1.  N NAME,IBBLK,NODE,IBDFDONE,IBBG,IBLFT,DLAYGO
  1.  S IBBG=1,IBLFT=5
  1.  S VALMBCK="R"
  1.  I '$G(IBTKBLK) S IBBG=+$G(VALMBG),IBLFT=+$G(VALMLFT)
  1.  S NAME=$$NEWNAME Q:NAME=-1 ""
  1.  K DIC,DIE,DD,DO,DINUM S DIC="^IBE(357.1,",DIC(0)="FL",X=NAME,DLAYGO=357.1
  1.  D FILE^DICN K DIC,DIE,DA
  1.  S IBBLK=+Y
  1.  I 'IBBLK D
  1.  .W !,"Unable to create a new block!" K DIC,DIE D PAUSE^IBDFU5
  1.  I IBBLK D
  1.  .;delete everything in the block - it should be empty
  1.  .D DLTCNTNT^IBDFU3(IBBLK,357.1)
  1.  .;set the current position of the block to the upper left-hand corner of the screen as the default
  1.  .S $P(^IBE(357.1,IBBLK,0),"^",4,5)=(IBBG-1)_"^"_(IBLFT-5)
  1.  .;now let the user edit the new block - header,name,outline,etc.
  1.  .K DIE,DA S DIE=357.1,DA=IBBLK,DR="[IBDF NEW EMPTY BLOCK]",DIE("NO^")="BACKOUTOK" D ^DIE K DIC,DIE,DR,DA
  1.  .I 'IBDFDONE S DIK="^IBE(357.1,",DA=IBBLK K DA(1) D ^DIK K DIK,DA Q
  1.  Q IBBLK
  1. NEWNAME() ;
  1.  K DIR S DIR(0)="357.1,.01A",DIR("A")="New Block Name: ",DIR("B")=""
  1.  D ^DIR K DIR I $D(DIRUT) Q -1
  1.  Q Y
  1. REDRAW ;redraws the ;entire form
  1.  S VALMBCK="R"
  1.  D UNCMPALL^IBDF19(IBFORM)
  1.  D IDXFORM^IBDF5A()
  1.  Q
  1. COPYBLK ;copies a block from another form,whether in the toolkit or not, expects IBFORM=current work form  to be defined
  1.  N IBBLK,TOP,BOT,NEWBLOCK
  1.  S IBBLK=$$SELECT2^IBDF13("")
  1.  I IBBLK S NEWBLOCK=$$COPYBLK^IBDFU2(IBBLK,IBFORM,357.1,357.1,$$CURY^IBDFU4,$$CURX^IBDFU4,0,"",1) I NEWBLOCK D
  1.  .D RE^VALM4
  1.  .D POS^IBDFU4(NEWBLOCK)
  1.  .D TOPNBOT^IBDFU5(NEWBLOCK,.TOP,.BOT)
  1.  .D IDXFORM^IBDF5A(TOP,BOT)
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. VIEW ;toggles between viewing form with data and without data
  1.  N STARTVAL
  1.  S STARTVAL=IBPRINT("WITH_DATA")
  1.  I 'IBPRINT("WITH_DATA") D
  1.  .D FULL^VALM1
  1.  .S DFN=$$PATIENT
  1.  .I DFN S IBPRINT("WITH_DATA")=1 I '$G(IBAPPT) D NOW^%DTC S IBAPPT=% K %,%H,%I,X
  1.  E  I IBPRINT("WITH_DATA") S IBPRINT("WITH_DATA")=0
  1.  ;
  1.  ;this action could be called at the form level or the block level - action depends on which
  1.  I '$G(IBBLK) D
  1.  .I STARTVAL'=IBPRINT("WITH_DATA") D JUSTDATA^IBDF2A(IBPRINT("WITH_DATA")) K ^TMP("IB",$J,"INTERFACES")
  1.  I $G(IBBLK) D UNCMPBLK^IBDF19(IBBLK),IDXBLOCK^IBDFU4
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. PATIENT() ;asks for a patient, returns the DFN
  1.  K DIR S DIR(0)="P^2:EM",DIR("A")="Test with what Patient"
  1.  D ^DIR K DIR I $D(DIRUT)!(+Y<1) Q 0
  1.  Q +Y