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

VAFHLZEN.m

Go to the documentation of this file.
  1. VAFHLZEN ;ALB/KCL,KUM - Create generic HL7 Enrollment (ZEN) segment ;11/16/19 3:34PM
  1. ;;5.3;Registration;**122,147,232,993**;Aug 13, 1993;Build 92
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;
  1. ;Supported ICRs
  1. ; #2055 - $$EXTERNAL^DILFD()
  1. ; #2056 - $$GET1^DIQ(}
  1. ;
  1. ; This generic extrinsic function is designed to return the
  1. ; HL7 Enrollment (ZEN) segment. This segment contains VA-specific
  1. ; current enrollment information for a patient.
  1. ;
  1. EN(DFN,VAFSTR,VAFNUM,VAFHLQ,VAFHLFS) ; --
  1. ; Entry point for creating HL7 Enrollment (ZEN) segment.
  1. ;
  1. ; Input(s):
  1. ; DFN - internal entry number of Patient (#2) file
  1. ; VAFSTR - (optional) string of fields requested, separated by
  1. ; commas. If not passed, return all data fields.
  1. ; VAFNUM - (optional) sequential number for SET ID (default=1)
  1. ; VAFHLQ - (optional) HL7 null variable.
  1. ; VAFHLFS - (optional) HL7 field separator.
  1. ;
  1. ; Output(s):
  1. ; String containing the desired components of the HL7 ZEN segment
  1. ;
  1. N VAFENR,VAFIEN,VAFPREF,VAFY,SEQ
  1. ;
  1. ; if VAFHLQ or VAFHLFS not passed, use default HL7 variables
  1. S VAFHLQ=$S($D(VAFHLQ):VAFHLQ,1:$G(HLQ)),VAFHLFS=$S($D(VAFHLFS):VAFHLFS,1:$G(HLFS))
  1. ;
  1. ; if set id not passed, use default
  1. S VAFNUM=$S($G(VAFNUM):VAFNUM,1:1)
  1. ;
  1. ; if DFN not passed, exit
  1. I '$G(DFN) S VAFY=1 G ENQ
  1. ;
  1. ; if VAFSTR not passed, return all data fields (SEQ's)
  1. ; DG*5.3*993 KUM - Allow new sequence numbers to send
  1. ;I $G(VAFSTR)']"" F SEQ=1:1:13 S $P(VAFSTR,",",SEQ)=SEQ
  1. I $G(VAFSTR)']"" F SEQ=1:1:19 S $P(VAFSTR,",",SEQ)=SEQ
  1. ;
  1. ; find IEN of patients 'current' enrollment record using
  1. ; enrollment API, exit if not successful
  1. S VAFIEN=$$FINDCUR^DGENA(DFN)
  1. I '$G(VAFIEN) S VAFY=1 G ENQ
  1. ;
  1. ; get current enrollment record from Patient Enrollment (#27.11) file
  1. ; using enrollment API, exit if not successful
  1. I '$$GET^DGENA(VAFIEN,.VAFENR) S VAFY=1 G ENQ
  1. ;
  1. ; initialize output string and requested data fields
  1. S $P(VAFY,VAFHLFS,12)="",VAFSTR=","_VAFSTR_","
  1. ;
  1. ; set-up segment data fields
  1. S $P(VAFY,VAFHLFS,1)=$S($G(VAFNUM):VAFNUM,1:1) ; Set ID
  1. ;
  1. ;!!!!!! until HEC is ready to accept new Application Date, must transmit
  1. ;Application Date in the Enrollment Date field
  1. ; DG*5.3*933 - KUM - Make sure only send Date value for all Date fields
  1. ;I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=$S($G(VAFENR("DATE")):$$HLDATE^HLFNC(VAFENR("DATE")),1:VAFHLQ) ; Enrollment Date
  1. ;I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=$S($G(VAFENR("APP")):$$HLDATE^HLFNC(VAFENR("APP")),1:VAFHLQ) ; Enrollment Date filled with Application Date
  1. I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=$S($G(VAFENR("APP")):$$HLDATE^HLFNC(VAFENR("APP"),"DT"),1:VAFHLQ) ; Enrollment Date filled with Application Date
  1. ;
  1. I VAFSTR[",3," S $P(VAFY,VAFHLFS,3)=$S($G(VAFENR("SOURCE"))]"":VAFENR("SOURCE"),1:VAFHLQ) ; Enrollment Source
  1. I VAFSTR[",4," S $P(VAFY,VAFHLFS,4)=$S($G(VAFENR("STATUS"))]"":VAFENR("STATUS"),1:VAFHLQ) ; Enrollment Status
  1. I VAFSTR[",5," S $P(VAFY,VAFHLFS,5)=$S($G(VAFENR("REASON"))]"":VAFENR("REASON"),1:VAFHLQ) ; Enrollment Reason Canceled/Declined
  1. I VAFSTR[",6," S $P(VAFY,VAFHLFS,6)=$S($G(VAFENR("REMARKS"))]"":VAFENR("REMARKS"),1:VAFHLQ) ; Canceled/Declined Remarks
  1. I VAFSTR[",7," S X=$$STATION^VAFHLFNC(VAFENR("FACREC")) S $P(VAFY,VAFHLFS,7)=$S(X]"":X,1:VAFHLQ) ; Facility Received
  1. I VAFSTR[",8," S X=$$STATION^VAFHLFNC($$PREF^DGENPTA(DFN)) S $P(VAFY,VAFHLFS,8)=$S(X]"":X,1:VAFHLQ) ; Preferred Facility
  1. I VAFSTR[",9," S $P(VAFY,VAFHLFS,9)=$S($G(VAFENR("PRIORITY"))]"":VAFENR("PRIORITY"),1:VAFHLQ) ; Enrollment Priority
  1. ;I VAFSTR[",10," S $P(VAFY,VAFHLFS,10)=$S($G(VAFENR("EFFDATE")):$$HLDATE^HLFNC(VAFENR("EFFDATE")),1:VAFHLQ) ; Effective Date
  1. I VAFSTR[",10," S $P(VAFY,VAFHLFS,10)=$S($G(VAFENR("EFFDATE")):$$HLDATE^HLFNC(VAFENR("EFFDATE"),"DT"),1:VAFHLQ) ; Effective Date
  1. ;I VAFSTR[",11," S $P(VAFY,VAFHLFS,11)=$S($G(VAFENR("APP")):$$HLDATE^HLFNC(VAFENR("APP")),1:VAFHLQ) ; Enrollment Application Date
  1. I VAFSTR[",11," S $P(VAFY,VAFHLFS,11)=$S($G(VAFENR("APP")):$$HLDATE^HLFNC(VAFENR("APP"),"DT"),1:VAFHLQ) ; Enrollment Application Date
  1. ;I VAFSTR[",12," S $P(VAFY,VAFHLFS,12)=$S($G(VAFENR("END")):$$HLDATE^HLFNC(VAFENR("END")),1:VAFHLQ) ; Enrollment End Date
  1. I VAFSTR[",12," S $P(VAFY,VAFHLFS,12)=$S($G(VAFENR("END")):$$HLDATE^HLFNC(VAFENR("END"),"DT"),1:VAFHLQ) ; Enrollment End Date
  1. I VAFSTR[",13," S $P(VAFY,VAFHLFS,13)=$S($G(VAFENR("SUBGRP"))]"":VAFENR("SUBGRP"),1:VAFHLQ) ; Enrollment Priority Subgroup
  1. ;DG*5.3*993 KUM - Add Seq numbers 16, 17, 18, 19 in ZEN segment
  1. I VAFSTR[",14," S $P(VAFY,VAFHLFS,14)=VAFHLQ ; Adding to allow to send sequence numbers 16-18
  1. I VAFSTR[",15," S $P(VAFY,VAFHLFS,15)=VAFHLQ ; Adding to allow to send sequence numbers 16-18
  1. I VAFSTR[",16," S $P(VAFY,VAFHLFS,16)=$S($G(VAFENR("PTAPPLIED"))]"":VAFENR("PTAPPLIED"),1:VAFHLQ) ; PT Applied for Enrollment?
  1. S VAFSTR("REGREA")=$$GET1^DIQ(408.43,$G(VAFSTR("REGREA")),.03)
  1. I VAFSTR[",17," S $P(VAFY,VAFHLFS,17)=$S($G(VAFENR("REGREA"))]"":VAFENR("REGREA"),1:VAFHLQ) ; Registration only Reason
  1. ;I VAFSTR[",18," S X=$G(VAFENR("REGDATE")) I X]"" S $P(VAFY,VAFHLFS,18)=$S(X]"":$$HLDATE^HLFNC(X),1:VAFHLQ) ; Registration only Date
  1. I VAFSTR[",18," S X=$G(VAFENR("REGDATE")) I X]"" S $P(VAFY,VAFHLFS,18)=$S(X]"":$$HLDATE^HLFNC(X,"DT"),1:VAFHLQ) ; Registration only Date
  1. S VAFENR("REGSRC")=$$EXTERNAL^DILFD(27.11,.17,"",$G(VAFENR("REGSRC")))
  1. I VAFSTR[",19," S $P(VAFY,VAFHLFS,19)=$S($G(VAFENR("REGSRC"))]"":VAFENR("REGSRC"),1:VAFHLQ) ; Source of Registration
  1. ;
  1. ENQ Q "ZEN"_VAFHLFS_$G(VAFY)