VAFHCA08 ;ALB/CM OUTPATIENT A08 GENERATOR ;4/5/95
;;5.3;Registration;**91**;Jun 06, 1996
;
;This function will generator an A08 HL7 message for an outpatient
;event. If the generation is successful, 0 will be returned.
;If for any reason is not successful, -1 and error message will be
;returned.
;
;Two entry points have been provided. The first is for use by the
;Update event outside of an outpatient event. The second is for use
;by the outpatient event. The second will return 0^COUNT, where COUNT
;is the last value entered.
;
UP(DFN,EVENT,NODE,COUNT,GBL,PISTR,ZSTR,PSTR,XSTR,PDNUM,ZNUM,PNUM,XNUM) ;
;
;DFN - Patient file DFN
;EVENT - Event number from pivot file
;NODE - Zero Node of pivot file entry
;COUNT - Subscript to start global/array storage at
;GBL - global or array to store segments
;PISTR - fields to be included in PID (null - required fields,
;or string of fields seperated by commas)
;ZSTR - fields to be included in ZPD (null - required fields,
;or string of fields seperated by commas)
;PSTR - fields to be included in OPV1
;(if null - required fields, if "A" - supported
;fields, or string of fields seperated by commas")
;XSTR - fields to be included in ODG1
;(if null - required fields, if "A" - supported
;fields, or string of fields seperated by commas")
;PDNUM - ID # for PID (optional)
;ZNUM - ID # for ZPD (optional)
;PNUM - ID # for OPV1 (optional)
;XNUM - ID # for ODG1 (optional)
;
;Be sure to have HLENTRY defined before making this call.
; HL("SAN") v1.6 from init^hlfn2
;It should be equal to the HL7 NON-DHCP APPLICATION PARAMETER name
;This is only necessary if passing "A" for the fields.
;
;As well as all variables defined in INIT^HLFNC2
;
I '$D(DFN)!'$D(EVENT)!'$D(NODE)!'$D(GBL) Q "-1^MISSING PARAMETERS"
I $D(HL)=1 Q "-1^"_HL ; this to insure init^hlfnc2 called
I '$D(HL) Q "-1^ No HL Array"
D SET
S UPFLG="",EVDT=$P(NODE,"^"),VPTR=$P(NODE,"^",5)
I '$D(COUNT)!(+COUNT<1) S COUNT=1
;S @GBL@(COUNT)=$$MSH^HLFNC1("ADT"_$E(HL("ECH"))_"A08"),COUNT=COUNT+1
S FLG="05" ;event is new flag
G EN
;
OA08(DFN,EVENT,EVDT,VPTR,PISTR,ZSTR,PSTR,XSTR,PDNUM,ZNUM,PNUM,XNUM) ;
;
;DFN - Patient file DFN
;EVENT - Event number from pivot file
;EVDT - event date/time FileMan format
;VPTR - variable pointer
;PISTR - fields to be included in PID (null - required fields,
;or string of fields seperated by commas)
;ZSTR - fields to be included in ZPD (null - required fields,
;or string of fields seperated by commas)
;PSTR - fields to be included in OPV1
;(if null - required fields, if "A" - supported
;fields, or string of fields seperated by commas")
;XSTR - fields to be included in ODG1
;(if null - required fields, if "A" - supported
;fields, or string of fields seperated by commas")
;PDNUM - ID # for PID (optional)
;ZNUM - ID # for ZPD (optional)
;PNUM - ID # for OPV1 (optional)
;XNUM - ID # for ODG1 (optional)
;
;
I '$D(DFN)&('$D(EVENT))&('$D(EVDT))!('$D(VPTR)) Q "-1^Missing Parameters, Unable to generate A08 Message"
I '$D(DFN) Q "-1^No patient selected, Unable to generate A08 Message"
I DFN="" Q "-1^No patient selected, Unable to generate A08 Message"
I $D(EVENT) I EVENT'="" S NODE=$$PIVX^VAFHPIVT(EVENT,DFN,EVDT)
I $D(EVENT) I EVENT="" K EVENT
D SET
I '$D(EVENT) S NODE=$$PIVNW^VAFHPIVT(DFN,EVDT,2,VPTR),EVENT=$P(NODE,":")
I EVENT<1 Q "-1^Bad Event Number, Unable to generate A08 Message"
S NODE=$P(NODE,":",2)
; hlsdata should not be defined in 1.6 so this should always use hla()
S GBL=$G(HLSDATA) I GBL']"" S GBL="HLA(""HLS"")"
S COUNT=1
S (HLENTRY,HLNDAP)="PIMS HL7" DO I $D(HL)=1 G EXIT
. K HL D INIT^HLFNC2("VAFH A08",.HL) ; ; only for oa08 entry
;call to determine old or new
S FLG="05" ;NEW
N LAST
S LAST=$$LTD^VAFHUTL(DFN)
I $P(LAST,"^")>EVDT S FLG="04" ;OLD
;
EN ;
S EVN=$$EVN^VAFHLEVN("A08",FLG)
I +EVN=-1 S HLERR="-1^UNABLE TO GENERATE EVN SEGMENT" G EXIT
S PID=$$EN^VAFHLPID(DFN,PISTR)
S ZPD=$$EN^VAFHLZPD(DFN,ZSTR)
I $G(^DPT(DFN,.1))]"",$D(UPFLG) DO ; if inpatient get inpat pv1
. S OPV1=$$EN^VAFHAPV1(DFN,$$NOW^XLFDT(),",2,3,7,8,10,19,44,45",,EVENT)
E S OPV1=$$OUT^VAFHLPV1(DFN,EVENT,EVDT,VPTR,PSTR,PNUM)
;
I +OPV1=-1 S HLERR="-1^UNABLE TO GENERATE PV1 SEGMENT" G EXIT
I $D(XSTR) S ODG1=$$OUT^VAFHLDG1(DFN,EVENT,EVDT,VPTR,XSTR,XNUM)
S @GBL@(COUNT)=EVN,COUNT=COUNT+1
S @GBL@(COUNT)=PID M @GBL@(COUNT)=VAPID S COUNT=COUNT+1
S @GBL@(COUNT)=ZPD,COUNT=COUNT+1
; CHANGE BECAUSE PHILLY WANTS "T"
I $P(OPV1,HLFS,3)="" S $P(OPV1,HLFS,3)="T"
S @GBL@(COUNT)=OPV1
I $D(XSTR) I +ODG1'=-1 S COUNT=COUNT+1,@GBL@(COUNT)=ODG1
I '$D(UPFLG) S HLMTN="ADT" DO ; upflag set on EN entry only
. I GBL["^TMP(" DO Q
. . D GENERATE^HLMA("VAFH A08","GM",1,.HLRSLT)
. . K ^TMP("HLS",$J)
. I GBL["HLA(" DO Q
. . D GENERATE^HLMA("VAFH A08","LM",1,.HLRSLT)
. . K HLA
EXIT ;
N TERR ; upflg is set from up entry, HL check is at top
I $D(UPFLG) K UPFLG,EVN,PID,ZPD,OPV1,ODG1 Q "0^"_COUNT
;I $D(HLERR)!$D(HL)=1 S TERR=$G(HLERR)
I $D(HL)=1 S TERR="-1^"_HL
I '$D(HLERR),$D(HL)>1 S TERR=0
I '$D(TERR) S TERR=0 ;just in case
K VAPID,HLRSLT,NODE,EVN,PID,ZPD,OPV1,ODG1,COUNT,FLG,CNT,ERR,EGBL
K HLSDATA,HLEVN,HLMTN,HLENTRY,HLERR,HLNDAP,EFLAG
D KILL^HLTRANS
Q TERR
;
SET ;
I '$D(PNUM) S PNUM=1
I '$D(PDNUM) S PDNUM=1
I '$D(ZNUM) S ZNUM=1
I '$D(XNUM) S XNUM=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHCA08 5525 printed Nov 22, 2024@18:12:45 Page 2
VAFHCA08 ;ALB/CM OUTPATIENT A08 GENERATOR ;4/5/95
+1 ;;5.3;Registration;**91**;Jun 06, 1996
+2 ;
+3 ;This function will generator an A08 HL7 message for an outpatient
+4 ;event. If the generation is successful, 0 will be returned.
+5 ;If for any reason is not successful, -1 and error message will be
+6 ;returned.
+7 ;
+8 ;Two entry points have been provided. The first is for use by the
+9 ;Update event outside of an outpatient event. The second is for use
+10 ;by the outpatient event. The second will return 0^COUNT, where COUNT
+11 ;is the last value entered.
+12 ;
UP(DFN,EVENT,NODE,COUNT,GBL,PISTR,ZSTR,PSTR,XSTR,PDNUM,ZNUM,PNUM,XNUM) ;
+1 ;
+2 ;DFN - Patient file DFN
+3 ;EVENT - Event number from pivot file
+4 ;NODE - Zero Node of pivot file entry
+5 ;COUNT - Subscript to start global/array storage at
+6 ;GBL - global or array to store segments
+7 ;PISTR - fields to be included in PID (null - required fields,
+8 ;or string of fields seperated by commas)
+9 ;ZSTR - fields to be included in ZPD (null - required fields,
+10 ;or string of fields seperated by commas)
+11 ;PSTR - fields to be included in OPV1
+12 ;(if null - required fields, if "A" - supported
+13 ;fields, or string of fields seperated by commas")
+14 ;XSTR - fields to be included in ODG1
+15 ;(if null - required fields, if "A" - supported
+16 ;fields, or string of fields seperated by commas")
+17 ;PDNUM - ID # for PID (optional)
+18 ;ZNUM - ID # for ZPD (optional)
+19 ;PNUM - ID # for OPV1 (optional)
+20 ;XNUM - ID # for ODG1 (optional)
+21 ;
+22 ;Be sure to have HLENTRY defined before making this call.
+23 ; HL("SAN") v1.6 from init^hlfn2
+24 ;It should be equal to the HL7 NON-DHCP APPLICATION PARAMETER name
+25 ;This is only necessary if passing "A" for the fields.
+26 ;
+27 ;As well as all variables defined in INIT^HLFNC2
+28 ;
+29 IF '$DATA(DFN)!'$DATA(EVENT)!'$DATA(NODE)!'$DATA(GBL)
QUIT "-1^MISSING PARAMETERS"
+30 ; this to insure init^hlfnc2 called
IF $DATA(HL)=1
QUIT "-1^"_HL
+31 IF '$DATA(HL)
QUIT "-1^ No HL Array"
+32 DO SET
+33 SET UPFLG=""
SET EVDT=$PIECE(NODE,"^")
SET VPTR=$PIECE(NODE,"^",5)
+34 IF '$DATA(COUNT)!(+COUNT<1)
SET COUNT=1
+35 ;S @GBL@(COUNT)=$$MSH^HLFNC1("ADT"_$E(HL("ECH"))_"A08"),COUNT=COUNT+1
+36 ;event is new flag
SET FLG="05"
+37 GOTO EN
+38 ;
OA08(DFN,EVENT,EVDT,VPTR,PISTR,ZSTR,PSTR,XSTR,PDNUM,ZNUM,PNUM,XNUM) ;
+1 ;
+2 ;DFN - Patient file DFN
+3 ;EVENT - Event number from pivot file
+4 ;EVDT - event date/time FileMan format
+5 ;VPTR - variable pointer
+6 ;PISTR - fields to be included in PID (null - required fields,
+7 ;or string of fields seperated by commas)
+8 ;ZSTR - fields to be included in ZPD (null - required fields,
+9 ;or string of fields seperated by commas)
+10 ;PSTR - fields to be included in OPV1
+11 ;(if null - required fields, if "A" - supported
+12 ;fields, or string of fields seperated by commas")
+13 ;XSTR - fields to be included in ODG1
+14 ;(if null - required fields, if "A" - supported
+15 ;fields, or string of fields seperated by commas")
+16 ;PDNUM - ID # for PID (optional)
+17 ;ZNUM - ID # for ZPD (optional)
+18 ;PNUM - ID # for OPV1 (optional)
+19 ;XNUM - ID # for ODG1 (optional)
+20 ;
+21 ;
+22 IF '$DATA(DFN)&('$DATA(EVENT))&('$DATA(EVDT))!('$DATA(VPTR))
QUIT "-1^Missing Parameters, Unable to generate A08 Message"
+23 IF '$DATA(DFN)
QUIT "-1^No patient selected, Unable to generate A08 Message"
+24 IF DFN=""
QUIT "-1^No patient selected, Unable to generate A08 Message"
+25 IF $DATA(EVENT)
IF EVENT'=""
SET NODE=$$PIVX^VAFHPIVT(EVENT,DFN,EVDT)
+26 IF $DATA(EVENT)
IF EVENT=""
KILL EVENT
+27 DO SET
+28 IF '$DATA(EVENT)
SET NODE=$$PIVNW^VAFHPIVT(DFN,EVDT,2,VPTR)
SET EVENT=$PIECE(NODE,":")
+29 IF EVENT<1
QUIT "-1^Bad Event Number, Unable to generate A08 Message"
+30 SET NODE=$PIECE(NODE,":",2)
+31 ; hlsdata should not be defined in 1.6 so this should always use hla()
+32 SET GBL=$GET(HLSDATA)
IF GBL']""
SET GBL="HLA(""HLS"")"
+33 SET COUNT=1
+34 SET (HLENTRY,HLNDAP)="PIMS HL7"
Begin DoDot:1
+35 ; ; only for oa08 entry
KILL HL
DO INIT^HLFNC2("VAFH A08",.HL)
End DoDot:1
IF $DATA(HL)=1
GOTO EXIT
+36 ;call to determine old or new
+37 ;NEW
SET FLG="05"
+38 NEW LAST
+39 SET LAST=$$LTD^VAFHUTL(DFN)
+40 ;OLD
IF $PIECE(LAST,"^")>EVDT
SET FLG="04"
+41 ;
EN ;
+1 SET EVN=$$EVN^VAFHLEVN("A08",FLG)
+2 IF +EVN=-1
SET HLERR="-1^UNABLE TO GENERATE EVN SEGMENT"
GOTO EXIT
+3 SET PID=$$EN^VAFHLPID(DFN,PISTR)
+4 SET ZPD=$$EN^VAFHLZPD(DFN,ZSTR)
+5 ; if inpatient get inpat pv1
IF $GET(^DPT(DFN,.1))]""
IF $DATA(UPFLG)
Begin DoDot:1
+6 SET OPV1=$$EN^VAFHAPV1(DFN,$$NOW^XLFDT(),",2,3,7,8,10,19,44,45",,EVENT)
End DoDot:1
+7 IF '$TEST
SET OPV1=$$OUT^VAFHLPV1(DFN,EVENT,EVDT,VPTR,PSTR,PNUM)
+8 ;
+9 IF +OPV1=-1
SET HLERR="-1^UNABLE TO GENERATE PV1 SEGMENT"
GOTO EXIT
+10 IF $DATA(XSTR)
SET ODG1=$$OUT^VAFHLDG1(DFN,EVENT,EVDT,VPTR,XSTR,XNUM)
+11 SET @GBL@(COUNT)=EVN
SET COUNT=COUNT+1
+12 SET @GBL@(COUNT)=PID
MERGE @GBL@(COUNT)=VAPID
SET COUNT=COUNT+1
+13 SET @GBL@(COUNT)=ZPD
SET COUNT=COUNT+1
+14 ; CHANGE BECAUSE PHILLY WANTS "T"
+15 IF $PIECE(OPV1,HLFS,3)=""
SET $PIECE(OPV1,HLFS,3)="T"
+16 SET @GBL@(COUNT)=OPV1
+17 IF $DATA(XSTR)
IF +ODG1'=-1
SET COUNT=COUNT+1
SET @GBL@(COUNT)=ODG1
+18 ; upflag set on EN entry only
IF '$DATA(UPFLG)
SET HLMTN="ADT"
Begin DoDot:1
+19 IF GBL["^TMP("
Begin DoDot:2
+20 DO GENERATE^HLMA("VAFH A08","GM",1,.HLRSLT)
+21 KILL ^TMP("HLS",$JOB)
End DoDot:2
QUIT
+22 IF GBL["HLA("
Begin DoDot:2
+23 DO GENERATE^HLMA("VAFH A08","LM",1,.HLRSLT)
+24 KILL HLA
End DoDot:2
QUIT
End DoDot:1
EXIT ;
+1 ; upflg is set from up entry, HL check is at top
NEW TERR
+2 IF $DATA(UPFLG)
KILL UPFLG,EVN,PID,ZPD,OPV1,ODG1
QUIT "0^"_COUNT
+3 ;I $D(HLERR)!$D(HL)=1 S TERR=$G(HLERR)
+4 IF $DATA(HL)=1
SET TERR="-1^"_HL
+5 IF '$DATA(HLERR)
IF $DATA(HL)>1
SET TERR=0
+6 ;just in case
IF '$DATA(TERR)
SET TERR=0
+7 KILL VAPID,HLRSLT,NODE,EVN,PID,ZPD,OPV1,ODG1,COUNT,FLG,CNT,ERR,EGBL
+8 KILL HLSDATA,HLEVN,HLMTN,HLENTRY,HLERR,HLNDAP,EFLAG
+9 DO KILL^HLTRANS
+10 QUIT TERR
+11 ;
SET ;
+1 IF '$DATA(PNUM)
SET PNUM=1
+2 IF '$DATA(PDNUM)
SET PDNUM=1
+3 IF '$DATA(ZNUM)
SET ZNUM=1
+4 IF '$DATA(XNUM)
SET XNUM=1
+5 QUIT
