BQICAHLO ;VNGT/HS/ALA-HL7 for CANES Export ; 08 Nov 2010 2:09 PM
;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
;
EN ;EP
NEW APPARMS,PARMS,IN,RECORD,ERR,ERROR,WHO,HLMSTATE,MSIEN,BDIEN,CNT,HIN,HLFS,HLECH
NEW MSH,SEG,VISIT,GRP
K ^BQIHL7($J)
; Start the batch segment
S APPARMS("COUNTRY")="USA"
S APPARMS("FIELD SEPARATOR")="|"
S APPARMS("ENCODING CHARACTERS")="^~\&"
S APPARMS("VERSION")="2.5"
I '$$NEWBATCH^HLOAPI(.APPARMS,.HLMSTATE,.ERROR) Q
;
I $O(^BQIDATA($J,0))'="" D
. S IN=0
. F S IN=$O(^BQIDATA($J,IN)) Q:IN="" D
.. D BEG
.. S RECORD=^BQIDATA($J,IN)
.. S VISIT=$P(RECORD,DELIM,17)
.. D SEG
;
I $O(^BQIDATA($J,0))="" D BEG
;
I '$D(ERR) D
. ; Define sending and receiving parameters
. S APPARMS("SENDING APPLICATION")="RPMS-CANES"
. S APPARMS("ACCEPT ACK TYPE")="AL" ;Commit ACK type
. S APPARMS("APP ACK RESPONSE")="AACK^BQICAHLO" ;Callback when 'application ACK' is received
. S APPARMS("ACCEPT ACK RESPONSE")="CACK^BQICAHLO" ;Callback when 'commit ACK' is received
. S APPARMS("APP ACK TYPE")="AL" ;Application ACK type
. S APPARMS("QUEUE")="CANES ADT" ;Incoming QUEUE
. S WHO("RECEIVING APPLICATION")="CDC"
. S WHO("FACILITY LINK NAME")="CANES"
. I '$$SENDONE^HLOAPI1(.HLMSTATE,.APPARMS,.WHO,.ERROR) D
.. S ERR=$G(ERROR)
;
; Set up HL7 messages in global for flat file export
S MSIEN=$G(HLMSTATE("IEN"))
I MSIEN="" Q
S CNT=0
S BDIEN=$P($G(^HLB(MSIEN,0)),U,2) I BDIEN="" Q
S HIN=0
F S HIN=$O(^HLB(MSIEN,3,HIN)) Q:'HIN D
. S MSH=""
. S GRP=$P(^HLB(MSIEN,3,HIN,0),U,1)
. S N=0
. F S N=$O(^HLB(MSIEN,3,HIN,N)) Q:'N S MSH=MSH_$G(^HLB(MSIEN,3,HIN,N))
. S CNT=CNT+1,^BQIHL7($J,CNT)=MSH
. S N=0
. F S N=$O(^HLA(BDIEN,2,GRP,1,N)) Q:'N D
.. I ^HLA(BDIEN,2,GRP,1,N,0)="" Q
.. S CNT=CNT+1,^BQIHL7($J,CNT)=^HLA(BDIEN,2,GRP,1,N,0)
Q
;
BEG ; Begin message
S PARMS("EVENT")="A08"
S PARMS("MESSAGE TYPE")="ADT"
I '$$ADDMSG^HLOAPI(.HLMSTATE,.PARMS,.ERROR) D Q
. ;
S HLFS=HLMSTATE("HDR","FIELD SEPARATOR")
S HLECH=HLMSTATE("HDR","ENCODING CHARACTERS")
;
D SET^HLOAPI(.SEG,"EVN",0)
D SET^HLOAPI(.SEG,"A08",1)
D SET^HLOAPI(.SEG,$$HLDATE^HLFNC($$NOW^XLFDT(),"TS"),2)
I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) Q
Q
;
SEG ; For each record, create the segments
;PID
D SET^HLOAPI(.SEG,"PID",0)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,1),2)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,2),3)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,3),6)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,4),7)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,7),11,1)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,8),11,3)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,9),11,4)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,10),11,5)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,11),11,9)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,12),11,8)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,13),10)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,14),22)
S X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
;PV1
D SET^HLOAPI(.SEG,"PV1",0)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,15),3)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,16),44)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,17),19)
S X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
;DG1
D SET^HLOAPI(.SEG,"DG1",0)
D SET^HLOAPI(.SEG,1,1)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,18),3,1)
NEW CODE,SYS,CSY
I $$VERSION^XPDUTL("AICD")<4.0 D
. S SYS=1
I $$VERSION^XPDUTL("AICD")>3.51 D
. S CODE=$P(RECORD,DELIM,18),SYS=$P($$CODECS^ICDEX(CODE,80),"^",1)
S CSY=$S(SYS=30:"I10",1:"I9")
D SET^HLOAPI(.SEG,CSY,3,3)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,19),3,5)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,20),3,6)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,21),3,4)
S X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
;OBX
NEW INC,VALUE
S INC=0
I $P(RECORD,DELIM,23)'="" D
. S INC=INC+1
. D SET^HLOAPI(.SEG,"OBX",0)
. D SET^HLOAPI(.SEG,INC,1)
. D SET^HLOAPI(.SEG,"ST",2)
. D SET^HLOAPI(.SEG,"TMP",3)
. D SET^HLOAPI(.SEG,$P(RECORD,DELIM,23),5)
. D SET^HLOAPI(.SEG,"R",11)
. S X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG,.ERR)
I $P(RECORD,DELIM,24)'="" D
. S VALUE=$P(RECORD,DELIM,24)
. F BJ=1:1:$L(VALUE,";") D
.. S TYP=$P(VALUE,";",BJ)
.. S INC=INC+1
.. S MEAS=$P(TYP,"=",1),RESULT=$P(TYP,"=",2)
.. D SET^HLOAPI(.SEG,"OBX",0)
.. D SET^HLOAPI(.SEG,INC,1)
.. D SET^HLOAPI(.SEG,"ST",2)
.. D SET^HLOAPI(.SEG,MEAS,3)
.. D SET^HLOAPI(.SEG,RESULT,5)
.. D SET^HLOAPI(.SEG,"R",11)
.. S X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG,.ERR)
I $P(RECORD,DELIM,25)'="" D
. S INC=INC+1
. D SET^HLOAPI(.SEG,"OBX",0)
. D SET^HLOAPI(.SEG,INC,1)
. D SET^HLOAPI(.SEG,"CE",2)
. S VALUE=$P(RECORD,DELIM,25,26)
. NEW LAB,RES
. S RES=$P(VALUE,"^",3),RESULT=$P(RES,"=",2)
. S LAB=$P(VALUE,"^",1,2)_"^"_$P(RES,"=",1)_"^"_$P(VALUE,"^",4,5)
. S LAB=$$TKO^BQIUL1(LAB,DELIM)
. ;S LAB=$P(VALUE,"=",1),RESULT=$P(VALUE,"=",2)
. S RESULT=$$TKO^BQIUL1(RESULT,DELIM)
. D SET^HLOAPI(.SEG,$P(LAB,"^",1),3,1)
. D SET^HLOAPI(.SEG,$P(LAB,"^",2),3,2)
. D SET^HLOAPI(.SEG,$P(LAB,"^",3),3,3)
. D SET^HLOAPI(.SEG,$P(LAB,"^",5),3,5)
. D SET^HLOAPI(.SEG,RESULT,5)
. D SET^HLOAPI(.SEG,"R",11)
. I $P(RECORD,DELIM,31)'="" D
.. S VALUE=$P(RECORD,DELIM,31)
.. D SET^HLOAPI(.SEG,VALUE,6,1)
.. D SET^HLOAPI(.SEG,VALUE,6,2)
.. D SET^HLOAPI(.SEG,"L",6,3)
. I $P(RECORD,DELIM,32)'="" D
.. S VALUE=$P(RECORD,DELIM,32)
.. NEW L,H
.. S L=$P(VALUE,"^",1),H=$P(VALUE,"^",2)
.. I L'="",H'="" D SET^HLOAPI(.SEG,L_"-"_H,7) Q
.. I L'="",H="" D
... I L'?.N D SET^HLOAPI(.SEG,L,7) Q
... D SET^HLOAPI(.SEG,">"_L,7)
.. I L="",H'="" D SET^HLOAPI(.SEG,"<"_H,7)
. I $P(RECORD,DELIM,33)'="" D
.. S VALUE=$P(RECORD,DELIM,33)
.. I VALUE'["*" D SET^HLOAPI(.SEG,VALUE,8) Q
.. D SET^HLOAPI(.SEG,$S(VALUE["H":"HH",1:"LL"),8)
. S X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG,.ERR)
; NTE
I $P(RECORD,DELIM,30)'="" D
. NEW FILE,RIEN,VALUE,COMM,I
. S VALUE=$P(RECORD,DELIM,30)
. S FILE=$P(VALUE,":",1),RIEN=$P(VALUE,":",2)
. I FILE=9000010.25 D
.. F I=1:1:3 S COMM=$P($G(^AUPNVMIC(RIEN,13)),U,I) I COMM'="" D
... D SET^HLOAPI(.SEG,"NTE",0)
... D SET^HLOAPI(.SEG,I,1)
... D SET^HLOAPI(.SEG,COMM,3)
... S X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG,.ERR)
. I FILE=9000010.09 D
.. S I=0
.. F S I=$O(^AUPNVLAB(RIEN,21,I)) Q:'I D
... S COMM=^AUPNVLAB(RIEN,21,I,0)
... D SET^HLOAPI(.SEG,"NTE",0)
... D SET^HLOAPI(.SEG,I,1)
... D SET^HLOAPI(.SEG,COMM,3)
... S X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG,.ERR)
. S X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
;ZID
D SET^HLOAPI(.SEG,"ZID",0)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,5),1,1)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,6),1,2)
S X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
;ZLI
NEW VER,PTCH,VERSION
S VER=$$VERSION^XPDUTL("BQI")
S PTCH=$$LAST^XPDUTL("ICARE MANAGEMENT SYSTEM",VER)
S VERSION=VER_$S($P(PTCH,U,1)'=-1:"P"_$P(PTCH,U,1),1:"")
D SET^HLOAPI(.SEG,"ZLI",0)
D SET^HLOAPI(.SEG,$P(RECORD,DELIM,22),3)
D SET^HLOAPI(.SEG,VERSION,10)
S X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
Q
;
AACK ; Application Acknowledgement
Q
;
CACK ; Commit Acknowledgement
Q
BQICAHLO ;VNGT/HS/ALA-HL7 for CANES Export ; 08 Nov 2010 2:09 PM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
+2 ;
EN ;EP
+1 NEW APPARMS,PARMS,IN,RECORD,ERR,ERROR,WHO,HLMSTATE,MSIEN,BDIEN,CNT,HIN,HLFS,HLECH
+2 NEW MSH,SEG,VISIT,GRP
+3 KILL ^BQIHL7($JOB)
+4 ; Start the batch segment
+5 SET APPARMS("COUNTRY")="USA"
+6 SET APPARMS("FIELD SEPARATOR")="|"
+7 SET APPARMS("ENCODING CHARACTERS")="^~\&"
+8 SET APPARMS("VERSION")="2.5"
+9 IF '$$NEWBATCH^HLOAPI(.APPARMS,.HLMSTATE,.ERROR)
QUIT
+10 ;
+11 IF $ORDER(^BQIDATA($JOB,0))'=""
Begin DoDot:1
+12 SET IN=0
+13 FOR
SET IN=$ORDER(^BQIDATA($JOB,IN))
IF IN=""
QUIT
Begin DoDot:2
+14 DO BEG
+15 SET RECORD=^BQIDATA($JOB,IN)
+16 SET VISIT=$PIECE(RECORD,DELIM,17)
+17 DO SEG
End DoDot:2
End DoDot:1
+18 ;
+19 IF $ORDER(^BQIDATA($JOB,0))=""
DO BEG
+20 ;
+21 IF '$DATA(ERR)
Begin DoDot:1
+22 ; Define sending and receiving parameters
+23 SET APPARMS("SENDING APPLICATION")="RPMS-CANES"
+24 ;Commit ACK type
SET APPARMS("ACCEPT ACK TYPE")="AL"
+25 ;Callback when 'application ACK' is received
SET APPARMS("APP ACK RESPONSE")="AACK^BQICAHLO"
+26 ;Callback when 'commit ACK' is received
SET APPARMS("ACCEPT ACK RESPONSE")="CACK^BQICAHLO"
+27 ;Application ACK type
SET APPARMS("APP ACK TYPE")="AL"
+28 ;Incoming QUEUE
SET APPARMS("QUEUE")="CANES ADT"
+29 SET WHO("RECEIVING APPLICATION")="CDC"
+30 SET WHO("FACILITY LINK NAME")="CANES"
+31 IF '$$SENDONE^HLOAPI1(.HLMSTATE,.APPARMS,.WHO,.ERROR)
Begin DoDot:2
+32 SET ERR=$GET(ERROR)
End DoDot:2
End DoDot:1
+33 ;
+34 ; Set up HL7 messages in global for flat file export
+35 SET MSIEN=$GET(HLMSTATE("IEN"))
+36 IF MSIEN=""
QUIT
+37 SET CNT=0
+38 SET BDIEN=$PIECE($GET(^HLB(MSIEN,0)),U,2)
IF BDIEN=""
QUIT
+39 SET HIN=0
+40 FOR
SET HIN=$ORDER(^HLB(MSIEN,3,HIN))
IF 'HIN
QUIT
Begin DoDot:1
+41 SET MSH=""
+42 SET GRP=$PIECE(^HLB(MSIEN,3,HIN,0),U,1)
+43 SET N=0
+44 FOR
SET N=$ORDER(^HLB(MSIEN,3,HIN,N))
IF 'N
QUIT
SET MSH=MSH_$GET(^HLB(MSIEN,3,HIN,N))
+45 SET CNT=CNT+1
SET ^BQIHL7($JOB,CNT)=MSH
+46 SET N=0
+47 FOR
SET N=$ORDER(^HLA(BDIEN,2,GRP,1,N))
IF 'N
QUIT
Begin DoDot:2
+48 IF ^HLA(BDIEN,2,GRP,1,N,0)=""
QUIT
+49 SET CNT=CNT+1
SET ^BQIHL7($JOB,CNT)=^HLA(BDIEN,2,GRP,1,N,0)
End DoDot:2
End DoDot:1
+50 QUIT
+51 ;
BEG ; Begin message
+1 SET PARMS("EVENT")="A08"
+2 SET PARMS("MESSAGE TYPE")="ADT"
+3 IF '$$ADDMSG^HLOAPI(.HLMSTATE,.PARMS,.ERROR)
Begin DoDot:1
+4 ;
End DoDot:1
QUIT
+5 SET HLFS=HLMSTATE("HDR","FIELD SEPARATOR")
+6 SET HLECH=HLMSTATE("HDR","ENCODING CHARACTERS")
+7 ;
+8 DO SET^HLOAPI(.SEG,"EVN",0)
+9 DO SET^HLOAPI(.SEG,"A08",1)
+10 DO SET^HLOAPI(.SEG,$$HLDATE^HLFNC($$NOW^XLFDT(),"TS"),2)
+11 IF '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
QUIT
+12 QUIT
+13 ;
SEG ; For each record, create the segments
+1 ;PID
+2 DO SET^HLOAPI(.SEG,"PID",0)
+3 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,1),2)
+4 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,2),3)
+5 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,3),6)
+6 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,4),7)
+7 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,7),11,1)
+8 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,8),11,3)
+9 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,9),11,4)
+10 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,10),11,5)
+11 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,11),11,9)
+12 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,12),11,8)
+13 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,13),10)
+14 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,14),22)
+15 SET X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
+16 ;PV1
+17 DO SET^HLOAPI(.SEG,"PV1",0)
+18 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,15),3)
+19 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,16),44)
+20 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,17),19)
+21 SET X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
+22 ;DG1
+23 DO SET^HLOAPI(.SEG,"DG1",0)
+24 DO SET^HLOAPI(.SEG,1,1)
+25 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,18),3,1)
+26 NEW CODE,SYS,CSY
+27 IF $$VERSION^XPDUTL("AICD")<4.0
Begin DoDot:1
+28 SET SYS=1
End DoDot:1
+29 IF $$VERSION^XPDUTL("AICD")>3.51
Begin DoDot:1
+30 SET CODE=$PIECE(RECORD,DELIM,18)
SET SYS=$PIECE($$CODECS^ICDEX(CODE,80),"^",1)
End DoDot:1
+31 SET CSY=$SELECT(SYS=30:"I10",1:"I9")
+32 DO SET^HLOAPI(.SEG,CSY,3,3)
+33 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,19),3,5)
+34 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,20),3,6)
+35 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,21),3,4)
+36 SET X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
+37 ;OBX
+38 NEW INC,VALUE
+39 SET INC=0
+40 IF $PIECE(RECORD,DELIM,23)'=""
Begin DoDot:1
+41 SET INC=INC+1
+42 DO SET^HLOAPI(.SEG,"OBX",0)
+43 DO SET^HLOAPI(.SEG,INC,1)
+44 DO SET^HLOAPI(.SEG,"ST",2)
+45 DO SET^HLOAPI(.SEG,"TMP",3)
+46 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,23),5)
+47 DO SET^HLOAPI(.SEG,"R",11)
+48 SET X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG,.ERR)
End DoDot:1
+49 IF $PIECE(RECORD,DELIM,24)'=""
Begin DoDot:1
+50 SET VALUE=$PIECE(RECORD,DELIM,24)
+51 FOR BJ=1:1:$LENGTH(VALUE,";")
Begin DoDot:2
+52 SET TYP=$PIECE(VALUE,";",BJ)
+53 SET INC=INC+1
+54 SET MEAS=$PIECE(TYP,"=",1)
SET RESULT=$PIECE(TYP,"=",2)
+55 DO SET^HLOAPI(.SEG,"OBX",0)
+56 DO SET^HLOAPI(.SEG,INC,1)
+57 DO SET^HLOAPI(.SEG,"ST",2)
+58 DO SET^HLOAPI(.SEG,MEAS,3)
+59 DO SET^HLOAPI(.SEG,RESULT,5)
+60 DO SET^HLOAPI(.SEG,"R",11)
+61 SET X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG,.ERR)
End DoDot:2
End DoDot:1
+62 IF $PIECE(RECORD,DELIM,25)'=""
Begin DoDot:1
+63 SET INC=INC+1
+64 DO SET^HLOAPI(.SEG,"OBX",0)
+65 DO SET^HLOAPI(.SEG,INC,1)
+66 DO SET^HLOAPI(.SEG,"CE",2)
+67 SET VALUE=$PIECE(RECORD,DELIM,25,26)
+68 NEW LAB,RES
+69 SET RES=$PIECE(VALUE,"^",3)
SET RESULT=$PIECE(RES,"=",2)
+70 SET LAB=$PIECE(VALUE,"^",1,2)_"^"_$PIECE(RES,"=",1)_"^"_$PIECE(VALUE,"^",4,5)
+71 SET LAB=$$TKO^BQIUL1(LAB,DELIM)
+72 ;S LAB=$P(VALUE,"=",1),RESULT=$P(VALUE,"=",2)
+73 SET RESULT=$$TKO^BQIUL1(RESULT,DELIM)
+74 DO SET^HLOAPI(.SEG,$PIECE(LAB,"^",1),3,1)
+75 DO SET^HLOAPI(.SEG,$PIECE(LAB,"^",2),3,2)
+76 DO SET^HLOAPI(.SEG,$PIECE(LAB,"^",3),3,3)
+77 DO SET^HLOAPI(.SEG,$PIECE(LAB,"^",5),3,5)
+78 DO SET^HLOAPI(.SEG,RESULT,5)
+79 DO SET^HLOAPI(.SEG,"R",11)
+80 IF $PIECE(RECORD,DELIM,31)'=""
Begin DoDot:2
+81 SET VALUE=$PIECE(RECORD,DELIM,31)
+82 DO SET^HLOAPI(.SEG,VALUE,6,1)
+83 DO SET^HLOAPI(.SEG,VALUE,6,2)
+84 DO SET^HLOAPI(.SEG,"L",6,3)
End DoDot:2
+85 IF $PIECE(RECORD,DELIM,32)'=""
Begin DoDot:2
+86 SET VALUE=$PIECE(RECORD,DELIM,32)
+87 NEW L,H
+88 SET L=$PIECE(VALUE,"^",1)
SET H=$PIECE(VALUE,"^",2)
+89 IF L'=""
IF H'=""
DO SET^HLOAPI(.SEG,L_"-"_H,7)
QUIT
+90 IF L'=""
IF H=""
Begin DoDot:3
+91 IF L'?.N
DO SET^HLOAPI(.SEG,L,7)
QUIT
+92 DO SET^HLOAPI(.SEG,">"_L,7)
End DoDot:3
+93 IF L=""
IF H'=""
DO SET^HLOAPI(.SEG,"<"_H,7)
End DoDot:2
+94 IF $PIECE(RECORD,DELIM,33)'=""
Begin DoDot:2
+95 SET VALUE=$PIECE(RECORD,DELIM,33)
+96 IF VALUE'["*"
DO SET^HLOAPI(.SEG,VALUE,8)
QUIT
+97 DO SET^HLOAPI(.SEG,$SELECT(VALUE["H":"HH",1:"LL"),8)
End DoDot:2
+98 SET X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG,.ERR)
End DoDot:1
+99 ; NTE
+100 IF $PIECE(RECORD,DELIM,30)'=""
Begin DoDot:1
+101 NEW FILE,RIEN,VALUE,COMM,I
+102 SET VALUE=$PIECE(RECORD,DELIM,30)
+103 SET FILE=$PIECE(VALUE,":",1)
SET RIEN=$PIECE(VALUE,":",2)
+104 IF FILE=9000010.25
Begin DoDot:2
+105 FOR I=1:1:3
SET COMM=$PIECE($GET(^AUPNVMIC(RIEN,13)),U,I)
IF COMM'=""
Begin DoDot:3
+106 DO SET^HLOAPI(.SEG,"NTE",0)
+107 DO SET^HLOAPI(.SEG,I,1)
+108 DO SET^HLOAPI(.SEG,COMM,3)
+109 SET X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG,.ERR)
End DoDot:3
End DoDot:2
+110 IF FILE=9000010.09
Begin DoDot:2
+111 SET I=0
+112 FOR
SET I=$ORDER(^AUPNVLAB(RIEN,21,I))
IF 'I
QUIT
Begin DoDot:3
+113 SET COMM=^AUPNVLAB(RIEN,21,I,0)
+114 DO SET^HLOAPI(.SEG,"NTE",0)
+115 DO SET^HLOAPI(.SEG,I,1)
+116 DO SET^HLOAPI(.SEG,COMM,3)
+117 SET X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG,.ERR)
End DoDot:3
End DoDot:2
+118 SET X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
End DoDot:1
+119 ;ZID
+120 DO SET^HLOAPI(.SEG,"ZID",0)
+121 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,5),1,1)
+122 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,6),1,2)
+123 SET X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
+124 ;ZLI
+125 NEW VER,PTCH,VERSION
+126 SET VER=$$VERSION^XPDUTL("BQI")
+127 SET PTCH=$$LAST^XPDUTL("ICARE MANAGEMENT SYSTEM",VER)
+128 SET VERSION=VER_$SELECT($PIECE(PTCH,U,1)'=-1:"P"_$PIECE(PTCH,U,1),1:"")
+129 DO SET^HLOAPI(.SEG,"ZLI",0)
+130 DO SET^HLOAPI(.SEG,$PIECE(RECORD,DELIM,22),3)
+131 DO SET^HLOAPI(.SEG,VERSION,10)
+132 SET X=$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
+133 QUIT
+134 ;
AACK ; Application Acknowledgement
+1 QUIT
+2 ;
CACK ; Commit Acknowledgement
+1 QUIT
