- IBDF2H ;ALB/CJM - ENCOUNTER FORM - (prints hand print field);07/20/94
- ;;3.0;AUTOMATED INFO COLLECTION SYS;**25**;APR 24, 1997
- ;
- HFLD(FIELD) ;for printing the input field=FIELD
- N BLOCK,LABEL,ROW,COL,NODE,DISP,FNAME,FID,TYPEDATA,PI,FORMAT,WIDTH,UNIT
- Q:'$G(FIELD)
- S NODE=$G(^IBE(359.94,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(359.94," D IX^DIK K DIK Q
- S PI=$P(NODE,"^",6)
- S COL=$P(NODE,"^",3)
- S ROW=$P(NODE,"^",4)
- S LABEL=$P(NODE,"^",2)
- S DISP=$P(NODE,"^",5)
- S TYPEDATA=$P(NODE,"^",10)
- S FNAME=$P(NODE,"^")
- S FID="H"_FIELD
- D DRWSTR^IBDFU(+ROW,+COL,LABEL,DISP)
- ;
- I TYPEDATA S NODE=$G(^IBE(359.1,TYPEDATA,0)) S FORMAT=$$FRMT^IBDF2F(NODE,$G(IBAPPT)),WIDTH=$P(NODE,"^",6),UNIT=$P(NODE,"^",11)
- D DRWHAND^IBDFM1(ROW,COL+$L(LABEL)+1,WIDTH,PI,1,FID,FNAME,LABEL,"",1,2,2,TYPEDATA)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF2H 925 printed Feb 19, 2025@00:17:50 Page 2
- IBDF2H ;ALB/CJM - ENCOUNTER FORM - (prints hand print field);07/20/94
- +1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**25**;APR 24, 1997
- +2 ;
- HFLD(FIELD) ;for printing the input field=FIELD
- +1 NEW BLOCK,LABEL,ROW,COL,NODE,DISP,FNAME,FID,TYPEDATA,PI,FORMAT,WIDTH,UNIT
- +2 if '$GET(FIELD)
- QUIT
- +3 SET NODE=$GET(^IBE(359.94,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(359.94,"
- DO IX^DIK
- KILL DIK
- QUIT
- +7 SET PI=$PIECE(NODE,"^",6)
- +8 SET COL=$PIECE(NODE,"^",3)
- +9 SET ROW=$PIECE(NODE,"^",4)
- +10 SET LABEL=$PIECE(NODE,"^",2)
- +11 SET DISP=$PIECE(NODE,"^",5)
- +12 SET TYPEDATA=$PIECE(NODE,"^",10)
- +13 SET FNAME=$PIECE(NODE,"^")
- +14 SET FID="H"_FIELD
- +15 DO DRWSTR^IBDFU(+ROW,+COL,LABEL,DISP)
- +16 ;
- +17 IF TYPEDATA
- SET NODE=$GET(^IBE(359.1,TYPEDATA,0))
- SET FORMAT=$$FRMT^IBDF2F(NODE,$GET(IBAPPT))
- SET WIDTH=$PIECE(NODE,"^",6)
- SET UNIT=$PIECE(NODE,"^",11)
- +18 DO DRWHAND^IBDFM1(ROW,COL+$LENGTH(LABEL)+1,WIDTH,PI,1,FID,FNAME,LABEL,"",1,2,2,TYPEDATA)
- +19 QUIT