| 1 | IBDFQSL2 ;ALB/CJM/AAS/MAF - ENCOUNTER FORM - Quick selection edit (cont.);12-Jun-95
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;**34**;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | GETLST(FORM,BLOCK,LIST,INTRFACE,ARY,FILTER,COUNT) ; -- returns any specified selection list for a clinic
|
|---|
| 5 | ; -- input FORM = ien of entry in 357
|
|---|
| 6 | ; BLOCK = ien of entry in 357.1
|
|---|
| 7 | ; LIST = ien of entry in 357.2
|
|---|
| 8 | ; INTRFACE = name of selection list in package interface file
|
|---|
| 9 | ; ARY = name of array to return list in
|
|---|
| 10 | ; FILTER = predefined filters (optional, default = 1)
|
|---|
| 11 | ; 1 = must be selection list
|
|---|
| 12 | ; 2 = only visit cpts on list
|
|---|
| 13 | ;
|
|---|
| 14 | ; -- output The format of the returned array is as follows
|
|---|
| 15 | ; @ARY@(0) = count of array element (0 of nothing found)
|
|---|
| 16 | ; @ARY@(1) = ^group header
|
|---|
| 17 | ; @ARY@(2) = problem ien or cpt or icd code^user defined text
|
|---|
| 18 | ; @ARY@(3) = problem ien or cpt or icd code^used defined text
|
|---|
| 19 | ; @ARY@(k) = ^next group header
|
|---|
| 20 | ; @ARY@(k+1) = problem ien or cpt or icd code^user define text
|
|---|
| 21 | ;
|
|---|
| 22 | Q:'FORM!('BLOCK)!('LIST)!('INTRFACE)
|
|---|
| 23 | N OLDARY,IBDTMP
|
|---|
| 24 | S COUNT=$G(COUNT,0)
|
|---|
| 25 | I $G(FILTER)<1 S FILTER=1 ;default value=1
|
|---|
| 26 | I FILTER>1 S OLDARY=ARY,ARY="IBDTMP"
|
|---|
| 27 | S @ARY@(0)=+$G(@ARY@(0))
|
|---|
| 28 | D COPYLIST(LIST,ARY,.COUNT)
|
|---|
| 29 | S @ARY@(0)=COUNT
|
|---|
| 30 | I FILTER=2 D F2^IBDF18A1(OLDARY)
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | COPYLIST(LIST,ARY,COUNT) ;copies the entries from LIST to @ARY, starting subscript at COUNT+1
|
|---|
| 34 | ;
|
|---|
| 35 | N SLCTN,SUBCOL,TEXT,IEN,NODE,TSUBCOL,NODE,GROUP,ORDER,HDR,GRPORDR
|
|---|
| 36 | ;
|
|---|
| 37 | D SUBCOL^IBDF18A1(LIST,.TSUBCOL) ;find the subcolumn containing the text
|
|---|
| 38 | ;
|
|---|
| 39 | S GRPORDR=""
|
|---|
| 40 | F S GRPORDR=$O(^IBE(357.4,"APO",LIST,GRPORDR)) Q:GRPORDR="" D
|
|---|
| 41 | .S GROUP=0
|
|---|
| 42 | .F S GROUP=$O(^IBE(357.4,"APO",LIST,GRPORDR,GROUP)) Q:'GROUP D
|
|---|
| 43 | ..S HDR=$P($G(^IBE(357.4,GROUP,0)),"^") ;I HDR="BLANK" S HDR="" If don't want to print BLANK group
|
|---|
| 44 | ..S COUNT=COUNT+1,@ARY@(COUNT)="^"_HDR_"^^^"_GROUP_"^"_GRPORDR
|
|---|
| 45 | ..S ORDER=""
|
|---|
| 46 | ..F S ORDER=$O(^IBE(357.3,"APO",LIST,GROUP,ORDER)) Q:ORDER="" D
|
|---|
| 47 | ...S SLCTN=0
|
|---|
| 48 | ...F S SLCTN=$O(^IBE(357.3,"APO",LIST,GROUP,ORDER,SLCTN)) Q:'SLCTN D
|
|---|
| 49 | ....S NODE=$G(^IBE(357.3,SLCTN,0))
|
|---|
| 50 | ....S IEN=$P(NODE,"^")
|
|---|
| 51 | ....S SUBCOL=$O(^IBE(357.3,SLCTN,1,"B",+TSUBCOL,0))
|
|---|
| 52 | ....;
|
|---|
| 53 | ....I 'SUBCOL D Q ;placeholders
|
|---|
| 54 | .....S TEXT=$S($P(NODE,"^",6)?1E.E:$P(NODE,"^",6),1:"BLANK")
|
|---|
| 55 | .....S COUNT=COUNT+1
|
|---|
| 56 | .....S @ARY@(COUNT)=" "_"^"_TEXT_"^"_LIST_"^"_SLCTN_"^"_GROUP_"^"_ORDER Q
|
|---|
| 57 | ....;
|
|---|
| 58 | ....S NODE=$G(^IBE(357.3,SLCTN,1,SUBCOL,0))
|
|---|
| 59 | ....S:$P(NODE,"^")=TSUBCOL TEXT=$P(NODE,"^",2)
|
|---|
| 60 | ....;
|
|---|
| 61 | ....I $L(TEXT) S COUNT=COUNT+1,@ARY@(COUNT)=IEN_"^"_TEXT_"^"_LIST_"^"_SLCTN_"^"_GROUP_"^"_ORDER Q
|
|---|
| 62 | Q
|
|---|
