VAFHLZTE ;SHRPE/YMG - Create HL7 ZTE segment ;06/17/19
;;5.3;Registration;**952,977**;Aug 13, 1993;Build 177
;;Per VA Directive 6402, this routine should not be modified.
;
Q
EN(DFN,VAFSTR,VAFCHK,VAFZTE) ; build HL7 ZTE segments.
; These segments contain VA-specific data for OTH (Other Than Honorable)
; patients. ZTE segments will be returned in the array VAFZTE.
;
; Input: DFN - Pointer to PATIENT file (#2)
; VAFSTR - String of fields requested separated by commas
; VAFCHK - 1 to only create ZTE segments if patient is OTH, 0 to create segments regardless of patient's OTH status (default)
; .VAFZEL - Array to return segments in
;
; Existence of HL7 encoding characters (HLFS,HLECH) is assumed
;
; Output: VAFZTE(X) = ZTE segment (first 245 characters)
; VAFZTE(X,Y) = Remaining portion of ZTE segment in 245 character chunks
;
; Notes: VAFZTE is initialized (KILLed) on input.
;
N DGOTHSTR,IEN33,IEN3301,IEN3303,IEN3311,VAFHLZTE,VAFSETID,VAFMAXL
K VAFZTE
S VAFMAXL=245
S VAFCHK=+$G(VAFCHK,0)
I VAFCHK,'$$ISOTHD^DGOTHD(DFN) Q
I '$G(DFN)!($G(VAFSTR)="") Q
S VAFSTR=","_VAFSTR_","
S IEN33=+$O(^DGOTH(33,"B",DFN,"")) I 'IEN33 Q
; Build ZTE segments
S VAFSETID=1
; ZTE for pending request
S DGOTHSTR=$$GETPEND^DGOTHUT1(DFN)
I $P(DGOTHSTR,U)>0 D GETDATA("P",DGOTHSTR),MAKESEG S VAFSETID=VAFSETID+1
; ZTE for denied requests
S IEN3303=0 F S IEN3303=$O(^DGOTH(33,IEN33,3,IEN3303)) Q:'IEN3303 D
.S DGOTHSTR=$$GETDEN^DGOTHUT1(IEN33,IEN3303)
.I $P(DGOTHSTR,U)>0 D GETDATA("D",DGOTHSTR),MAKESEG S VAFSETID=VAFSETID+1
.Q
; ZTE for approved requests
S IEN3301=0 F S IEN3301=$O(^DGOTH(33,IEN33,1,IEN3301)) Q:'IEN3301 D
.S IEN3311=0 F S IEN3311=$O(^DGOTH(33,IEN33,1,IEN3301,1,IEN3311)) Q:'IEN3311 D
..S DGOTHSTR=$$GETAUTH^DGOTHUT1(IEN33,IEN3301,IEN3311)
..I $P(DGOTHSTR,U)>0 D GETDATA("A",DGOTHSTR),MAKESEG S VAFSETID=VAFSETID+1
..Q
.Q
Q
;
GETDATA(DGTYPE,DGOTHSTR) ; Get information needed to build ZTE segment
; Input:
; DGTYPE = request type: "P" = Pending, "D" = Denied, "A" = Approved
; DGOTHSTR = "^" - delimited string containing data from file 33 to use
;
; Existence of the following variables is assumed
; DFN - Pointer to Patient (#2) file
; VAFSTR - Fields to extract (padded with commas)
; VAFSETID - Value to use for Set ID (optional)
; HL7 encoding characters (HLFS, HLENC, HLQ)
;
; Output: VAFHLZTE(SeqNum) = Value
;
; Notes: VAFHLZTE is initialized (KILLed) on entry
;
K VAFHLZTE
; Set ID
I VAFSTR[",1," S VAFHLZTE(1)=+$G(VAFSETID)
; Date request submitted
I VAFSTR[",2," S VAFHLZTE(2)=$$HLDATE^HLFNC($P(DGOTHSTR,U,$S(DGTYPE="A":4,1:2)))
; Request creation timestamp
I VAFSTR[",3," S VAFHLZTE(3)=$$HLDATE^HLFNC($P(DGOTHSTR,U,$S(DGTYPE="A":10,DGTYPE="D":7,1:6)))
; Authorization status
I VAFSTR[",4," S VAFHLZTE(4)=DGTYPE
; Request entered/edited timestamp
I VAFSTR[",5," S VAFHLZTE(5)=$$HLDATE^HLFNC($P(DGOTHSTR,U,$S(DGTYPE="A":7,DGTYPE="D":5,1:4)))
; Request entered by
I VAFSTR[",6," S VAFHLZTE(6)=$P(DGOTHSTR,U,$S(DGTYPE="A":6,DGTYPE="D":4,1:3)) ; DG*5.3*977 OTH-EXT
; Facility
I VAFSTR[",7," S VAFHLZTE(7)=$$STA^XUAF4($P(DGOTHSTR,U,$S(DGTYPE="A":9,DGTYPE="D":6,1:5)))
; 365 day period number
I VAFSTR[",8," S VAFHLZTE(8)=$S(DGTYPE="A":$P(DGOTHSTR,U),1:"")
; 90 day period number
I VAFSTR[",9," S VAFHLZTE(9)=$S(DGTYPE="A":$P(DGOTHSTR,U,2),1:"")
; Authorization date
I VAFSTR[10 S VAFHLZTE(10)=$S(DGTYPE="A":$$HLDATE^HLFNC($P(DGOTHSTR,U,5)),1:"")
; Request authorized by
I VAFSTR[11 S VAFHLZTE(11)=$S(DGTYPE="A":$P(DGOTHSTR,U,8),1:"") ; DG*5.3*977 OTH-EXT
; 90 day period start date
I VAFSTR[12 S VAFHLZTE(12)=$S(DGTYPE="A":$$HLDATE^HLFNC($P(DGOTHSTR,U,3)),1:"")
; Authorization comment
I VAFSTR[13 S VAFHLZTE(13)=$S(DGTYPE="D":$P(DGOTHSTR,U,3),1:"") ; DG*5.3*977 OTH-EXT
Q
;
MAKESEG ; Create segment using obtained data
; Input: Existence of the following variables is assumed
; VAFSETID = Number denoting Xth repetition of the ZTE segment
; VAFMAXL = Maximum length of each node (defaults to 245)
; VAFHLZTE(SeqNum) = Value
; HL7 encoding characters (HLFS, HLECH)
;
; Output: VAFZTE(VAFSETID) = ZTE segment (first VAFMAXL characters)
; VAFZTE(VAFSETID,x) = Remaining portion of ZTE segment in VAFMAXL character chunks (if needed), beginning with a field separator
;
; Notes: VAFZTE(VAFSETID) is initialized (KILLed) on input. Fields will not be split across nodes in VAFZTE()
;
N SEQ,SPILL,SPILLON,SPOT,LASTSEQ,VAFY
K VAFZTE(VAFSETID)
S VAFZTE(VAFSETID)="ZTE"
S:'+$G(VAFMAXL) VAFMAXL=245
S VAFY=$NA(VAFZTE(VAFSETID))
S (SPILL,SPILLON)=0
S LASTSEQ=+$O(VAFHLZTE(""),-1)
F SEQ=1:1:LASTSEQ D
.; Make sure maximum length won't be exceeded
.I ($L(@VAFY)+$L($G(VAFHLZTE(SEQ)))+1)>VAFMAXL D
..; Max length exceeded - start putting data on next node
..S SPILL=SPILL+1
..S SPILLON=SEQ-1
..S VAFY=$NA(VAFZTE(VAFSETID,SPILL))
.; Add to string
.S SPOT=(SEQ+1)-SPILLON
.S $P(@VAFY,HLFS,SPOT)=$G(VAFHLZTE(SEQ))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLZTE 5119 printed Oct 16, 2024@19:04:13 Page 2
VAFHLZTE ;SHRPE/YMG - Create HL7 ZTE segment ;06/17/19
+1 ;;5.3;Registration;**952,977**;Aug 13, 1993;Build 177
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
EN(DFN,VAFSTR,VAFCHK,VAFZTE) ; build HL7 ZTE segments.
+1 ; These segments contain VA-specific data for OTH (Other Than Honorable)
+2 ; patients. ZTE segments will be returned in the array VAFZTE.
+3 ;
+4 ; Input: DFN - Pointer to PATIENT file (#2)
+5 ; VAFSTR - String of fields requested separated by commas
+6 ; VAFCHK - 1 to only create ZTE segments if patient is OTH, 0 to create segments regardless of patient's OTH status (default)
+7 ; .VAFZEL - Array to return segments in
+8 ;
+9 ; Existence of HL7 encoding characters (HLFS,HLECH) is assumed
+10 ;
+11 ; Output: VAFZTE(X) = ZTE segment (first 245 characters)
+12 ; VAFZTE(X,Y) = Remaining portion of ZTE segment in 245 character chunks
+13 ;
+14 ; Notes: VAFZTE is initialized (KILLed) on input.
+15 ;
+16 NEW DGOTHSTR,IEN33,IEN3301,IEN3303,IEN3311,VAFHLZTE,VAFSETID,VAFMAXL
+17 KILL VAFZTE
+18 SET VAFMAXL=245
+19 SET VAFCHK=+$GET(VAFCHK,0)
+20 IF VAFCHK
IF '$$ISOTHD^DGOTHD(DFN)
QUIT
+21 IF '$GET(DFN)!($GET(VAFSTR)="")
QUIT
+22 SET VAFSTR=","_VAFSTR_","
+23 SET IEN33=+$ORDER(^DGOTH(33,"B",DFN,""))
IF 'IEN33
QUIT
+24 ; Build ZTE segments
+25 SET VAFSETID=1
+26 ; ZTE for pending request
+27 SET DGOTHSTR=$$GETPEND^DGOTHUT1(DFN)
+28 IF $PIECE(DGOTHSTR,U)>0
DO GETDATA("P",DGOTHSTR)
DO MAKESEG
SET VAFSETID=VAFSETID+1
+29 ; ZTE for denied requests
+30 SET IEN3303=0
FOR
SET IEN3303=$ORDER(^DGOTH(33,IEN33,3,IEN3303))
if 'IEN3303
QUIT
Begin DoDot:1
+31 SET DGOTHSTR=$$GETDEN^DGOTHUT1(IEN33,IEN3303)
+32 IF $PIECE(DGOTHSTR,U)>0
DO GETDATA("D",DGOTHSTR)
DO MAKESEG
SET VAFSETID=VAFSETID+1
+33 QUIT
End DoDot:1
+34 ; ZTE for approved requests
+35 SET IEN3301=0
FOR
SET IEN3301=$ORDER(^DGOTH(33,IEN33,1,IEN3301))
if 'IEN3301
QUIT
Begin DoDot:1
+36 SET IEN3311=0
FOR
SET IEN3311=$ORDER(^DGOTH(33,IEN33,1,IEN3301,1,IEN3311))
if 'IEN3311
QUIT
Begin DoDot:2
+37 SET DGOTHSTR=$$GETAUTH^DGOTHUT1(IEN33,IEN3301,IEN3311)
+38 IF $PIECE(DGOTHSTR,U)>0
DO GETDATA("A",DGOTHSTR)
DO MAKESEG
SET VAFSETID=VAFSETID+1
+39 QUIT
End DoDot:2
+40 QUIT
End DoDot:1
+41 QUIT
+42 ;
GETDATA(DGTYPE,DGOTHSTR) ; Get information needed to build ZTE segment
+1 ; Input:
+2 ; DGTYPE = request type: "P" = Pending, "D" = Denied, "A" = Approved
+3 ; DGOTHSTR = "^" - delimited string containing data from file 33 to use
+4 ;
+5 ; Existence of the following variables is assumed
+6 ; DFN - Pointer to Patient (#2) file
+7 ; VAFSTR - Fields to extract (padded with commas)
+8 ; VAFSETID - Value to use for Set ID (optional)
+9 ; HL7 encoding characters (HLFS, HLENC, HLQ)
+10 ;
+11 ; Output: VAFHLZTE(SeqNum) = Value
+12 ;
+13 ; Notes: VAFHLZTE is initialized (KILLed) on entry
+14 ;
+15 KILL VAFHLZTE
+16 ; Set ID
+17 IF VAFSTR[",1,"
SET VAFHLZTE(1)=+$GET(VAFSETID)
+18 ; Date request submitted
+19 IF VAFSTR[",2,"
SET VAFHLZTE(2)=$$HLDATE^HLFNC($PIECE(DGOTHSTR,U,$SELECT(DGTYPE="A":4,1:2)))
+20 ; Request creation timestamp
+21 IF VAFSTR[",3,"
SET VAFHLZTE(3)=$$HLDATE^HLFNC($PIECE(DGOTHSTR,U,$SELECT(DGTYPE="A":10,DGTYPE="D":7,1:6)))
+22 ; Authorization status
+23 IF VAFSTR[",4,"
SET VAFHLZTE(4)=DGTYPE
+24 ; Request entered/edited timestamp
+25 IF VAFSTR[",5,"
SET VAFHLZTE(5)=$$HLDATE^HLFNC($PIECE(DGOTHSTR,U,$SELECT(DGTYPE="A":7,DGTYPE="D":5,1:4)))
+26 ; Request entered by
+27 ; DG*5.3*977 OTH-EXT
IF VAFSTR[",6,"
SET VAFHLZTE(6)=$PIECE(DGOTHSTR,U,$SELECT(DGTYPE="A":6,DGTYPE="D":4,1:3))
+28 ; Facility
+29 IF VAFSTR[",7,"
SET VAFHLZTE(7)=$$STA^XUAF4($PIECE(DGOTHSTR,U,$SELECT(DGTYPE="A":9,DGTYPE="D":6,1:5)))
+30 ; 365 day period number
+31 IF VAFSTR[",8,"
SET VAFHLZTE(8)=$SELECT(DGTYPE="A":$PIECE(DGOTHSTR,U),1:"")
+32 ; 90 day period number
+33 IF VAFSTR[",9,"
SET VAFHLZTE(9)=$SELECT(DGTYPE="A":$PIECE(DGOTHSTR,U,2),1:"")
+34 ; Authorization date
+35 IF VAFSTR[10
SET VAFHLZTE(10)=$SELECT(DGTYPE="A":$$HLDATE^HLFNC($PIECE(DGOTHSTR,U,5)),1:"")
+36 ; Request authorized by
+37 ; DG*5.3*977 OTH-EXT
IF VAFSTR[11
SET VAFHLZTE(11)=$SELECT(DGTYPE="A":$PIECE(DGOTHSTR,U,8),1:"")
+38 ; 90 day period start date
+39 IF VAFSTR[12
SET VAFHLZTE(12)=$SELECT(DGTYPE="A":$$HLDATE^HLFNC($PIECE(DGOTHSTR,U,3)),1:"")
+40 ; Authorization comment
+41 ; DG*5.3*977 OTH-EXT
IF VAFSTR[13
SET VAFHLZTE(13)=$SELECT(DGTYPE="D":$PIECE(DGOTHSTR,U,3),1:"")
+42 QUIT
+43 ;
MAKESEG ; Create segment using obtained data
+1 ; Input: Existence of the following variables is assumed
+2 ; VAFSETID = Number denoting Xth repetition of the ZTE segment
+3 ; VAFMAXL = Maximum length of each node (defaults to 245)
+4 ; VAFHLZTE(SeqNum) = Value
+5 ; HL7 encoding characters (HLFS, HLECH)
+6 ;
+7 ; Output: VAFZTE(VAFSETID) = ZTE segment (first VAFMAXL characters)
+8 ; VAFZTE(VAFSETID,x) = Remaining portion of ZTE segment in VAFMAXL character chunks (if needed), beginning with a field separator
+9 ;
+10 ; Notes: VAFZTE(VAFSETID) is initialized (KILLed) on input. Fields will not be split across nodes in VAFZTE()
+11 ;
+12 NEW SEQ,SPILL,SPILLON,SPOT,LASTSEQ,VAFY
+13 KILL VAFZTE(VAFSETID)
+14 SET VAFZTE(VAFSETID)="ZTE"
+15 if '+$GET(VAFMAXL)
SET VAFMAXL=245
+16 SET VAFY=$NAME(VAFZTE(VAFSETID))
+17 SET (SPILL,SPILLON)=0
+18 SET LASTSEQ=+$ORDER(VAFHLZTE(""),-1)
+19 FOR SEQ=1:1:LASTSEQ
Begin DoDot:1
+20 ; Make sure maximum length won't be exceeded
+21 IF ($LENGTH(@VAFY)+$LENGTH($GET(VAFHLZTE(SEQ)))+1)>VAFMAXL
Begin DoDot:2
+22 ; Max length exceeded - start putting data on next node
+23 SET SPILL=SPILL+1
+24 SET SPILLON=SEQ-1
+25 SET VAFY=$NAME(VAFZTE(VAFSETID,SPILL))
End DoDot:2
+26 ; Add to string
+27 SET SPOT=(SEQ+1)-SPILLON
+28 SET $PIECE(@VAFY,HLFS,SPOT)=$GET(VAFHLZTE(SEQ))
End DoDot:1
+29 QUIT
