source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF2G.m@ 1078

Last change on this file since 1078 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1IBDF2G ;ALB/CJM - ENCOUNTER FORM - (prints input field);07/20/94
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3MFLD(FIELD) ;for printing the multiple choice field=FIELD
4 N BLOCK,LABEL,ROW,COL,NODE,CHOICE,ID,DISP,FNAME,FID,ALLOWED,HDR,QLFR,PI
5 Q:'$G(FIELD)
6 S NODE=$G(^IBE(357.93,FIELD,0))
7 S BLOCK=$P(NODE,"^",8)
8 ;if the input field does not belong to the right block, reindex it and quit
9 I BLOCK'=IBBLK K DA S DA=FIELD,DIK="^IBE(357.93," D IX^DIK K DIK Q
10 ;
11 ;get the package interface
12 S PI=$P(NODE,"^",6)
13 ;
14 S COL=$P(NODE,"^",3)
15 S ROW=$P(NODE,"^",4)
16 S HDR=$P(NODE,"^",2)
17 I HDR]" ",ROW=+ROW,COL=+COL
18 E S HDR=""
19 S DISP=$P(NODE,"^",7)
20 S FNAME=$P(NODE,"^")
21 S ALLOWED=$P(NODE,"^",9)
22 D:HDR]"" DRWSTR^IBDFU(+ROW,+COL,HDR,DISP)
23 ;
24 ;print the choices
25 S FID="M"_FIELD
26 S CHOICE=0 F S CHOICE=$O(^IBE(357.93,FIELD,1,CHOICE)) Q:'CHOICE D
27 .S NODE=$G(^IBE(357.93,FIELD,1,CHOICE,0))
28 .S ID=$P(NODE,"^",8) ;the ID of the choice
29 .S LABEL=$P(NODE,"^",5)
30 .S COL=$P(NODE,"^",2)
31 .S ROW=$P(NODE,"^",3)
32 .S DISP=$P(NODE,"^",4)
33 .I LABEL]" ",ROW=+ROW,COL=+COL
34 .E S LABEL=""
35 .D:LABEL]"" DRWSTR^IBDFU(ROW,COL,LABEL,DISP)
36 .S COL=$P(NODE,"^",6)
37 .S ROW=$P(NODE,"^",7)
38 .S QLFR=$P(NODE,"^",9)
39 .I ROW=+ROW,COL=+COL D DRWBBL^IBDFM1(ROW,COL,PI,ID,FNAME,FID,ALLOWED,LABEL,HDR,QLFR)
40 Q
Note: See TracBrowser for help on using the repository browser.