- IBDFU4 ;ALB/CJM - ENCOUNTER FORM - BUILD FORM(write single form block to array for display,position & size copied block) ; 08-JAN-1993
- ;;3.0;AUTOMATED INFO COLLECTION SYS;**10**;APR 24, 1997
- ;
- IDXBLOCK ; create list containing block rows for list processor
- ;
- N I
- W !,"... BUILDING THE FORM BLOCK ..."
- Q:$$BLKDESCR^IBDFU1B(.IBBLK)
- ;
- ;keep small blocks in memory
- ;I ((IBBLK("H")+1)*(IBBLK("W")+1))<4000 S VALMAR="IBMEMARY"
- ;
- K @VALMAR D KILL^VALM10()
- D BLNKFORM^IBDF5A(0,IBBLK("H")-1,IBBLK("W"))
- S I="",$P(I,"~",IBBLK("W")+1)="~"
- S @VALMAR@(IBBLK("H")+1,0)=" "_I
- S VALMCNT=IBBLK("H")+1
- D DRWBLOCK^IBDF2A1(.IBBLK,1)
- Q
- POS(NEWBLOCK,DFLTX,DFLTY) ;allows the user to position and size the block
- ;NEWBLOCK = block to be edited
- ;DFLTY - default value for starting row
- ;DFLTX - default value for starting column
- N IBX,IBY ;used in the input template
- S:$G(DFLTX)=+$G(DFLTX) $P(NODE,"^",5)=DFLTX
- S:$G(DFLTY)=+$G(DFLTY) $P(NODE,"^",4)=DFLTY
- N NODE,IBBLK,IBDONE
- S IBBLK=NEWBLOCK
- S NODE=$G(^IBE(357.1,NEWBLOCK,0))
- ;set defaults for starting column, starting row
- S ^IBE(357.1,NEWBLOCK,0)=NODE,IBDONE=0
- K DIE S DIE=357.1,DA=NEWBLOCK,DR="[IBDF POSITION COPIED BLOCK]"
- D ^DIE K DIE,DR,DA
- I 'IBDONE D DLTBLK^IBDFU3(NEWBLOCK,IBFORM,357.1)
- Q
- CURX() ;returns the current X position (top left corner of displayed poriton of the form - internal column value)
- N IB
- S IB=+$G(VALMLFT),IB=IB-5 S:IB<0 IB=0
- Q IB
- CURY() ;returns the current Y position (top left corner of displayed poriton of the form - internal row value)
- N IB
- S IB=+$G(VALMBG),IB=IB-1 S:IB<0 IB=0
- Q IB
- SLCTFORM(TK,NODE) ;allows the user to select a form and returns the IEN
- ;returns 0 if no form selected
- ;
- ;INPUTS
- ;if TK=0 assumes form should not be a toolkit form
- ;if TK=1 assumes form should be a toolkit form
- ;otherwise, ask the user if the he wants to select fromt he toolkit
- ;
- ;NODE is optional - if defined it returns the 0 node of the form selected - should be passed by reference
- ;
- N FORM,Y S FORM=0
- S TK=$G(TK)
- I TK'=0,TK'=1 D
- .K DIR S DIR(0)="YA",DIR("A")="Do you want to select a form from the toolkit? "
- .D ^DIR
- .I Y'=-1,'$D(DIRUT) S TK=Y
- ;don't continue with the selection if it is not known whether or not the form is comming from the toolkit
- I (TK=1)!(TK=0) D
- .D:$G(IBDEVICE("LISTMAN")) FULL^VALM1
- .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:"")
- .S DIC("A")="Select a FORM: "
- .D ^DIC S:+Y>0 FORM=+Y
- I FORM,$D(NODE) S NODE=Y(0)
- K DIC,Y,DIR
- Q FORM
- CLINICS(FORM,ARY) ;finds the list of clinics using FORM
- ;@ARY@(0) is set to the number of clinics found
- ;ARY is where to put the list of clinics
- ;
- N CLINIC,SETUP,IDX,COUNT,NAME
- K @ARY
- S COUNT=0
- F IDX="C","D","E","F","G","H","I","J" D
- .S SETUP="" F S SETUP=$O(^SD(409.95,IDX,FORM,SETUP)) Q:'SETUP D
- ..S CLINIC=$P($G(^SD(409.95,SETUP,0)),"^",1)
- ..Q:'CLINIC
- ..S NAME=$P($G(^SC(CLINIC,0)),"^",1)
- ..Q:NAME=""
- ..I '$D(@ARY@(NAME)) S @ARY@(NAME)=CLINIC,COUNT=COUNT+1
- S @ARY@(0)=COUNT
- Q
- LIST(ARY,SCRNSIZE) ;
- ;ARY is the same as in CLINICS
- N CLINIC,COUNT,DIR,DTOUT,DUOUT,DIRUT,DIROUT
- S DIR(0)="YO",DIR("B")="Y",DIR("A")="List the clinics using the form"
- D ^DIR K DIR I '$D(DIRUT),Y D
- .S (COUNT,CLINIC)=0
- .S DIR(0)="E"
- .F S CLINIC=$O(@ARY@(CLINIC)) Q:CLINIC="" W !,CLINIC S COUNT=COUNT+1 I COUNT=SCRNSIZE D ^DIR Q:'Y S COUNT=0
- .I '$D(DUOUT) D:COUNT>0 ^DIR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFU4 3589 printed Jan 18, 2025@03:54:50 Page 2
- 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
- +2 ;
- IDXBLOCK ; create list containing block rows for list processor
- +1 ;
- +2 NEW I
- +3 WRITE !,"... BUILDING THE FORM BLOCK ..."
- +4 if $$BLKDESCR^IBDFU1B(.IBBLK)
- QUIT
- +5 ;
- +6 ;keep small blocks in memory
- +7 ;I ((IBBLK("H")+1)*(IBBLK("W")+1))<4000 S VALMAR="IBMEMARY"
- +8 ;
- +9 KILL @VALMAR
- DO KILL^VALM10()
- +10 DO BLNKFORM^IBDF5A(0,IBBLK("H")-1,IBBLK("W"))
- +11 SET I=""
- SET $PIECE(I,"~",IBBLK("W")+1)="~"
- +12 SET @VALMAR@(IBBLK("H")+1,0)=" "_I
- +13 SET VALMCNT=IBBLK("H")+1
- +14 DO DRWBLOCK^IBDF2A1(.IBBLK,1)
- +15 QUIT
- POS(NEWBLOCK,DFLTX,DFLTY) ;allows the user to position and size the block
- +1 ;NEWBLOCK = block to be edited
- +2 ;DFLTY - default value for starting row
- +3 ;DFLTX - default value for starting column
- +4 ;used in the input template
- NEW IBX,IBY
- +5 if $GET(DFLTX)=+$GET(DFLTX)
- SET $PIECE(NODE,"^",5)=DFLTX
- +6 if $GET(DFLTY)=+$GET(DFLTY)
- SET $PIECE(NODE,"^",4)=DFLTY
- +7 NEW NODE,IBBLK,IBDONE
- +8 SET IBBLK=NEWBLOCK
- +9 SET NODE=$GET(^IBE(357.1,NEWBLOCK,0))
- +10 ;set defaults for starting column, starting row
- +11 SET ^IBE(357.1,NEWBLOCK,0)=NODE
- SET IBDONE=0
- +12 KILL DIE
- SET DIE=357.1
- SET DA=NEWBLOCK
- SET DR="[IBDF POSITION COPIED BLOCK]"
- +13 DO ^DIE
- KILL DIE,DR,DA
- +14 IF 'IBDONE
- DO DLTBLK^IBDFU3(NEWBLOCK,IBFORM,357.1)
- +15 QUIT
- CURX() ;returns the current X position (top left corner of displayed poriton of the form - internal column value)
- +1 NEW IB
- +2 SET IB=+$GET(VALMLFT)
- SET IB=IB-5
- if IB<0
- SET IB=0
- +3 QUIT IB
- CURY() ;returns the current Y position (top left corner of displayed poriton of the form - internal row value)
- +1 NEW IB
- +2 SET IB=+$GET(VALMBG)
- SET IB=IB-1
- if IB<0
- SET IB=0
- +3 QUIT IB
- SLCTFORM(TK,NODE) ;allows the user to select a form and returns the IEN
- +1 ;returns 0 if no form selected
- +2 ;
- +3 ;INPUTS
- +4 ;if TK=0 assumes form should not be a toolkit form
- +5 ;if TK=1 assumes form should be a toolkit form
- +6 ;otherwise, ask the user if the he wants to select fromt he toolkit
- +7 ;
- +8 ;NODE is optional - if defined it returns the 0 node of the form selected - should be passed by reference
- +9 ;
- +10 NEW FORM,Y
- SET FORM=0
- +11 SET TK=$GET(TK)
- +12 IF TK'=0
- IF TK'=1
- Begin DoDot:1
- +13 KILL DIR
- SET DIR(0)="YA"
- SET DIR("A")="Do you want to select a form from the toolkit? "
- +14 DO ^DIR
- +15 IF Y'=-1
- IF '$DATA(DIRUT)
- SET TK=Y
- End DoDot:1
- +16 ;don't continue with the selection if it is not known whether or not the form is comming from the toolkit
- +17 IF (TK=1)!(TK=0)
- Begin DoDot:1
- +18 if $GET(IBDEVICE("LISTMAN"))
- DO FULL^VALM1
- +19 KILL DIC
- SET DIC("S")=$SELECT(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)")
- SET DIC=357
- SET DIC(0)="AEQ"_$SELECT($DATA(NODE):"Z",1:"")
- +20 SET DIC("A")="Select a FORM: "
- +21 DO ^DIC
- if +Y>0
- SET FORM=+Y
- End DoDot:1
- +22 IF FORM
- IF $DATA(NODE)
- SET NODE=Y(0)
- +23 KILL DIC,Y,DIR
- +24 QUIT FORM
- CLINICS(FORM,ARY) ;finds the list of clinics using FORM
- +1 ;@ARY@(0) is set to the number of clinics found
- +2 ;ARY is where to put the list of clinics
- +3 ;
- +4 NEW CLINIC,SETUP,IDX,COUNT,NAME
- +5 KILL @ARY
- +6 SET COUNT=0
- +7 FOR IDX="C","D","E","F","G","H","I","J"
- Begin DoDot:1
- +8 SET SETUP=""
- FOR
- SET SETUP=$ORDER(^SD(409.95,IDX,FORM,SETUP))
- if 'SETUP
- QUIT
- Begin DoDot:2
- +9 SET CLINIC=$PIECE($GET(^SD(409.95,SETUP,0)),"^",1)
- +10 if 'CLINIC
- QUIT
- +11 SET NAME=$PIECE($GET(^SC(CLINIC,0)),"^",1)
- +12 if NAME=""
- QUIT
- +13 IF '$DATA(@ARY@(NAME))
- SET @ARY@(NAME)=CLINIC
- SET COUNT=COUNT+1
- End DoDot:2
- End DoDot:1
- +14 SET @ARY@(0)=COUNT
- +15 QUIT
- LIST(ARY,SCRNSIZE) ;
- +1 ;ARY is the same as in CLINICS
- +2 NEW CLINIC,COUNT,DIR,DTOUT,DUOUT,DIRUT,DIROUT
- +3 SET DIR(0)="YO"
- SET DIR("B")="Y"
- SET DIR("A")="List the clinics using the form"
- +4 DO ^DIR
- KILL DIR
- IF '$DATA(DIRUT)
- IF Y
- Begin DoDot:1
- +5 SET (COUNT,CLINIC)=0
- +6 SET DIR(0)="E"
- +7 FOR
- SET CLINIC=$ORDER(@ARY@(CLINIC))
- if CLINIC=""
- QUIT
- WRITE !,CLINIC
- SET COUNT=COUNT+1
- IF COUNT=SCRNSIZE
- DO ^DIR
- if 'Y
- QUIT
- SET COUNT=0
- +8 IF '$DATA(DUOUT)
- if COUNT>0
- DO ^DIR
- End DoDot:1
- +9 QUIT