source: FOIAVistA/tag/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFCMP.m@ 636

IBDFCMP ;ALB/MAF - AICS list of components on a form ; 29-JUL-96
 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
START K XQORS,VALMEVL D EN^VALM("IBDF FORM COMPONENTS")
 Q
INIT ;
% N I,J,X,Y,DIR,DIRUT,DTOUT,DUOUT,IBDF,IBDPAG,IBDPDT,IBDOJB,IBQUIT,QLFR,RULE,IBDFALL
 I '$D(DT) D DT^DICRW
 D HOME^%ZIS
 W !!,"Display Form Components",!!
 ;
 ; -- ask for form id
 D END
 S DIR("?")="Enter the Encounter Form Name you want to review."
 S DIR(0)="PO^357:AEQM",DIR("A")="Select Encounter Form" D ^DIR K DIR,DA,DR,DIC
 I $D(DIRUT) S VALMBCK="Q",VALMQUIT=1 Q
 S IBDFIFN=+Y
INIT1 S IBDCNT1=0,IBDCNT=0,VALMCNT=0
 D DQ
 ;
STRTQ G:$G(IBQUIT) END ;D PAUSE^IBDFDE
 Q
 ;
DQ ; -- entry point to list contents of one form,  
 ;    Input IBDFIFN := pointer to Encounter Form (357)
 ;
 S IBQUIT=0
 I '$D(^TMP("FORM-OBJ",$J,IBDFIFN,0)) S IBDFALL=1 D FRMLSTI^IBDFRPC(.IBDOBJ,IBDFIFN,"",1,IBDFALL) M ^TMP("FORM-OBJ",$J,IBDFIFN)=IBDOBJ K IBDOBJ
 I $D(^TMP("FORM-OBJ",$J,IBDFIFN,0)),^TMP("FORM-OBJ",$J,IBDFIFN,0)'>0 D NUL Q
 D LISTOB
 Q
 ;
LISTOB ; -- list items available for input on a form
 N IBDFOLDB
 S IBDFOLDB=0
 S I=0 F  S I=$O(^TMP("FORM-OBJ",$J,IBDFIFN,I)) Q:I=""!(IBQUIT)  D
 .S IBDOBJ=$G(^TMP("FORM-OBJ",$J,IBDFIFN,I))
 .S IBDF("PI")=+$P(IBDOBJ,"^",2),IBDF("TYPE")=$P(IBDOBJ,"^",5)
 .S IBDF("IEN")=+$P(IBDOBJ,"^",6),IBDF("VITAL")=$P(IBDOBJ,"^",7)
 .S IBDF("BROW")=+$P(IBDOBJ,"^",10)+1,IBDF("BCOL")=+$P(IBDOBJ,"^",11)+1
 .S IBDF("BLK")=+$P(IBDOBJ,"^",9),IBDF("BNAME")=$P($G(^IBE(357.1,IBDF("BLK"),0)),"^"),IBDF("BNODE")=$G(^IBE(357.1,IBDF("BLK"),0))
 .S IBDF("HT")=$P(IBDF("BNODE"),"^",7)
 .S IBDF("WDTH")=$P(IBDF("BNODE"),"^",6)
 .S IBDF("TKO")=$P(IBDF("BNODE"),"^",14)
 .I IBDFOLDB'=$P(IBDOBJ,"^",9) S IBDFFLAG=0
 .I 'IBDFFLAG D
 ..S X=""
 ..S IBDFFLAG=1,IBDFOLDB=$P(IBDOBJ,"^",9)
 ..S IBDCNT1=IBDCNT1+1
 ..S X=$$SETSTR^VALM1(X,X,1,80) D TMP
 ..S X=""
 ..S IBDVAL=IBDCNT1_") "
 ..S X=$$SETSTR^VALM1(IBDVAL,X,1,4)
 ..S X=$$SETSTR^VALM1($P(IBDF("BNAME"),"^",1),X,5,40) D TMP,CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
 ..S IBBLOCK(IBDCNT1)=IBDFIFN_"^"_IBDCNT_"^"_IBDOBJ
 ..S X="",X=$$SETSTR^VALM1($$LOWER^VALM1("  STARTING ROW: "),X,1,16)
 ..S IBDVAL=$S(IBDF("BROW"):IBDF("BROW"),1:"")
 ..S X=$$SETSTR^VALM1($J(IBDVAL,3),X,17,3)
 ..S X=$$SETSTR^VALM1($$LOWER^VALM1("STARTING COLUMN: "),X,49,17)
 ..S IBDVAL=$S(IBDF("BCOL"):IBDF("BCOL"),1:"")
 ..S X=$$SETSTR^VALM1($J(IBDVAL,3),X,66,3) D TMP
 ..S X="",X=$$SETSTR^VALM1($$LOWER^VALM1("   BLOCK WIDTH: "),X,1,16)
 ..S IBDVAL=$S(IBDF("WDTH"):IBDF("WDTH"),1:"")
 ..S X=$$SETSTR^VALM1($J(IBDVAL,3),X,17,3)
 ..S X=$$SETSTR^VALM1($$LOWER^VALM1("   BLOCK HEIGHT: "),X,49,17)
 ..S IBDVAL=$S(IBDF("HT"):IBDF("HT"),1:"")
 ..S X=$$SETSTR^VALM1($J(IBDVAL,3),X,66,3) D TMP
 Q
TMP ; -- Set up Array
 S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
 S ^TMP("FORMOBJ",$J,IBDCNT,0)=X,^TMP("FORMOBJ",$J,"IDX",VALMCNT,IBDCNT1)=""
 S ^TMP("FORMIDX",$J,IBDCNT)=VALMCNT_"^"_IBDFIFN_"^"_IBDF("BLK")
 Q
 ;
 ;
HELP ; -- help code
 S X="?" D DISP^XQORM1 W !!
 Q
 ;
 ;
EXIT ; -- exit code
 K IBDCAT,IBDNME,IBDTYPE,VALMCNT,IBDCNT,IBDCNT1,IBDNAME,IBDNUM,IBDNME,IBDFIFN,IBDVAL,IBDNODE,IBFASTXT,IBDF,IBBLOCK,IBDFNODE,IBDFSNOD,IBDFOBJ,IBDOBJ1,IBQUIT,IBDFFLAG,IBDOBJ
 K ^TMP("FORM-OBJ",$J),^TMP("FORMIDX",$J),^TMP("FORMOBJ",$J)
 Q
 ;
NUL ; -- NULL MESSAGE
 S ^TMP("FORMOBJ",$J,1,0)=" ",^TMP("FORMOBJ",$J,2,0)="There are no Components listed for this form.",^TMP("FORMIDX",$J,1)=1,^TMP("FORMIDX",$J,2)=2
 Q
 ;
HDR ; -- print patient header
 ;Q:'$D(IBDFIFN)
 S X="     Form Name: "_$E($P($G(^IBE(357,+IBDFIFN,0)),"^"),1,25)
 S IBDVAL="FORM ID #: "_$S(+$P($G(^IBE(357,+IBDFIFN,0)),"^",13):$P(^IBE(357,+IBDFIFN,0),"^",13),1:"")
 S VALMHDR(1)=$$SETSTR^VALM1(IBDVAL,X,55,25)
 S X="        Status: "_$S(+$P($G(^IBE(357,+IBDFIFN,0)),"^",5):"Compiled",1:"Uncompiled")
 S IBDVAL="  Toolkit: "_$S(+$P($G(^IBE(357,+IBDFIFN,0)),"^",7):"Yes",1:"No")
 S VALMHDR(2)=$$SETSTR^VALM1(IBDVAL,X,55,25)
 S X="     Scannable: "_$S(+$P($G(^IBE(357,+IBDFIFN,0)),"^",12):"Yes",1:"No")
 S IBDVAL="  Use ICR: "_$S(+$P($G(^IBE(357,+IBDFIFN,0)),"^",6):"Yes",1:"No")
 S VALMHDR(3)=$$SETSTR^VALM1(IBDVAL,X,55,25)
 S X=+$P($G(^IBE(357,+IBDFIFN,0)),"^",2)
 S X="Simplex/Duplex: "_$S(X]""&(X=0):"Simplex",X]""&(X=1):"Duplex Long-Edge",X]""&(X=2):"Duplex Short-Edge",1:"")
 S IBDVAL="  # Pages: "_$S(+$P($G(^IBE(357,+IBDFIFN,0)),"^",11):+$P($G(^IBE(357,+IBDFIFN,0)),"^",11),1:"0")
 S VALMHDR(4)=$$SETSTR^VALM1(IBDVAL,X,55,25)
 Q
 ;
END I $D(ZTQUEUED) S ZTREQ="@" Q
 K I,J,X,Y,DA,DR,DIC,DIE,DIR,DTOUT,DUOUT,DIRUT,IBDSEL,CHOICE,TEXT,TEXTU,RESULT,IBDPI,IBDCO,IBDF,IBDPAG,ZTSK,IBDFIFN
 K ^TMP("FORMIDX",$J),^TMP("FORM-OBJ",$J),^TMP("FORMOBJ",$J)
 D ^%ZISC
 Q
 ;
EXP ;  -- Expand Action
 D FULL^VALM1
 N VALMI,VALMAT,VALMY
 D EN^VALM2(XQORNOD(0),"O") S VALMI=0
 F  S VALMI=$O(VALMY(VALMI)) Q:'VALMI  D
 .S VALMAT=$G(IBBLOCK(VALMI))
 .W !
 .I DUZ(0)="@" W !,"Entry No. ",+$P(VALMAT,"^",11)
 .S DA=+$P(VALMAT,U,11),DIC="^IBE(357.1,",DR="0" D EN^DIQ,PAUSE^VALM1
 .K DA,DIC,DR
 S VALMBCK="R"
 Q