124 lines
4.8 KiB
Mathematica
124 lines
4.8 KiB
Mathematica
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
|