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

IBDFU4.m

Go to the documentation of this file.
  1. IBDFU4 ;ALB/CJM - ENCOUNTER FORM - BUILD FORM(write single form block to array for display,position & size copied block) ; 08-JAN-1993
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**10**;APR 24, 1997
  1. ;
  1. IDXBLOCK ; create list containing block rows for list processor
  1. ;
  1. N I
  1. W !,"... BUILDING THE FORM BLOCK ..."
  1. Q:$$BLKDESCR^IBDFU1B(.IBBLK)
  1. ;
  1. ;keep small blocks in memory
  1. ;I ((IBBLK("H")+1)*(IBBLK("W")+1))<4000 S VALMAR="IBMEMARY"
  1. ;
  1. K @VALMAR D KILL^VALM10()
  1. D BLNKFORM^IBDF5A(0,IBBLK("H")-1,IBBLK("W"))
  1. S I="",$P(I,"~",IBBLK("W")+1)="~"
  1. S @VALMAR@(IBBLK("H")+1,0)=" "_I
  1. S VALMCNT=IBBLK("H")+1
  1. D DRWBLOCK^IBDF2A1(.IBBLK,1)
  1. Q
  1. POS(NEWBLOCK,DFLTX,DFLTY) ;allows the user to position and size the block
  1. ;NEWBLOCK = block to be edited
  1. ;DFLTY - default value for starting row
  1. ;DFLTX - default value for starting column
  1. N IBX,IBY ;used in the input template
  1. S:$G(DFLTX)=+$G(DFLTX) $P(NODE,"^",5)=DFLTX
  1. S:$G(DFLTY)=+$G(DFLTY) $P(NODE,"^",4)=DFLTY
  1. N NODE,IBBLK,IBDONE
  1. S IBBLK=NEWBLOCK
  1. S NODE=$G(^IBE(357.1,NEWBLOCK,0))
  1. ;set defaults for starting column, starting row
  1. S ^IBE(357.1,NEWBLOCK,0)=NODE,IBDONE=0
  1. K DIE S DIE=357.1,DA=NEWBLOCK,DR="[IBDF POSITION COPIED BLOCK]"
  1. D ^DIE K DIE,DR,DA
  1. I 'IBDONE D DLTBLK^IBDFU3(NEWBLOCK,IBFORM,357.1)
  1. Q
  1. CURX() ;returns the current X position (top left corner of displayed poriton of the form - internal column value)
  1. N IB
  1. S IB=+$G(VALMLFT),IB=IB-5 S:IB<0 IB=0
  1. Q IB
  1. CURY() ;returns the current Y position (top left corner of displayed poriton of the form - internal row value)
  1. N IB
  1. S IB=+$G(VALMBG),IB=IB-1 S:IB<0 IB=0
  1. Q IB
  1. SLCTFORM(TK,NODE) ;allows the user to select a form and returns the IEN
  1. ;returns 0 if no form selected
  1. ;
  1. ;INPUTS
  1. ;if TK=0 assumes form should not be a toolkit form
  1. ;if TK=1 assumes form should be a toolkit form
  1. ;otherwise, ask the user if the he wants to select fromt he toolkit
  1. ;
  1. ;NODE is optional - if defined it returns the 0 node of the form selected - should be passed by reference
  1. ;
  1. N FORM,Y S FORM=0
  1. S TK=$G(TK)
  1. I TK'=0,TK'=1 D
  1. .K DIR S DIR(0)="YA",DIR("A")="Do you want to select a form from the toolkit? "
  1. .D ^DIR
  1. .I Y'=-1,'$D(DIRUT) S TK=Y
  1. ;don't continue with the selection if it is not known whether or not the form is comming from the toolkit
  1. I (TK=1)!(TK=0) D
  1. .D:$G(IBDEVICE("LISTMAN")) FULL^VALM1
  1. .K DIC S DIC("S")=$S(TK:"I $P($G(^(0)),U,7),$P($G(^(0)),U)'=""TOOL KIT"",$P($G(^(0)),U)'=""WORKCOPY"",$P($G(^(0)),U)'=""DEFAULTS""",1:"I '$P($G(^(0)),U,7)"),DIC=357,DIC(0)="AEQ"_$S($D(NODE):"Z",1:"")
  1. .S DIC("A")="Select a FORM: "
  1. .D ^DIC S:+Y>0 FORM=+Y
  1. I FORM,$D(NODE) S NODE=Y(0)
  1. K DIC,Y,DIR
  1. Q FORM
  1. CLINICS(FORM,ARY) ;finds the list of clinics using FORM
  1. ;@ARY@(0) is set to the number of clinics found
  1. ;ARY is where to put the list of clinics
  1. ;
  1. N CLINIC,SETUP,IDX,COUNT,NAME
  1. K @ARY
  1. S COUNT=0
  1. F IDX="C","D","E","F","G","H","I","J" D
  1. .S SETUP="" F S SETUP=$O(^SD(409.95,IDX,FORM,SETUP)) Q:'SETUP D
  1. ..S CLINIC=$P($G(^SD(409.95,SETUP,0)),"^",1)
  1. ..Q:'CLINIC
  1. ..S NAME=$P($G(^SC(CLINIC,0)),"^",1)
  1. ..Q:NAME=""
  1. ..I '$D(@ARY@(NAME)) S @ARY@(NAME)=CLINIC,COUNT=COUNT+1
  1. S @ARY@(0)=COUNT
  1. Q
  1. LIST(ARY,SCRNSIZE) ;
  1. ;ARY is the same as in CLINICS
  1. N CLINIC,COUNT,DIR,DTOUT,DUOUT,DIRUT,DIROUT
  1. S DIR(0)="YO",DIR("B")="Y",DIR("A")="List the clinics using the form"
  1. D ^DIR K DIR I '$D(DIRUT),Y D
  1. .S (COUNT,CLINIC)=0
  1. .S DIR(0)="E"
  1. .F S CLINIC=$O(@ARY@(CLINIC)) Q:CLINIC="" W !,CLINIC S COUNT=COUNT+1 I COUNT=SCRNSIZE D ^DIR Q:'Y S COUNT=0
  1. .I '$D(DUOUT) D:COUNT>0 ^DIR
  1. Q