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 Apr 09, 2024@21:50:31 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
