source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFCMP.m@ 1464

Last change on this file since 1464 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.8 KB
RevLine 
[613]1IBDFCMP ;ALB/MAF - AICS list of components on a form ; 29-JUL-96
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3START K XQORS,VALMEVL D EN^VALM("IBDF FORM COMPONENTS")
4 Q
5INIT ;
6% N I,J,X,Y,DIR,DIRUT,DTOUT,DUOUT,IBDF,IBDPAG,IBDPDT,IBDOJB,IBQUIT,QLFR,RULE,IBDFALL
7 I '$D(DT) D DT^DICRW
8 D HOME^%ZIS
9 W !!,"Display Form Components",!!
10 ;
11 ; -- ask for form id
12 D END
13 S DIR("?")="Enter the Encounter Form Name you want to review."
14 S DIR(0)="PO^357:AEQM",DIR("A")="Select Encounter Form" D ^DIR K DIR,DA,DR,DIC
15 I $D(DIRUT) S VALMBCK="Q",VALMQUIT=1 Q
16 S IBDFIFN=+Y
17INIT1 S IBDCNT1=0,IBDCNT=0,VALMCNT=0
18 D DQ
19 ;
20STRTQ G:$G(IBQUIT) END ;D PAUSE^IBDFDE
21 Q
22 ;
23DQ ; -- entry point to list contents of one form,
24 ; Input IBDFIFN := pointer to Encounter Form (357)
25 ;
26 S IBQUIT=0
27 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
28 I $D(^TMP("FORM-OBJ",$J,IBDFIFN,0)),^TMP("FORM-OBJ",$J,IBDFIFN,0)'>0 D NUL Q
29 D LISTOB
30 Q
31 ;
32LISTOB ; -- list items available for input on a form
33 N IBDFOLDB
34 S IBDFOLDB=0
35 S I=0 F S I=$O(^TMP("FORM-OBJ",$J,IBDFIFN,I)) Q:I=""!(IBQUIT) D
36 .S IBDOBJ=$G(^TMP("FORM-OBJ",$J,IBDFIFN,I))
37 .S IBDF("PI")=+$P(IBDOBJ,"^",2),IBDF("TYPE")=$P(IBDOBJ,"^",5)
38 .S IBDF("IEN")=+$P(IBDOBJ,"^",6),IBDF("VITAL")=$P(IBDOBJ,"^",7)
39 .S IBDF("BROW")=+$P(IBDOBJ,"^",10)+1,IBDF("BCOL")=+$P(IBDOBJ,"^",11)+1
40 .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))
41 .S IBDF("HT")=$P(IBDF("BNODE"),"^",7)
42 .S IBDF("WDTH")=$P(IBDF("BNODE"),"^",6)
43 .S IBDF("TKO")=$P(IBDF("BNODE"),"^",14)
44 .I IBDFOLDB'=$P(IBDOBJ,"^",9) S IBDFFLAG=0
45 .I 'IBDFFLAG D
46 ..S X=""
47 ..S IBDFFLAG=1,IBDFOLDB=$P(IBDOBJ,"^",9)
48 ..S IBDCNT1=IBDCNT1+1
49 ..S X=$$SETSTR^VALM1(X,X,1,80) D TMP
50 ..S X=""
51 ..S IBDVAL=IBDCNT1_") "
52 ..S X=$$SETSTR^VALM1(IBDVAL,X,1,4)
53 ..S X=$$SETSTR^VALM1($P(IBDF("BNAME"),"^",1),X,5,40) D TMP,CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
54 ..S IBBLOCK(IBDCNT1)=IBDFIFN_"^"_IBDCNT_"^"_IBDOBJ
55 ..S X="",X=$$SETSTR^VALM1($$LOWER^VALM1(" STARTING ROW: "),X,1,16)
56 ..S IBDVAL=$S(IBDF("BROW"):IBDF("BROW"),1:"")
57 ..S X=$$SETSTR^VALM1($J(IBDVAL,3),X,17,3)
58 ..S X=$$SETSTR^VALM1($$LOWER^VALM1("STARTING COLUMN: "),X,49,17)
59 ..S IBDVAL=$S(IBDF("BCOL"):IBDF("BCOL"),1:"")
60 ..S X=$$SETSTR^VALM1($J(IBDVAL,3),X,66,3) D TMP
61 ..S X="",X=$$SETSTR^VALM1($$LOWER^VALM1(" BLOCK WIDTH: "),X,1,16)
62 ..S IBDVAL=$S(IBDF("WDTH"):IBDF("WDTH"),1:"")
63 ..S X=$$SETSTR^VALM1($J(IBDVAL,3),X,17,3)
64 ..S X=$$SETSTR^VALM1($$LOWER^VALM1(" BLOCK HEIGHT: "),X,49,17)
65 ..S IBDVAL=$S(IBDF("HT"):IBDF("HT"),1:"")
66 ..S X=$$SETSTR^VALM1($J(IBDVAL,3),X,66,3) D TMP
67 Q
68TMP ; -- Set up Array
69 S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
70 S ^TMP("FORMOBJ",$J,IBDCNT,0)=X,^TMP("FORMOBJ",$J,"IDX",VALMCNT,IBDCNT1)=""
71 S ^TMP("FORMIDX",$J,IBDCNT)=VALMCNT_"^"_IBDFIFN_"^"_IBDF("BLK")
72 Q
73 ;
74 ;
75HELP ; -- help code
76 S X="?" D DISP^XQORM1 W !!
77 Q
78 ;
79 ;
80EXIT ; -- exit code
81 K IBDCAT,IBDNME,IBDTYPE,VALMCNT,IBDCNT,IBDCNT1,IBDNAME,IBDNUM,IBDNME,IBDFIFN,IBDVAL,IBDNODE,IBFASTXT,IBDF,IBBLOCK,IBDFNODE,IBDFSNOD,IBDFOBJ,IBDOBJ1,IBQUIT,IBDFFLAG,IBDOBJ
82 K ^TMP("FORM-OBJ",$J),^TMP("FORMIDX",$J),^TMP("FORMOBJ",$J)
83 Q
84 ;
85NUL ; -- NULL MESSAGE
86 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
87 Q
88 ;
89HDR ; -- print patient header
90 ;Q:'$D(IBDFIFN)
91 S X=" Form Name: "_$E($P($G(^IBE(357,+IBDFIFN,0)),"^"),1,25)
92 S IBDVAL="FORM ID #: "_$S(+$P($G(^IBE(357,+IBDFIFN,0)),"^",13):$P(^IBE(357,+IBDFIFN,0),"^",13),1:"")
93 S VALMHDR(1)=$$SETSTR^VALM1(IBDVAL,X,55,25)
94 S X=" Status: "_$S(+$P($G(^IBE(357,+IBDFIFN,0)),"^",5):"Compiled",1:"Uncompiled")
95 S IBDVAL=" Toolkit: "_$S(+$P($G(^IBE(357,+IBDFIFN,0)),"^",7):"Yes",1:"No")
96 S VALMHDR(2)=$$SETSTR^VALM1(IBDVAL,X,55,25)
97 S X=" Scannable: "_$S(+$P($G(^IBE(357,+IBDFIFN,0)),"^",12):"Yes",1:"No")
98 S IBDVAL=" Use ICR: "_$S(+$P($G(^IBE(357,+IBDFIFN,0)),"^",6):"Yes",1:"No")
99 S VALMHDR(3)=$$SETSTR^VALM1(IBDVAL,X,55,25)
100 S X=+$P($G(^IBE(357,+IBDFIFN,0)),"^",2)
101 S X="Simplex/Duplex: "_$S(X]""&(X=0):"Simplex",X]""&(X=1):"Duplex Long-Edge",X]""&(X=2):"Duplex Short-Edge",1:"")
102 S IBDVAL=" # Pages: "_$S(+$P($G(^IBE(357,+IBDFIFN,0)),"^",11):+$P($G(^IBE(357,+IBDFIFN,0)),"^",11),1:"0")
103 S VALMHDR(4)=$$SETSTR^VALM1(IBDVAL,X,55,25)
104 Q
105 ;
106END I $D(ZTQUEUED) S ZTREQ="@" Q
107 K I,J,X,Y,DA,DR,DIC,DIE,DIR,DTOUT,DUOUT,DIRUT,IBDSEL,CHOICE,TEXT,TEXTU,RESULT,IBDPI,IBDCO,IBDF,IBDPAG,ZTSK,IBDFIFN
108 K ^TMP("FORMIDX",$J),^TMP("FORM-OBJ",$J),^TMP("FORMOBJ",$J)
109 D ^%ZISC
110 Q
111 ;
112EXP ; -- Expand Action
113 D FULL^VALM1
114 N VALMI,VALMAT,VALMY
115 D EN^VALM2(XQORNOD(0),"O") S VALMI=0
116 F S VALMI=$O(VALMY(VALMI)) Q:'VALMI D
117 .S VALMAT=$G(IBBLOCK(VALMI))
118 .W !
119 .I DUZ(0)="@" W !,"Entry No. ",+$P(VALMAT,"^",11)
120 .S DA=+$P(VALMAT,U,11),DIC="^IBE(357.1,",DR="0" D EN^DIQ,PAUSE^VALM1
121 .K DA,DIC,DR
122 S VALMBCK="R"
123 Q
Note: See TracBrowser for help on using the repository browser.