IBDF2G ;ALB/CJM - ENCOUNTER FORM - (prints input field);07/20/94
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
MFLD(FIELD) ;for printing the multiple choice field=FIELD
N BLOCK,LABEL,ROW,COL,NODE,CHOICE,ID,DISP,FNAME,FID,ALLOWED,HDR,QLFR,PI
Q:'$G(FIELD)
S NODE=$G(^IBE(357.93,FIELD,0))
S BLOCK=$P(NODE,"^",8)
;if the input field does not belong to the right block, reindex it and quit
I BLOCK'=IBBLK K DA S DA=FIELD,DIK="^IBE(357.93," D IX^DIK K DIK Q
;
;get the package interface
S PI=$P(NODE,"^",6)
;
S COL=$P(NODE,"^",3)
S ROW=$P(NODE,"^",4)
S HDR=$P(NODE,"^",2)
I HDR]" ",ROW=+ROW,COL=+COL
E S HDR=""
S DISP=$P(NODE,"^",7)
S FNAME=$P(NODE,"^")
S ALLOWED=$P(NODE,"^",9)
D:HDR]"" DRWSTR^IBDFU(+ROW,+COL,HDR,DISP)
;
;print the choices
S FID="M"_FIELD
S CHOICE=0 F S CHOICE=$O(^IBE(357.93,FIELD,1,CHOICE)) Q:'CHOICE D
.S NODE=$G(^IBE(357.93,FIELD,1,CHOICE,0))
.S ID=$P(NODE,"^",8) ;the ID of the choice
.S LABEL=$P(NODE,"^",5)
.S COL=$P(NODE,"^",2)
.S ROW=$P(NODE,"^",3)
.S DISP=$P(NODE,"^",4)
.I LABEL]" ",ROW=+ROW,COL=+COL
.E S LABEL=""
.D:LABEL]"" DRWSTR^IBDFU(ROW,COL,LABEL,DISP)
.S COL=$P(NODE,"^",6)
.S ROW=$P(NODE,"^",7)
.S QLFR=$P(NODE,"^",9)
.I ROW=+ROW,COL=+COL D DRWBBL^IBDFM1(ROW,COL,PI,ID,FNAME,FID,ALLOWED,LABEL,HDR,QLFR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF2G 1324 printed Nov 22, 2024@18:01:34 Page 2
IBDF2G ;ALB/CJM - ENCOUNTER FORM - (prints input field);07/20/94
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
MFLD(FIELD) ;for printing the multiple choice field=FIELD
+1 NEW BLOCK,LABEL,ROW,COL,NODE,CHOICE,ID,DISP,FNAME,FID,ALLOWED,HDR,QLFR,PI
+2 if '$GET(FIELD)
QUIT
+3 SET NODE=$GET(^IBE(357.93,FIELD,0))
+4 SET BLOCK=$PIECE(NODE,"^",8)
+5 ;if the input field does not belong to the right block, reindex it and quit
+6 IF BLOCK'=IBBLK
KILL DA
SET DA=FIELD
SET DIK="^IBE(357.93,"
DO IX^DIK
KILL DIK
QUIT
+7 ;
+8 ;get the package interface
+9 SET PI=$PIECE(NODE,"^",6)
+10 ;
+11 SET COL=$PIECE(NODE,"^",3)
+12 SET ROW=$PIECE(NODE,"^",4)
+13 SET HDR=$PIECE(NODE,"^",2)
+14 IF HDR]" "
IF ROW=+ROW
IF COL=+COL
+15 IF '$TEST
SET HDR=""
+16 SET DISP=$PIECE(NODE,"^",7)
+17 SET FNAME=$PIECE(NODE,"^")
+18 SET ALLOWED=$PIECE(NODE,"^",9)
+19 if HDR]""
DO DRWSTR^IBDFU(+ROW,+COL,HDR,DISP)
+20 ;
+21 ;print the choices
+22 SET FID="M"_FIELD
+23 SET CHOICE=0
FOR
SET CHOICE=$ORDER(^IBE(357.93,FIELD,1,CHOICE))
if 'CHOICE
QUIT
Begin DoDot:1
+24 SET NODE=$GET(^IBE(357.93,FIELD,1,CHOICE,0))
+25 ;the ID of the choice
SET ID=$PIECE(NODE,"^",8)
+26 SET LABEL=$PIECE(NODE,"^",5)
+27 SET COL=$PIECE(NODE,"^",2)
+28 SET ROW=$PIECE(NODE,"^",3)
+29 SET DISP=$PIECE(NODE,"^",4)
+30 IF LABEL]" "
IF ROW=+ROW
IF COL=+COL
+31 IF '$TEST
SET LABEL=""
+32 if LABEL]""
DO DRWSTR^IBDFU(ROW,COL,LABEL,DISP)
+33 SET COL=$PIECE(NODE,"^",6)
+34 SET ROW=$PIECE(NODE,"^",7)
+35 SET QLFR=$PIECE(NODE,"^",9)
+36 IF ROW=+ROW
IF COL=+COL
DO DRWBBL^IBDFM1(ROW,COL,PI,ID,FNAME,FID,ALLOWED,LABEL,HDR,QLFR)
End DoDot:1
+37 QUIT
