source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFFV3.m@ 724

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1IBDFFV3 ;;ALB/CMR - AICS FORM VALIDATION ; FEB 23, 1996
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3PRINT(FRM,NAME,TYPE,CL,DG) ; -- print validation for each form
4 ; -- FRM = ien file 357
5 ; -- NAME (optional) name of form
6 ; -- TYPE (optional) type of form where:
7 ; -- 1 = FORM
8 ; -- 2 = BASIC DEFAULT FORM
9 ; -- 3 = SUPPLEMENTAL FORM - PATIENT WITH PRIOR VISITS
10 ; -- 4 = SUPPLEMENTAL FORM - FIRST TIME PATIENT
11 ; -- 5 = FORM WITH NO PRE-PRINTED PATIENT DATA
12 ; -- 6 = SUPPLEMENTAL FORM - ALL PATIENTS
13 ; -- 7 = RESERVED FOR FUTURE USE
14 ; -- 8 = SUPPLEMENTAL FORM - ALL PATIENTS
15 ; -- 9 = SUPPLEMENTAL FORM - ALL PATIENTS
16 ; -- CL (optional) clinic header
17 ; -- DG (optional) group or division header
18 N IEN,BUB,NODE,PG,IBDFFVAL,IBID,IBLABEL,PI,CK,CODE,GROUP
19 K WRITE
20 Q:'FRM!($G(^IBE(357,FRM,0))']"")
21 S PG=0
22 I $G(NAME)']"" S NAME=$P(^IBE(357,FRM,0),U)
23 I '$G(TYPE) S TYPE=1
24 S IEN=$P(^IBE(357,FRM,0),U,13) Q:'IEN!('$D(^IBD(357.95,+IEN)))
25 W $$CJ^XLFSTR("ENCOUNTER FORM VALIDATION",IOM),!
26 I $G(DG)]"" W !,DG
27 I $G(CL)]"" W !,CL
28 W !,$P($T(TYPE+TYPE),";;",2)," ",NAME
29 K BUB,HP
30 ; -- $o through all bubbles
31 S BUB=0,GROUP="" F S BUB=$O(^IBD(357.95,IEN,1,BUB)) Q:'BUB!($G(IBDFOUT)) S NODE=$G(^IBD(357.95,IEN,1,BUB,0)) I NODE]"" D DISP
32 K BUB
33 S HP=0 F S HP=$O(^IBD(357.95,IEN,2,HP)) Q:'HP!($G(IBDFOUT)) S NODE=$G(^IBD(357.95,IEN,2,HP,0)) I NODE]"" D DISP
34 Q:$G(IBDFOUT)
35 D PAGE(100) ;force final page footers
36 Q
37DISP ; -- display data for each element
38 N IBINACT
39 N ERR
40 ; -- write out group subheader if different from previous
41 I GROUP'=$P(NODE,U,5) S GROUP=$P(NODE,U,5) D PAGE(8) Q:$G(IBDFOUT) I '$G(CK) W !!,GROUP,!
42 ; -- determine errors up front
43 S PI=$S($D(BUB):$P(NODE,U,3),$D(HP):$P(NODE,U,4),1:"") I 'PI S ERR("PI")=""
44 S DQ=$P(NODE,U,10) I 'DQ,$P($G(^IBE(357.6,+PI,0)),U,19) S ERR("DQ")=""
45 K IBID,IBLABEL,IBINACT
46 I $D(BUB) S X=$P(NODE,U,4) I X,PI X $G(^IBE(357.6,PI,19)) I $G(IBLABEL)']"" S ERR("CODE")=""
47 I $G(IBINACT) S ERR("INACT")=""
48 D PAGE(5) Q:$G(IBDFOUT)
49 ; -- write error flag followed by displayed text
50 W ! W:$D(ERR) "*" W ?2,"[ ] ",$S($D(BUB):$P(NODE,U,8),$D(HP):$P(NODE,U,9),1:"") S WRITE=1
51 ; -- if bubble is dynamic s code accordingly
52 I $D(BUB),($G(IBID)']""),($P(NODE,U,11)) S IBID="DYNAMIC",IBLABEL="Value determined at print time"
53 I $D(HP) S IBID="HAND PRINT",IBLABEL="Value determined at scan time"
54 ; -- write return values
55 I $G(IBID)]"" W !,?6,IBID,?22,$G(IBLABEL)
56 ; -- write data qualifiers
57 I DQ]"" W !?6,"DATA QUALIFIER",?22,$P($G(^IBD(357.98,DQ,0)),"^")
58 I $D(HP),($P(NODE,U,17)) W !?6,"DATA ELEMENT",?22,$P($G(^IBE(359.1,$P(NODE,U,17),0)),U)
59 ; -- process errors
60 I $D(ERR) D ERROR
61 Q
62ERROR ;gathers errors to write
63 I '$D(ERR) Q
64 N CNT
65 I $D(ERR("PI")) D ERRORS("*** Package Interface is missing ***")
66 I $D(ERR("DQ")) D ERRORS("*** Data Qualifier is missing ***")
67 I $D(ERR("CODE")) D ERRORS("*** Invalid "_GROUP_" ***")
68 I $D(ERR("INACT")) D ERRORS("*** Inactive "_GROUP_" ***")
69 Q
70ERRORS(ERR) ; -- writes out errors
71 I $G(CNT) W !
72 I '$G(CNT) W !?6,"ERRORS" S CNT=1
73 W ?22,ERR
74 Q
75PAGE(PL) ; -- check page length
76 ; -- adds two lines to account for footer
77 K CK
78 I +PL S PL=PL+2
79 I '+PL S PL=5
80 Q:$Y+PL<IOSL
81 S PG=PG+1,CK=1
82 W !!,$$CJ^XLFSTR(PG,IOM)
83 I $E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR K DIR,DIRUT,DUOUT,DTOUT I 'Y S IBDFOUT=1 Q
84 W @IOF
85 I +PL<100 D
86 .W !,$$CJ^XLFSTR("ENCOUNTER FORM VALIDATION",IOM)
87 .W !!,$P($T(TYPE+TYPE),";;",2)," ",NAME
88 .W !!,GROUP,!
89 Q
90TYPE ; -- list of form types
91 ;;FORM:.........................................
92 ;;BASIC DEFAULT FORM: .........................
93 ;;SUPPLEMENTAL FORM - PATIENT WITH PRIOR VISITS:
94 ;;SUPPLEMENTAL FORM - FIRST TIME PATIENT: .....
95 ;;FORM WITH NO PRE-PRINTED PATIENT DATA: ......
96 ;;SUPPLEMENTAL FORM - ALL PATIENTS: ...........
97 ;;RESERVED FOR FUTURE USE: ....................
98 ;;SUPPLEMENTAL FORM - ALL PATIENTS:.............
99 ;;SUPPLEMENTAL FORM - ALL PATIENTS:.............
Note: See TracBrowser for help on using the repository browser.