| [613] | 1 | IBDFFV3 ;;ALB/CMR - AICS FORM VALIDATION ; FEB 23, 1996
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
|---|
| 3 | PRINT(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
|
|---|
| 37 | DISP ; -- 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
|
|---|
| 62 | ERROR ;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
|
|---|
| 70 | ERRORS(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
|
|---|
| 75 | PAGE(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
|
|---|
| 90 | TYPE ; -- 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:.............
|
|---|
