source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF1B3.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1IBDF1B3 ;ALB/CJM - ENCOUNTER FORM - (lists data that did not fit on the encounter form);4/28/93
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**39**;APR 24, 1997
3OVERFLOW ;
4 ;loops through @IBARRAY("OVERFLOW"), printing in list form all the data that did not fit
5 ;
6 N IBBLK,FIELD,TYPE,ITEM,RTN,PAGE
7 Q:'$D(@IBARRAY("OVERFLOW"))
8 S PAGE=1
9 D HDR
10 S IBBLK="" F S IBBLK=$O(@IBARRAY("OVERFLOW")@(IBBLK)) Q:'IBBLK D
11 .Q:$$BLKDESCR^IBDFU1B(.IBBLK)
12 .D BLOCKBRK
13 .S FIELD="" F S FIELD=$O(@IBARRAY("OVERFLOW")@(IBBLK,FIELD)) Q:'FIELD D
14 ..S TYPE="" F S TYPE=$O(@IBARRAY("OVERFLOW")@(IBBLK,FIELD,TYPE)) Q:TYPE="" D
15 ...I TYPE="DYNAMIC LIST" D LIST Q
16 ...D FIELD
17 D FOOTER
18 K @IBARRAY("OVERFLOW")
19 Q
20HDR ;writes header to top of page
21 N HDR
22 S HDR="ADDITIONAL ENCOUNTER FORM DATA"
23 W !,?((IOM-$L(HDR))/2),HDR,?(IOM-10),"PAGE: ",PAGE,!
24 W !,"CLINIC: ",$P($G(^SC(IBCLINIC,0)),"^")
25 W !,"PATIENT: " I $G(DFN) W $P($G(^DPT(DFN,0)),"^")
26 W !,"FORM: ",$P($G(^IBE(357,IBFORM,0)),"^"),!
27 S PAGE=PAGE+1
28 Q
29BLOCKBRK ;writes a line to the report with the block name
30 I $Y>(IOSL-3) W @IOF D HDR
31 W !!,"BLOCK: ",$P($G(^IBE(357.1,IBBLK,0)),"^")
32 Q
33FOOTER ;
34 N FTR S FTR="END OF REPORT"
35 W !!!,?((IOM-$L(FTR))\2),FTR,@IOF
36 Q
37FIELD ;displays the field (if list, displays all, if record, displays subfields)
38 N LASTITEM,RTN,LABEL,XLAB,YLAB,XIO,YIO,WIO,HIO,BLK,ITEM,PIECE,SPACING,DISPLAY,VALUE,FLDNAME,RTN,LIST,IFARY
39 ;
40 Q:'$$FLDDESCR^IBDFU1A(FIELD) ;gets the field description
41 D RTNDSCR^IBDFU1B(.RTN) ;get the rtn used by the field
42 S IFARY=RTN("DATA_LOCATION")
43 W !
44 I RTN("DATATYPE")=5 D TXTPRINT Q ;wordprocessing fields treated differently
45 ;now do other than wordprocessing
46 S LIST=$S((RTN("DATATYPE")=3)!(RTN("DATATYPE")=4):1,1:0)
47 I LIST,TYPE="CURRENT" S ITEM=$G(@IBARRAY("OVERFLOW")@(IBBLK,FIELD,TYPE))
48 I TYPE="NEXT",LIST D
49 .I $Y>(IOSL-5) W @IOF D HDR
50 .S ITEM=1 W !,?5,"**** LIST OF ",$E(RTN("NAME"),$F(RTN("NAME")," "),40)," ****" F D LISTVAL D Q:'ITEM
51 ..I VALUE'="" D SUBFLDS W !
52 I TYPE="CURRENT" D
53 .W !,?5,"**** ",$E(RTN("NAME"),$F(RTN("NAME")," "),40)_$S(LIST:" (#"_ITEM_")",1:"")_" ****"
54 .I 'LIST D SNGLVAL
55 .I LIST D LISTVAL
56 .D SUBFLDS
57 Q
58SUBFLDS ;process each subfield
59 N LAST,PVALUE
60 S LAST=$$SFLDDSCR^IBDFU1A(FIELD,0) Q:'LAST
61 F D S LAST=$$SFLDDSCR^IBDFU1A(FIELD,LAST) Q:'LAST
62 .I RTN("DATATYPE")=1!(RTN("DATATYPE")=3) S PIECE=1
63 .S PVALUE=$P($G(VALUE),"^",PIECE)
64 .;don't use the label appearing on the encounter form - it might be 'context sensitive' - use description form package interface file
65 .S LABEL=$$DATANAME^IBDFU1B(RTN,PIECE)
66 .I $Y>(IOSL-3) W @IOF D HDR
67 .W !,?5,LABEL_": ",PVALUE
68 Q
69 ;
70LIST ;displays the list
71 N RTN,LABEL,ITEM,PIECE,VALUE,LIST,IFARY,CNT
72 ;
73 S LIST=FIELD
74 Q:$$LSTDESCR^IBDFU1(.LIST) ;gets the list description
75 S RTN=LIST("RTN")
76 D RTNDSCR^IBDFU1B(.RTN) ;get the PACKAGE INTERFACE used
77 S IFARY=RTN("DATA_LOCATION")
78 W !
79 ;
80 D
81 .S CNT=0
82 .I $Y>(IOSL-5) W @IOF D HDR
83 .S ITEM=1 W !,?5,"**** LIST OF ",$E(RTN("NAME"),$F(RTN("NAME")," "),40)," ****" F D LISTVAL D Q:'ITEM
84 ..; -- file overflow data if not re-printing & there is a form ID
85 ..I '$G(REPRINT),($G(LIST("INPUT_RTN"))]""),$G(IBPFID) D
86 ...S CNT=CNT+1
87 ...S DIC="^IBD(357.96,IBPFID,2,",DIC(0)="L",DIC("P")=$P(^DD(357.96,2,0),"^",2),DA(1)=IBPFID,X=CNT,DLAYGO=357.96
88 ...S DIC("DR")=".03////^S X=LIST(""INPUT_RTN"");.04////^S X=$P(VALUE,""^"");.06////^S X=""S""_LIST_""("";.08////^S X=$P(VALUE,""^"",2)"
89 ...K DD,DO D FILE^DICN K DIC,DA,DLAYGO,DD,DO
90 ..I VALUE'="" D SUBCOLS W !
91 Q
92SUBCOLS ;process each subcolumn
93 N PVALUE,SUB,PIECE
94 F SUB=1:1:6 D
95 .Q:(LIST("SCTYPE",SUB)'=1)
96 .Q:'LIST("SCPIECE",SUB)
97 .S PIECE=LIST("SCPIECE",SUB)
98 .S PVALUE=$P($G(VALUE),"^",PIECE)
99 .;don't use the label appearing on the encounter form - it might be 'context sensitive' - use description form package interface file
100 .S LABEL=$$DATANAME^IBDFU1B(RTN,PIECE)
101 .I $Y>(IOSL-3) W @IOF D HDR
102 .W !,?5,LABEL_": ",PVALUE
103 Q
104 ;
105SNGLVAL ;output - VALUE
106 S VALUE=$G(@IFARY)
107 Q
108LISTVAL ;input - ITEM=prior item processes, output - VALUE,ITEM=current item processed
109 ;
110 S VALUE=$S(ITEM:$G(@IFARY@(ITEM)),1:"")
111 ;increment ITEM to next item
112 S ITEM=$O(@IFARY@(ITEM))
113 Q
114TXTPRINT ;for printing a word-processing field
115 N LINE,X,DIWL,DIWR,DIWF,LABEL
116 S LINE=0,DIWR=IOM-10,DIWL=0,DIWF=""
117 K ^UTILITY($J,"W",1)
118 F S LINE=$O(@IFARY@(LINE)) Q:'LINE S X=$G(@IFARY@(LINE,0)) I X'="" D ^DIWP
119 S LABEL=$E(RTN("NAME"),$F(RTN("NAME")," "),40)
120 I $Y>(IOSL-5) W @IOF D HDR
121 W !,?5,LABEL_": "
122 S X=0 F S X=$O(^UTILITY($J,"W",0,X)) Q:'X D
123 .I $Y>(IOSL-3) W @IOF D HDR
124 .W !,?10,$G(^UTILITY($J,"W",0,X,0))
125 K ^UTILITY($J,"W",1)
126 Q
Note: See TracBrowser for help on using the repository browser.