IBDFU5 ;ALB/CJM - ENCOUNTER FORM (utilities) ;JAN 16,1993 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997 TOPNBOT(BLOCK,TOP,BOT) ;finds the top and bottom of the block - pass TOP and BOT by reference N NODE S NODE=$G(^IBE(357.1,BLOCK,0)) S TOP=+$P(NODE,"^",4),BOT=(TOP+(+$P(NODE,"^",7)))-1 Q RUSURE(NAME) ;obtains verification from the user for deletion- returns 1 if answered YES, otherwise NO ;if NAME is defined it will be used in the prompt N RET S RET=1 K DIR S DIR(0)="Y",DIR("A")=$S(NAME="":"Are you sure",1:"Are you sure "_NAME_" should be deleted"),DIR("B")="NO" D ^DIR K DIR I (Y<1)!$D(DIRUT) S RET=0 Q RET PAUSE ; N ANS W !,$C(7),"Press RETURN to continue..." R ANS:DTIME Q ; NOGRPHCS ;sets graphics variables to "_" and "|" S (IOVL,IOBLC,IOBRC)="|",(IOHL,IOTRC,IOTLC)="_" Q ; HELP1 ;displays a list of the record's fields from file 357.6, IB PACKAGE INTERFACE file - EXECUTABLE HELP FOR FIELDS IN THE DATA FIELD FILE ; ;INPUT - D0 is a pointer to a DATA FIELD (file 357.5) ; N RTN Q:'$G(D0) W !,"WHAT DATA SHOULD BE PRINTED IN THE SUBFIELD? CHOOSE FROM:" S RTN=$P($G(^IBE(357.5,D0,0)),"^",3) Q:'RTN D SHOWDATA Q HELP2 ;displays a list of the record's fields from file 357.6, IB PACKAGE INTERFACE file - EXECUTABLE HELP FOR FIELDS IN THE SELECTION LIST FILE ; ;INPUT - D0 should be a pointer to a SELECTION LIST ; N RTN W !,"WHAT DATA SHOULD BE PRINTED IN THIS SUBCOLUMN? CHOOSE FROM:" Q:'$G(D0) S RTN=$P($G(^IBE(357.2,D0,0)),"^",11) Q:'RTN D SHOWDATA W !,"You can also enter 0 if you want the item number entered in the subcolumn.",! Q ; HELP3 ;displays a list of the record's fields from file 357.6, IB PACKAGE INTERFACE file - used to display available data to the user before he enters a data field label ; ;INPUT - D0 is a pointer to a DATA FIELD (file 357.5) N RTN W !,"Available Data:" Q:'$G(D0) S RTN=$P($G(^IBE(357.5,D0,0)),"^",3) Q:'RTN D SHOWDATA Q ; HELP4 ;displays a list of the record's fields from file 357.6, IB PACKAGE INTERFACE file - used to display to the user the available data before a subcolumn to a selection list ; ;INPUT - D0 should be a pointer to a SELECTION LIST ; N RTN W !,"Available Data:" Q:'$G(D0) S RTN=$P($G(^IBE(357.2,D0,0)),"^",11) Q:'RTN D SHOWDATA Q HELP5 ;for number of columns in list I $G(IBDEVICE("LISTMAN")) D FULL^VALM1 W !!,"A selection list COLUMN contains items on the list. It may consist of several",!,"subcolumns. For example, a typical column may have three subcolumns, one" W !,"containing a code, the second a description, and the third a marking area for",!,"the user to indicate his selections from the list. Besides going down the",!,"form, the list can can go across the form by having multiple columns." W !!,"Entering the number of columns is optional. By default the entire block will",!,"be filled with the list.",! I $G(IBDEVICE("LISTMAN")) D PAUSE^IBDFU5,RE^VALM4 Q ; SHOWDATA ;displays a discription of the the record returned by the package interface ; ;INPUT - RTN - ptr to the package interface file N NODE,SUB,ROW,COL,LINE,DESCR,CANSHOW,IEN S NODE=$G(^IBE(357.6,RTN,2)) ; ;piece 1 may not be displayable (an ien) S CANSHOW=$S($P(NODE,"^",17)=0:0,1:1) I 'CANSHOW S NODE="" ; F ROW=0:1:3 S LINE="" D W:(LINE'="") !,LINE .F COL=1:1:2 S SUB=COL+(2*ROW) D Q:LINE="" ..S DESCR="" ..I (SUB'=1) S NODE="",IEN=$O(^IBE(357.6,RTN,15,"C",SUB,0)) S:IEN NODE=$G(^IBE(357.6,RTN,15,IEN,0)) ..I NODE="" I (COL=1&'$D(^IBE(357.6,RTN,15,"C",SUB+1)))!((COL'=1)&(DESCR="(not applicable)")) Q ..S DESCR=$P(NODE,"^") I DESCR'="" S DESCR=DESCR_" :"_$P(NODE,"^",2)_" char" ..I DESCR="" S DESCR="(N/A)" ..S LINE=LINE_$S(DESCR="":"",1:$$PADRIGHT^IBDFU(" "_SUB_"= "_DESCR,39)) Q ; RESET ;resets the scrolling area of the screen to that defined by List Manager ;I $G(IOSTBM)'="" S IOTM=IOSL-4,IOBM=IOSL W IOSC,@IOSTBM,IORC Q VARIABLE(VAR) ;returns 0 if VAR is not syntactically a good local variable name, 1 otherwise N I,LEN,CHAR,GOOD S LEN=$L(VAR) S CHAR=$E(VAR) I '((CHAR?1A)!(CHAR="%")) Q 0 S GOOD=1 F I=2:1:LEN S CHAR=$E(VAR,I) I '((CHAR?1A)!(CHAR?1N)) S GOOD=0 Q Q GOOD ID1 ;writes identifier for subcolumn of selection list (file 357.2) N NODE,TYPE,PIECE,IEN S NODE=$G(^(0)) Q:NODE="" W "HEADER=",$$PADRIGHT^IBDFU($P(NODE,U,2),27)_" CONTENT=" I $P(NODE,U,4)=1 D .S TYPE=$P($G(^IBE(357.2,D0,0)),"^",11) Q:'TYPE .S PIECE=+$P(NODE,U,5) .W:'PIECE "#COUNT" .W:PIECE $$DATANAME^IBDFU1B(TYPE,PIECE) I $P(NODE,U,4)=2 D .S TYPE=$P(NODE,U,6) Q:'TYPE .W $P($G(^IBE(357.91,TYPE,0)),U) Q ; DFLTS() ;returns the default form if found, 0 otherwise N FORM S FORM=0 F S FORM=$O(^IBE(357,"B","DEFAULTS",FORM)) Q:'FORM Q:$P($G(^IBE(357,FORM,0)),"^",7) Q FORM ; OKPIECE(PI,PIECE) ;returns 1 if the piece=PIECE is selectable for the package interface=PI, 0 otherwise ; I ('$G(PIECE))!('$G(PI)) Q 0 N QUIT S QUIT=0 I PIECE=1 S QUIT=$S($P($G(^IBE(357.6,PI,2)),"^",17)'=0:1,1:0) I PIECE'=1 S QUIT=$D(^IBE(357.6,PI,15,"C",PIECE)) Q QUIT