IBDF2G.m

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

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