Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFHCA08

VAFHCA08.m

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