source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHCA08.m@ 1742

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

initial load of WorldVistAEHR

File size: 5.3 KB
Line 
1VAFHCA08 ;ALB/CM OUTPATIENT A08 GENERATOR ;4/5/95
2 ;;5.3;Registration;**91**;Jun 06, 1996
3 ;
4 ;This function will generator an A08 HL7 message for an outpatient
5 ;event. If the generation is successful, 0 will be returned.
6 ;If for any reason is not successful, -1 and error message will be
7 ;returned.
8 ;
9 ;Two entry points have been provided. The first is for use by the
10 ;Update event outside of an outpatient event. The second is for use
11 ;by the outpatient event. The second will return 0^COUNT, where COUNT
12 ;is the last value entered.
13 ;
14UP(DFN,EVENT,NODE,COUNT,GBL,PISTR,ZSTR,PSTR,XSTR,PDNUM,ZNUM,PNUM,XNUM) ;
15 ;
16 ;DFN - Patient file DFN
17 ;EVENT - Event number from pivot file
18 ;NODE - Zero Node of pivot file entry
19 ;COUNT - Subscript to start global/array storage at
20 ;GBL - global or array to store segments
21 ;PISTR - fields to be included in PID (null - required fields,
22 ;or string of fields seperated by commas)
23 ;ZSTR - fields to be included in ZPD (null - required fields,
24 ;or string of fields seperated by commas)
25 ;PSTR - fields to be included in OPV1
26 ;(if null - required fields, if "A" - supported
27 ;fields, or string of fields seperated by commas")
28 ;XSTR - fields to be included in ODG1
29 ;(if null - required fields, if "A" - supported
30 ;fields, or string of fields seperated by commas")
31 ;PDNUM - ID # for PID (optional)
32 ;ZNUM - ID # for ZPD (optional)
33 ;PNUM - ID # for OPV1 (optional)
34 ;XNUM - ID # for ODG1 (optional)
35 ;
36 ;Be sure to have HLENTRY defined before making this call.
37 ; HL("SAN") v1.6 from init^hlfn2
38 ;It should be equal to the HL7 NON-DHCP APPLICATION PARAMETER name
39 ;This is only necessary if passing "A" for the fields.
40 ;
41 ;As well as all variables defined in INIT^HLFNC2
42 ;
43 I '$D(DFN)!'$D(EVENT)!'$D(NODE)!'$D(GBL) Q "-1^MISSING PARAMETERS"
44 I $D(HL)=1 Q "-1^"_HL ; this to insure init^hlfnc2 called
45 I '$D(HL) Q "-1^ No HL Array"
46 D SET
47 S UPFLG="",EVDT=$P(NODE,"^"),VPTR=$P(NODE,"^",5)
48 I '$D(COUNT)!(+COUNT<1) S COUNT=1
49 ;S @GBL@(COUNT)=$$MSH^HLFNC1("ADT"_$E(HL("ECH"))_"A08"),COUNT=COUNT+1
50 S FLG="05" ;event is new flag
51 G EN
52 ;
53OA08(DFN,EVENT,EVDT,VPTR,PISTR,ZSTR,PSTR,XSTR,PDNUM,ZNUM,PNUM,XNUM) ;
54 ;
55 ;DFN - Patient file DFN
56 ;EVENT - Event number from pivot file
57 ;EVDT - event date/time FileMan format
58 ;VPTR - variable pointer
59 ;PISTR - fields to be included in PID (null - required fields,
60 ;or string of fields seperated by commas)
61 ;ZSTR - fields to be included in ZPD (null - required fields,
62 ;or string of fields seperated by commas)
63 ;PSTR - fields to be included in OPV1
64 ;(if null - required fields, if "A" - supported
65 ;fields, or string of fields seperated by commas")
66 ;XSTR - fields to be included in ODG1
67 ;(if null - required fields, if "A" - supported
68 ;fields, or string of fields seperated by commas")
69 ;PDNUM - ID # for PID (optional)
70 ;ZNUM - ID # for ZPD (optional)
71 ;PNUM - ID # for OPV1 (optional)
72 ;XNUM - ID # for ODG1 (optional)
73 ;
74 ;
75 I '$D(DFN)&('$D(EVENT))&('$D(EVDT))!('$D(VPTR)) Q "-1^Missing Parameters, Unable to generate A08 Message"
76 I '$D(DFN) Q "-1^No patient selected, Unable to generate A08 Message"
77 I DFN="" Q "-1^No patient selected, Unable to generate A08 Message"
78 I $D(EVENT) I EVENT'="" S NODE=$$PIVX^VAFHPIVT(EVENT,DFN,EVDT)
79 I $D(EVENT) I EVENT="" K EVENT
80 D SET
81 I '$D(EVENT) S NODE=$$PIVNW^VAFHPIVT(DFN,EVDT,2,VPTR),EVENT=$P(NODE,":")
82 I EVENT<1 Q "-1^Bad Event Number, Unable to generate A08 Message"
83 S NODE=$P(NODE,":",2)
84 ; hlsdata should not be defined in 1.6 so this should always use hla()
85 S GBL=$G(HLSDATA) I GBL']"" S GBL="HLA(""HLS"")"
86 S COUNT=1
87 S (HLENTRY,HLNDAP)="PIMS HL7" DO I $D(HL)=1 G EXIT
88 . K HL D INIT^HLFNC2("VAFH A08",.HL) ; ; only for oa08 entry
89 ;call to determine old or new
90 S FLG="05" ;NEW
91 N LAST
92 S LAST=$$LTD^VAFHUTL(DFN)
93 I $P(LAST,"^")>EVDT S FLG="04" ;OLD
94 ;
95EN ;
96 S EVN=$$EVN^VAFHLEVN("A08",FLG)
97 I +EVN=-1 S HLERR="-1^UNABLE TO GENERATE EVN SEGMENT" G EXIT
98 S PID=$$EN^VAFHLPID(DFN,PISTR)
99 S ZPD=$$EN^VAFHLZPD(DFN,ZSTR)
100 I $G(^DPT(DFN,.1))]"",$D(UPFLG) DO ; if inpatient get inpat pv1
101 . S OPV1=$$EN^VAFHAPV1(DFN,$$NOW^XLFDT(),",2,3,7,8,10,19,44,45",,EVENT)
102 E S OPV1=$$OUT^VAFHLPV1(DFN,EVENT,EVDT,VPTR,PSTR,PNUM)
103 ;
104 I +OPV1=-1 S HLERR="-1^UNABLE TO GENERATE PV1 SEGMENT" G EXIT
105 I $D(XSTR) S ODG1=$$OUT^VAFHLDG1(DFN,EVENT,EVDT,VPTR,XSTR,XNUM)
106 S @GBL@(COUNT)=EVN,COUNT=COUNT+1
107 S @GBL@(COUNT)=PID M @GBL@(COUNT)=VAPID S COUNT=COUNT+1
108 S @GBL@(COUNT)=ZPD,COUNT=COUNT+1
109 ; CHANGE BECAUSE PHILLY WANTS "T"
110 I $P(OPV1,HLFS,3)="" S $P(OPV1,HLFS,3)="T"
111 S @GBL@(COUNT)=OPV1
112 I $D(XSTR) I +ODG1'=-1 S COUNT=COUNT+1,@GBL@(COUNT)=ODG1
113 I '$D(UPFLG) S HLMTN="ADT" DO ; upflag set on EN entry only
114 . I GBL["^TMP(" DO Q
115 . . D GENERATE^HLMA("VAFH A08","GM",1,.HLRSLT)
116 . . K ^TMP("HLS",$J)
117 . I GBL["HLA(" DO Q
118 . . D GENERATE^HLMA("VAFH A08","LM",1,.HLRSLT)
119 . . K HLA
120EXIT ;
121 N TERR ; upflg is set from up entry, HL check is at top
122 I $D(UPFLG) K UPFLG,EVN,PID,ZPD,OPV1,ODG1 Q "0^"_COUNT
123 ;I $D(HLERR)!$D(HL)=1 S TERR=$G(HLERR)
124 I $D(HL)=1 S TERR="-1^"_HL
125 I '$D(HLERR),$D(HL)>1 S TERR=0
126 I '$D(TERR) S TERR=0 ;just in case
127 K VAPID,HLRSLT,NODE,EVN,PID,ZPD,OPV1,ODG1,COUNT,FLG,CNT,ERR,EGBL
128 K HLSDATA,HLEVN,HLMTN,HLENTRY,HLERR,HLNDAP,EFLAG
129 D KILL^HLTRANS
130 Q TERR
131 ;
132SET ;
133 I '$D(PNUM) S PNUM=1
134 I '$D(PDNUM) S PDNUM=1
135 I '$D(ZNUM) S ZNUM=1
136 I '$D(XNUM) S XNUM=1
137 Q
Note: See TracBrowser for help on using the repository browser.