- 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
