- IBDFCMP1 ;ALB/MAF - AICS list of components on a form (cont.); 29-JUL-96
- ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- ;
- ;
- EXP ;EXPAND
- ; -- expand action
- N IBI,IBAT,VALMY,IBDVALM
- S (IBDCNT,IBDCNT1,VALMCNT)=0
- N IBDVALM,IBDAT,VALMY
- S VALMBCK=""
- D FULL^VALM1 S VALMBCK="R"
- D EN^VALM2($G(XQORNOD(0))) G REP:'$O(VALMY(0)) S IBDVALM=0
- F IBDVALM=0:0 S IBDVALM=$O(VALMY(IBDVALM)) Q:'IBDVALM S IBDOBJ=$G(IBBLOCK(IBDVALM)) S (IBDCNT,IBDCNT1,VALMCNT)=0 D EN^VALM("IBDF COMPONENT EXPAND")
- G REP
- ;
- ;
- INIT K ^TMP("FORMEXP",$J),^TMP("EXPIDX") D
- .S IBDFIFN=$P(IBDOBJ,"^")
- .F IBDNUM=0:0 S IBDNUM=$O(^TMP("FORM-OBJ",$J,IBDFIFN,IBDNUM)) Q:'IBDNUM I $P(IBDOBJ,"^",11)=$P($G(^TMP("FORM-OBJ",$J,IBDFIFN,IBDNUM)),"^",9) D
- ..N IBDFSC,IBDFNUM,IBDFSEL,IBDFHP,IBDFMC,IBDFROW,IBDFCOL
- ..S (IBDFSC,IBDFNUM)=0
- ..S IBDOBJ1=$G(^TMP("FORM-OBJ",$J,IBDFIFN,IBDNUM))
- ..S IBDF("PI")=+$P(IBDOBJ1,"^",2),IBDF("TYPE")=$P(IBDOBJ1,"^",5)
- ..S IBDF("IEN")=+$P(IBDOBJ1,"^",6),IBDF("VITAL")=$P(IBDOBJ1,"^",7)
- ..I $P(IBDOBJ1,"^",5)="LIST" D ;SELECTION LIST
- ...S IBDFSEL=$P(^IBE(357.2,$P(IBDOBJ1,"^",6),0),"^")
- ...S IBDFSNOD=$O(^IBE(357.2,$P(IBDOBJ1,"^",6),1,0)) S IBDFNODE=$G(^IBE(357.2,$P(IBDOBJ1,"^",6),1,+IBDFSNOD,0)) S IBDFSEL=IBDFSEL_"^"_$P(IBDFNODE,"^",4)_"^"_$P(IBDFNODE,"^",3) S IBDFROW=4,IBDFCOL=5 D SETUP(IBDFSEL,IBDFROW,IBDFCOL)
- ...F S IBDFSC=$O(^IBE(357.2,IBDF("IEN"),2,"B",IBDFSC)) Q:'IBDFSC F S IBDFNUM=$O(^IBE(357.2,IBDF("IEN"),2,"B",IBDFSC,IBDFNUM)) Q:'IBDFNUM S IBDFSEL=$G(^IBE(357.2,IBDF("IEN"),2,IBDFNUM,0)) D SETUP1(IBDFSEL)
- ..I $P(IBDOBJ1,"^",5)="MC" D ;MULTIPLE CHOICE
- ...S IBDFMC=$G(^IBE(357.93,IBDF("IEN"),0)) S IBDFROW=4,IBDFCOL=3 D SETUP(IBDFMC,IBDFROW,IBDFCOL)
- ..I $P(IBDOBJ1,"^",5)="HP" D ;HAND PRINT FIELD
- ...S IBDFHP=$G(^IBE(359.94,IBDF("IEN"),0)) S IBDFROW=4,IBDFCOL=3 D SETUP(IBDFHP,IBDFROW,IBDFCOL)
- ..I $P(IBDOBJ1,"^",5)="DF" D ;DATA FIELDS
- ...S IBDFDF=$G(^IBE(357.5,IBDF("IEN"),0)) S IBDFROW=11,IBDFCOL=10 D SETUP(IBDFDF,IBDFROW,IBDFCOL)
- ..I $P(IBDOBJ1,"^",5)="FL" D ;FORM LINE
- ...S IBDFFL=$G(^IBE(357.7,IBDF("IEN"),0)) S IBDFROW=3,IBDFCOL=2 D SETUP(IBDFFL,IBDFROW,IBDFCOL)
- ..I $P(IBDOBJ1,"^",5)="TA" D ;TEXT AREA
- ...S IBDFTA=$G(^IBE(357.8,IBDF("IEN"),0)) S IBDFROW=4,IBDFCOL=3 D SETUP(IBDFTA,IBDFROW,IBDFCOL)
- Q
- ;
- ;
- REP ; -- Redisplay initial screen
- S IBDFIFN=$S('$D(IBDFIFN):+$P(IBDOBJ,"^"),1:IBDFIFN) D INIT1^IBDFCMP S VALMBCK="R" Q
- Q
- ;
- ;
- SETUP(IBOBJECT,IBROW,IBCOL) ; -- Setting up the data for list manager
- S IBDCNT1=IBDCNT1+1
- S X=""
- S X=$$SETSTR^VALM1(X,X,1,80) D TMP
- S X="",X=$P(IBOBJECT,"^")
- S X=$$SETSTR^VALM1(X,X,1,25)
- S IBDVAL=$S($P(IBDOBJ1,"^",5)]"":$P(IBDOBJ1,"^",5),1:"")
- S X=$$SETSTR^VALM1(IBDVAL,X,30,10)
- S IBDVAL=$S($P(IBOBJECT,"^",IBROW):$P(IBOBJECT,"^",IBROW)+1,$P(IBOBJECT,"^",IBROW)=0:1,1:"N/A")
- S X=$$SETSTR^VALM1($J(IBDVAL,3),X,48,6)
- S IBDVAL=$S($P(IBOBJECT,"^",IBCOL):$P(IBOBJECT,"^",IBCOL)+1,$P(IBOBJECT,"^",IBCOL)=0:1,1:"N/A")
- S X=$$SETSTR^VALM1($J(IBDVAL,4),X,58,5)
- ;D TMP,CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
- I X]"",$P(IBDOBJ1,"^",5)="LIST" D
- .S IBDVAL=$S($P(^IBE(357.2,IBDF("IEN"),0),"^",7):$P(^IBE(357.2,IBDF("IEN"),0),"^",7),1:"N/A")
- .S IBDVAL=$J($S(IBDVAL=1:"1 Space",IBDVAL=2:"2 Spaces",IBDVAL=3:"LINE",IBDVAL=4:"Sp/Ln/Sp",1:"N/A"),9)
- .S X=$$SETSTR^VALM1(IBDVAL,X,71,9)
- .D TMP,CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
- .S X="",X=$$SETSTR^VALM1(X,X,1,80) D TMP
- .S IBDVAL=" "_"Subcolumn"_" "_"Type"_" "_"Data"_" "_"Width"_" "_"Qualifier"_" "_"Rule"_" "_"Edit"
- .S X="",X=$$SETSTR^VALM1(IBDVAL,X,1,80) D TMP,CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
- I $P(IBDOBJ1,"^",5)'="LIST" D
- .D TMP,CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
- Q
- SETUP1(IBOBJECT) ; -- Setup of the subcolumn info for the Selection list
- S X=""
- S X=$$SETSTR^VALM1($P(IBOBJECT,"^"),X,8,2)
- S IBDVAL=$S($P(IBOBJECT,"^",4)]"":$P(IBOBJECT,"^",4),1:"")
- S IBDVAL=$J($$LOWER^VALM1($S(IBDVAL=1:"TEXT",IBDVAL=2:"MARKING",1:"")),10)
- S X=$$SETSTR^VALM1(IBDVAL,X,11,10)
- S IBDVAL=$S($P(IBOBJECT,"^",5):$P(IBOBJECT,"^",5),1:"")
- S IBDVAL=$J($$LOWER^VALM1($S(IBDVAL=1:"CODE",IBDVAL=2:"SHORT NAME",IBDVAL=3:"DESCRIP.",1:"N/A")),10)
- S X=$$SETSTR^VALM1(IBDVAL,X,25,10)
- S IBDVAL=$S($P(IBOBJECT,"^",3)]"":$P(IBOBJECT,"^",3),1:"")
- S X=$$SETSTR^VALM1($J(IBDVAL,3),X,40,3)
- S IBDVAL=$S($P(IBOBJECT,"^",3)]"":$P(IBOBJECT,"^",3),1:"")
- S IBDVAL=$S($P(IBOBJECT,"^",9):$P(IBOBJECT,"^",9),1:"")
- S IBDVAL=$P($G(^IBD(357.98,+IBDVAL,0)),"^",3)
- S IBDVAL=$J($$LOWER^VALM1($S(IBDVAL]"":IBDVAL,1:"N/A")),10)
- S X=$$SETSTR^VALM1(IBDVAL,X,47,10)
- S IBDVAL=$S($P(IBOBJECT,"^",10):$P(IBOBJECT,"^",10),1:"")
- S IBDVAL=$J($$LOWER^VALM1($S(IBDVAL=0:"ANY NUMBER",IBDVAL=1:"ONLY 1",IBDVAL=2:"AT MOST 1",IBDVAL=3:"AT LEAST 1",1:"N/A")),10)
- S X=$$SETSTR^VALM1(IBDVAL,X,59,10)
- ;I $P(IBDOBJ1,"^",5)="LIST" D
- ;S IBDVAL=$S($P(^IBE(357.2,IBDF("IEN"),0),"^",7):$P(^IBE(357.2,IBDF("IEN"),0),"^",7),1:"N/A")
- ;S IBDVAL=$S(IBDVAL=1:"1 S",IBDVAL=2:"2 S",IBDVAL=3:"LIN",IBDVAL=4:"SLS",1:"N/A")
- S IBDVAL=$S($P(IBOBJECT,"^",7)=1:"Yes",1:"No")
- S X=$$SETSTR^VALM1($J(IBDVAL,3),X,77,3)
- D TMP
- Q
- ;
- ;
- TMP ; -- Set up Array
- S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
- S ^TMP("FORMEXP",$J,IBDCNT,0)=X,^TMP("FORMEXP",$J,"IDX",VALMCNT,IBDCNT1)=""
- S ^TMP("EXPIDX",$J,IBDCNT)=VALMCNT ;_"^"_IBDFIFN_"^"_IBDF("BLK")
- Q
- ;
- ;
- HDR ; -- print patient header
- S X=""
- S X=" Form Name: "_$E($P($G(^IBE(357,IBDFIFN,0)),"^"),1,25)
- S VALMHDR(1)=X
- S X=" Block Name: "_$E($P($G(^IBE(357.1,+$P(IBDOBJ,"^",11),0)),"^"),1,25)
- S VALMHDR(2)=X
- Q
- ;
- ;
- EXIT ; -- Exit code
- K ^TMP("FORMEXP",$J),^TMP("EXPIDX")
- Q
- HELP ; -- help code
- S X="?" D DISP^XQORM1 W !!
- Q
- IBDFCMP1 ;ALB/MAF - AICS list of components on a form (cont.); 29-JUL-96
- +1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- +2 ;
- +3 ;
- EXP ;EXPAND
- +1 ; -- expand action
- +2 NEW IBI,IBAT,VALMY,IBDVALM
- +3 SET (IBDCNT,IBDCNT1,VALMCNT)=0
- +4 NEW IBDVALM,IBDAT,VALMY
- +5 SET VALMBCK=""
- +6 DO FULL^VALM1
- SET VALMBCK="R"
- +7 DO EN^VALM2($GET(XQORNOD(0)))
- IF '$ORDER(VALMY(0))
- GOTO REP
- SET IBDVALM=0
- +8 FOR IBDVALM=0:0
- SET IBDVALM=$ORDER(VALMY(IBDVALM))
- IF 'IBDVALM
- QUIT
- SET IBDOBJ=$GET(IBBLOCK(IBDVALM))
- SET (IBDCNT,IBDCNT1,VALMCNT)=0
- DO EN^VALM("IBDF COMPONENT EXPAND")
- +9 GOTO REP
- +10 ;
- +11 ;
- INIT KILL ^TMP("FORMEXP",$JOB),^TMP("EXPIDX")
- Begin DoDot:1
- +1 SET IBDFIFN=$PIECE(IBDOBJ,"^")
- +2 FOR IBDNUM=0:0
- SET IBDNUM=$ORDER(^TMP("FORM-OBJ",$JOB,IBDFIFN,IBDNUM))
- IF 'IBDNUM
- QUIT
- IF $PIECE(IBDOBJ,"^",11)=$PIECE($GET(^TMP("FORM-OBJ",$JOB,IBDFIFN,IBDNUM)),"^",9)
- Begin DoDot:2
- +3 NEW IBDFSC,IBDFNUM,IBDFSEL,IBDFHP,IBDFMC,IBDFROW,IBDFCOL
- +4 SET (IBDFSC,IBDFNUM)=0
- +5 SET IBDOBJ1=$GET(^TMP("FORM-OBJ",$JOB,IBDFIFN,IBDNUM))
- +6 SET IBDF("PI")=+$PIECE(IBDOBJ1,"^",2)
- SET IBDF("TYPE")=$PIECE(IBDOBJ1,"^",5)
- +7 SET IBDF("IEN")=+$PIECE(IBDOBJ1,"^",6)
- SET IBDF("VITAL")=$PIECE(IBDOBJ1,"^",7)
- +8 ;SELECTION LIST
- IF $PIECE(IBDOBJ1,"^",5)="LIST"
- Begin DoDot:3
- +9 SET IBDFSEL=$PIECE(^IBE(357.2,$PIECE(IBDOBJ1,"^",6),0),"^")
- +10 SET IBDFSNOD=$ORDER(^IBE(357.2,$PIECE(IBDOBJ1,"^",6),1,0))
- SET IBDFNODE=$GET(^IBE(357.2,$PIECE(IBDOBJ1,"^",6),1,+IBDFSNOD,0))
- SET IBDFSEL=IBDFSEL_"^"_$PIECE(IBDFNODE,"^",4)_"^"_$PIECE(IBDFNODE,"^",3)
- SET IBDFROW=4
- SET IBDFCOL=5
- DO SETUP(IBDFSEL,IBDFROW,IBDFCOL)
- +11 FOR
- SET IBDFSC=$ORDER(^IBE(357.2,IBDF("IEN"),2,"B",IBDFSC))
- IF 'IBDFSC
- QUIT
- FOR
- SET IBDFNUM=$ORDER(^IBE(357.2,IBDF("IEN"),2,"B",IBDFSC,IBDFNUM))
- IF 'IBDFNUM
- QUIT
- SET IBDFSEL=$GET(^IBE(357.2,IBDF("IEN"),2,IBDFNUM,0))
- DO SETUP1(IBDFSEL)
- End DoDot:3
- +12 ;MULTIPLE CHOICE
- IF $PIECE(IBDOBJ1,"^",5)="MC"
- Begin DoDot:3
- +13 SET IBDFMC=$GET(^IBE(357.93,IBDF("IEN"),0))
- SET IBDFROW=4
- SET IBDFCOL=3
- DO SETUP(IBDFMC,IBDFROW,IBDFCOL)
- End DoDot:3
- +14 ;HAND PRINT FIELD
- IF $PIECE(IBDOBJ1,"^",5)="HP"
- Begin DoDot:3
- +15 SET IBDFHP=$GET(^IBE(359.94,IBDF("IEN"),0))
- SET IBDFROW=4
- SET IBDFCOL=3
- DO SETUP(IBDFHP,IBDFROW,IBDFCOL)
- End DoDot:3
- +16 ;DATA FIELDS
- IF $PIECE(IBDOBJ1,"^",5)="DF"
- Begin DoDot:3
- +17 SET IBDFDF=$GET(^IBE(357.5,IBDF("IEN"),0))
- SET IBDFROW=11
- SET IBDFCOL=10
- DO SETUP(IBDFDF,IBDFROW,IBDFCOL)
- End DoDot:3
- +18 ;FORM LINE
- IF $PIECE(IBDOBJ1,"^",5)="FL"
- Begin DoDot:3
- +19 SET IBDFFL=$GET(^IBE(357.7,IBDF("IEN"),0))
- SET IBDFROW=3
- SET IBDFCOL=2
- DO SETUP(IBDFFL,IBDFROW,IBDFCOL)
- End DoDot:3
- +20 ;TEXT AREA
- IF $PIECE(IBDOBJ1,"^",5)="TA"
- Begin DoDot:3
- +21 SET IBDFTA=$GET(^IBE(357.8,IBDF("IEN"),0))
- SET IBDFROW=4
- SET IBDFCOL=3
- DO SETUP(IBDFTA,IBDFROW,IBDFCOL)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +22 QUIT
- +23 ;
- +24 ;
- REP ; -- Redisplay initial screen
- +1 SET IBDFIFN=$SELECT('$DATA(IBDFIFN):+$PIECE(IBDOBJ,"^"),1:IBDFIFN)
- DO INIT1^IBDFCMP
- SET VALMBCK="R"
- QUIT
- +2 QUIT
- +3 ;
- +4 ;
- SETUP(IBOBJECT,IBROW,IBCOL) ; -- Setting up the data for list manager
- +1 SET IBDCNT1=IBDCNT1+1
- +2 SET X=""
- +3 SET X=$$SETSTR^VALM1(X,X,1,80)
- DO TMP
- +4 SET X=""
- SET X=$PIECE(IBOBJECT,"^")
- +5 SET X=$$SETSTR^VALM1(X,X,1,25)
- +6 SET IBDVAL=$SELECT($PIECE(IBDOBJ1,"^",5)]"":$PIECE(IBDOBJ1,"^",5),1:"")
- +7 SET X=$$SETSTR^VALM1(IBDVAL,X,30,10)
- +8 SET IBDVAL=$SELECT($PIECE(IBOBJECT,"^",IBROW):$PIECE(IBOBJECT,"^",IBROW)+1,$PIECE(IBOBJECT,"^",IBROW)=0:1,1:"N/A")
- +9 SET X=$$SETSTR^VALM1($JUSTIFY(IBDVAL,3),X,48,6)
- +10 SET IBDVAL=$SELECT($PIECE(IBOBJECT,"^",IBCOL):$PIECE(IBOBJECT,"^",IBCOL)+1,$PIECE(IBOBJECT,"^",IBCOL)=0:1,1:"N/A")
- +11 SET X=$$SETSTR^VALM1($JUSTIFY(IBDVAL,4),X,58,5)
- +12 ;D TMP,CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
- +13 IF X]""
- IF $PIECE(IBDOBJ1,"^",5)="LIST"
- Begin DoDot:1
- +14 SET IBDVAL=$SELECT($PIECE(^IBE(357.2,IBDF("IEN"),0),"^",7):$PIECE(^IBE(357.2,IBDF("IEN"),0),"^",7),1:"N/A")
- +15 SET IBDVAL=$JUSTIFY($SELECT(IBDVAL=1:"1 Space",IBDVAL=2:"2 Spaces",IBDVAL=3:"LINE",IBDVAL=4:"Sp/Ln/Sp",1:"N/A"),9)
- +16 SET X=$$SETSTR^VALM1(IBDVAL,X,71,9)
- +17 DO TMP
- DO CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
- +18 SET X=""
- SET X=$$SETSTR^VALM1(X,X,1,80)
- DO TMP
- +19 SET IBDVAL=" "_"Subcolumn"_" "_"Type"_" "_"Data"_" "_"Width"_" "_"Qualifier"_" "_"Rule"_" "_"Edit"
- +20 SET X=""
- SET X=$$SETSTR^VALM1(IBDVAL,X,1,80)
- DO TMP
- DO CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
- End DoDot:1
- +21 IF $PIECE(IBDOBJ1,"^",5)'="LIST"
- Begin DoDot:1
- +22 DO TMP
- DO CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
- End DoDot:1
- +23 QUIT
- SETUP1(IBOBJECT) ; -- Setup of the subcolumn info for the Selection list
- +1 SET X=""
- +2 SET X=$$SETSTR^VALM1($PIECE(IBOBJECT,"^"),X,8,2)
- +3 SET IBDVAL=$SELECT($PIECE(IBOBJECT,"^",4)]"":$PIECE(IBOBJECT,"^",4),1:"")
- +4 SET IBDVAL=$JUSTIFY($$LOWER^VALM1($SELECT(IBDVAL=1:"TEXT",IBDVAL=2:"MARKING",1:"")),10)
- +5 SET X=$$SETSTR^VALM1(IBDVAL,X,11,10)
- +6 SET IBDVAL=$SELECT($PIECE(IBOBJECT,"^",5):$PIECE(IBOBJECT,"^",5),1:"")
- +7 SET IBDVAL=$JUSTIFY($$LOWER^VALM1($SELECT(IBDVAL=1:"CODE",IBDVAL=2:"SHORT NAME",IBDVAL=3:"DESCRIP.",1:"N/A")),10)
- +8 SET X=$$SETSTR^VALM1(IBDVAL,X,25,10)
- +9 SET IBDVAL=$SELECT($PIECE(IBOBJECT,"^",3)]"":$PIECE(IBOBJECT,"^",3),1:"")
- +10 SET X=$$SETSTR^VALM1($JUSTIFY(IBDVAL,3),X,40,3)
- +11 SET IBDVAL=$SELECT($PIECE(IBOBJECT,"^",3)]"":$PIECE(IBOBJECT,"^",3),1:"")
- +12 SET IBDVAL=$SELECT($PIECE(IBOBJECT,"^",9):$PIECE(IBOBJECT,"^",9),1:"")
- +13 SET IBDVAL=$PIECE($GET(^IBD(357.98,+IBDVAL,0)),"^",3)
- +14 SET IBDVAL=$JUSTIFY($$LOWER^VALM1($SELECT(IBDVAL]"":IBDVAL,1:"N/A")),10)
- +15 SET X=$$SETSTR^VALM1(IBDVAL,X,47,10)
- +16 SET IBDVAL=$SELECT($PIECE(IBOBJECT,"^",10):$PIECE(IBOBJECT,"^",10),1:"")
- +17 SET IBDVAL=$JUSTIFY($$LOWER^VALM1($SELECT(IBDVAL=0:"ANY NUMBER",IBDVAL=1:"ONLY 1",IBDVAL=2:"AT MOST 1",IBDVAL=3:"AT LEAST 1",1:"N/A")),10)
- +18 SET X=$$SETSTR^VALM1(IBDVAL,X,59,10)
- +19 ;I $P(IBDOBJ1,"^",5)="LIST" D
- +20 ;S IBDVAL=$S($P(^IBE(357.2,IBDF("IEN"),0),"^",7):$P(^IBE(357.2,IBDF("IEN"),0),"^",7),1:"N/A")
- +21 ;S IBDVAL=$S(IBDVAL=1:"1 S",IBDVAL=2:"2 S",IBDVAL=3:"LIN",IBDVAL=4:"SLS",1:"N/A")
- +22 SET IBDVAL=$SELECT($PIECE(IBOBJECT,"^",7)=1:"Yes",1:"No")
- +23 SET X=$$SETSTR^VALM1($JUSTIFY(IBDVAL,3),X,77,3)
- +24 DO TMP
- +25 QUIT
- +26 ;
- +27 ;
- TMP ; -- Set up Array
- +1 SET IBDCNT=IBDCNT+1
- SET VALMCNT=VALMCNT+1
- +2 SET ^TMP("FORMEXP",$JOB,IBDCNT,0)=X
- SET ^TMP("FORMEXP",$JOB,"IDX",VALMCNT,IBDCNT1)=""
- +3 ;_"^"_IBDFIFN_"^"_IBDF("BLK")
- SET ^TMP("EXPIDX",$JOB,IBDCNT)=VALMCNT
- +4 QUIT
- +5 ;
- +6 ;
- HDR ; -- print patient header
- +1 SET X=""
- +2 SET X=" Form Name: "_$EXTRACT($PIECE($GET(^IBE(357,IBDFIFN,0)),"^"),1,25)
- +3 SET VALMHDR(1)=X
- +4 SET X=" Block Name: "_$EXTRACT($PIECE($GET(^IBE(357.1,+$PIECE(IBDOBJ,"^",11),0)),"^"),1,25)
- +5 SET VALMHDR(2)=X
- +6 QUIT
- +7 ;
- +8 ;
- EXIT ; -- Exit code
- +1 KILL ^TMP("FORMEXP",$JOB),^TMP("EXPIDX")
- +2 QUIT
- HELP ; -- help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
