BOPT2 ;IHS/ILC/ALG/CIA/PLS - ILC Send and Receive (cont);28-Feb-2006 14:42;SM
;;1.0;AUTOMATED DISPENSING INTERFACE;**1**;Jul 26, 2005
;not an entry point
Q
MSH ;EP - Build Header
;set encoding characrters
N MCID,PROCID,VERID,TIME,OUT1
S FLD="|",HLFS="|"
S ENCD="^~\&",HLECH="^~\&"
S COM=$E(ENCD,1)
S REP=$E(ENCD,2)
S ESC=$E(ENCD,3)
S SCOM=$E(ENCD,4)
;GET DATA
S RECAPP=$P($G(^BOP(90355,1,0)),U,3)
S:RECAPP="" RECAPP="AOW-MEDSTN"
S MCID=$P(NODE,"^",7)
S PROCID=$P(NODE,"^",8)
S VERID=$P(NODE,"^",9)
S SNDAPP=RECAPP
S NODE1=$G(^BOP(90355.1,COUNTER,1))
S SITE=$P(NODE1,"^",11)
S TIME=$P(NODE,"^",5)
S TIME=$$HLDATE^HLFNC(TIME),TIME=$P(TIME,"-",1)
S OUT1=$C(11)_"MSH"_FLD_ENCD_FLD_SNDAPP_FLD_SITE_FLD_RECAPP_FLD_FLD_TIME_FLD_FLD_TYPE_COM_ACTION
S OUT1=OUT1_FLD_MCID_FLD_PROCID_FLD_VERID_"|"_$C(13)
S CONT=CONT+1
S OUT(CONT)=OUT1
Q
EVN ;EP - BUILD EVENT SEGMENT
N EVNDT,OUT2
S EVNDT=$P(NODE,"^",3)
S:$P(EVNDT,".",2)=24 $P(EVNDT,".",2)=2359
S EVNDT=$$HLDATE^HLFNC(EVNDT),EVNDT=$P(EVNDT,"-",1)
S OUT2="EVN"_FLD_ACTION_FLD_EVNDT_"|||"_$C(13)
S CONT=CONT+1
S OUT(CONT)=OUT2
Q
PID ;EP - BUILD PID
N PID1,PNAM,BDAY,SEX,RACE,PHH,PHW,PAN,SSN,OUT3,ADR,BOPWHO,X
S PID1=$P(NODE1,"^",2)
S X=$P(NODE1,"^",3)
S PNAM=$$HLNAME^HLFNC(X)
S BDAY=$P(NODE1,"^",4)
I $E(BDAY,4,5)="00" S $E(BDAY,4,5)="01"
I $E(BDAY,6,7)="00" S $E(BDAY,6,7)="01"
S BDAY=$$HLDATE^HLFNC(BDAY),BDAY=$P(BDAY,"-",1)
S SEX=$P(NODE1,"^",5)
S RACE=$P(NODE1,"^",6)
S ADR=$$ADRFIX(NODE1)
S PHH=$P(NODE1,"^",12)
S PHW=$P(NODE1,"^",13)
S PAN=$P(NODE1,"^",14)
S SSN=$P(NODE1,"^",15)
;
; for omnicell
S BOPWHO=$$INTFACE^BOPTU(1) I $G(BOPWHO)="O" S (BDAY,SEX,ADDR,PHH,PHW)=""
S OUT3="PID"_FLD_$G(BOPWHO)_FLD_FLD_PID1_COM_COM_COM_SITE_FLD_FLD_PNAM_FLD_FLD_BDAY ;DUG 2/11/04
S OUT3=OUT3_FLD_SEX_FLD_FLD_FLD_ADR_FLD_FLD_PHH_FLD_PHW_FLD_FLD_FLD_FLD
S OUT3=OUT3_PAN_"|"_$C(13)
S CONT=CONT+1
S OUT(CONT)=OUT3
Q
;
ADRFIX(DATA) ;FIX ADDRESS TO HL7
N ADR1,ADR2,ADR3,ADR4
S ADR1=$P(DATA,"^",7)
S ADR2=$P(DATA,"^",8)
S ADR3=$P(DATA,"^",9)
S ADR4=$P(DATA,"^",10)
Q ADR1_COM_ADR2_COM_ADR3_COM_ADR4
;
PV1 ;EP - Build PV1
N OUT4,PCLSS,LOCAT,LOCAT2,PLOCAT,PDOC,SERV,ACTSAT,ADMTM,BOPWHO
S NODE10=^BOP(90355.1,COUNTER,10)
S PCLSS=$P(NODE10,"^",1)
;
;Location
S LOCAT=$P(NODE10,"^",2)
;
;Room/Bed
S LOCAT2=$P(NODE10,"^",3)
;
S OLDLOC=$P(NODE10,"^",10)
S PTYPE=$P(NODE10,U,11)
;handle room and bed
S X=$P(NODE10,"^",4)
S PDOC=$$HLNAME^HLFNC(X)
; new code for consult doc
S X=$P(NODE10,"^",20)
S CDOC=$$HLNAME^HLFNC(X) S:CDOC'="" CDOC=COM_CDOC
; end of code
S SERV=$P(NODE10,"^",5)
;
;Defaults
I '$G(BOPTYPE) S BOPTPE=0
I $G(BOPITE)="" S BOPITE="AEC"
;
;Here is where location is paired with the room/bed and put into the
;string PLOCAT. PLOCAT is sent across the interface is its structure
;is: plocation ^ proom ^ pbed (as seen by the client)
;BOPTYPE is used for a calculation type
;
;TYPE=2 (Ex: Hines)
;
;The location is sent as the Plocation
;The VISTA room/bed can be in 3 formats: xxx-yyy converted to xxx^yyy
;xxx-yyy-NNNN converted to xxx^yyy or xxx-yyy-N converted to xxxyyy^N
;
I BOPTYPE=2 D
.S LX=LOCAT2,LOCAT=$TR(LOCAT,"-","")
.I $L(LOCAT2,"-")=2 S LX=$P(LOCAT2,"-")_COM_$P(LOCAT2,"-",2)
.I $L(LOCAT2,"-")=3,$P(LOCAT2,"-",3)?4N.N S LX=$P(LOCAT2,"-")_COM_$P(LOCAT2,"-",2)
.I $L(LOCAT2,"-")=3,$P(LOCAT2,"-",3)?1N S LX=$P(LOCAT2,"-")_$P(LOCAT2,"-",2)_COM_$P(LOCAT2,"-",3)
.S PLOCAT=LOCAT_COM_LX_COM_SITE
;
;The following code is for facilities that use the
;NursingUnit-Room-Bed as the format of the Room-Bed field.
I $S(BOPTYPE=1:1,BOPITE["PALO-ALTO":1,1:0) D
.N I,L S PLOCAT=""
.F I=1:1:3 S L=$P(LOCAT2,"-",I) S PLOCAT=PLOCAT_L_COM
.S PLOCAT=PLOCAT_SITE
;
; The following is for sites where the ward location is
; 6DM but the nursing unit is 6D and they want the 6DM to go out to
; remote system
I BOPTYPE=3 S PLOCAT=LOCAT_COM_$P(LOCAT2,"-",2)_COM_$P(LOCAT2,"-",3)_COM_SITE
;
; The following code is for type 4 sites. location room bed ignore '-' piece 3
I BOPTYPE=4 S PLOCAT=LOCAT_COM_$P(LOCAT2,"-")_COM_$P(LOCAT2,"-",2)_COM_SITE
;
;The following code is for the default handling of Nursing Units,
;Rooms and Beds, BOPTYPE=0 (or ""). The Nursing Unit is
;correct and the Room-Bed can be separated as the first and second
;"-" pieces.
I +BOPTYPE=0!(BOPTYPE=5) D
.I BOPTYPE=5,$L(LOCAT2,"-")=3 S LOCAT2=$P(LOCAT2,"-")_$P(LOCAT2,"-",2)
.S PLOCAT=LOCAT_COM_$P(LOCAT2,"-")_COM_$P(LOCAT2,"-",2)_COM_SITE
;
S BFLD="||||||||||"
S ACTSAT=$P(NODE10,"^",8)
S ADMTM=$P(NODE10,"^",6)
S:$P(ADMTM,".",2)=24 $P(ADMTM,".",2)=2359
;DO CHANGE FORMAT TO HL7 TIME
S ADMTM=$$HLDATE^HLFNC(ADMTM),ADMTM=$P(ADMTM,"-",1)
S DISDT=$P(NODE10,"^",7)
S:$P(DISDT,".",2)=24 $P(DISDT,".",2)=2359
S DISDT=$$HLDATE^HLFNC(DISDT),DISDT=$P(DISDT,"-",1)
;
; for omnicell
S BOPWHO=$$INTFACE^BOPTU(1) I $G(BOPWHO)]"" S (SERV,ACTSAT)=""
; S OUT4="PV1"_FLD_FLD_PCLSS_FLD_PLOCAT_FLD_FLD_FLD_COM_OLDLOC_FLD_COM_PDOC_FLD_FLD_FLD_SERV_BFLD_BFLD
S OUT4="PV1"_FLD_FLD_PCLSS_FLD_PLOCAT_FLD_FLD_FLD_COM_OLDLOC_FLD_COM_PDOC_FLD_FLD_CDOC_FLD_SERV_$E(BFLD,1,7)_COM_PDOC_FLD_PTYPE_FLD_BFLD
S OUT4=OUT4_BFLD_ACTSAT_FLD_FLD_FLD_FLD_FLD_ADMTM
S OUT4=OUT4_FLD_DISDT_"|"_$C(13)
S CONT=CONT+1
S OUT(CONT)=OUT4
K OUT4,PCLSS,LOCAT,LOCAT2,PLOCAT,PDOC,SERV,ACTSAT,ADMTM,BOPWHO
Q
MRG ;EP - Build a merge
S PRIOR=""
Q
BOPT2 ;IHS/ILC/ALG/CIA/PLS - ILC Send and Receive (cont);28-Feb-2006 14:42;SM
+1 ;;1.0;AUTOMATED DISPENSING INTERFACE;**1**;Jul 26, 2005
+2 ;not an entry point
+3 QUIT
MSH ;EP - Build Header
+1 ;set encoding characrters
+2 NEW MCID,PROCID,VERID,TIME,OUT1
+3 SET FLD="|"
SET HLFS="|"
+4 SET ENCD="^~\&"
SET HLECH="^~\&"
+5 SET COM=$EXTRACT(ENCD,1)
+6 SET REP=$EXTRACT(ENCD,2)
+7 SET ESC=$EXTRACT(ENCD,3)
+8 SET SCOM=$EXTRACT(ENCD,4)
+9 ;GET DATA
+10 SET RECAPP=$PIECE($GET(^BOP(90355,1,0)),U,3)
+11 IF RECAPP=""
SET RECAPP="AOW-MEDSTN"
+12 SET MCID=$PIECE(NODE,"^",7)
+13 SET PROCID=$PIECE(NODE,"^",8)
+14 SET VERID=$PIECE(NODE,"^",9)
+15 SET SNDAPP=RECAPP
+16 SET NODE1=$GET(^BOP(90355.1,COUNTER,1))
+17 SET SITE=$PIECE(NODE1,"^",11)
+18 SET TIME=$PIECE(NODE,"^",5)
+19 SET TIME=$$HLDATE^HLFNC(TIME)
SET TIME=$PIECE(TIME,"-",1)
+20 SET OUT1=$CHAR(11)_"MSH"_FLD_ENCD_FLD_SNDAPP_FLD_SITE_FLD_RECAPP_FLD_FLD_TIME_FLD_FLD_TYPE_COM_ACTION
+21 SET OUT1=OUT1_FLD_MCID_FLD_PROCID_FLD_VERID_"|"_$CHAR(13)
+22 SET CONT=CONT+1
+23 SET OUT(CONT)=OUT1
+24 QUIT
EVN ;EP - BUILD EVENT SEGMENT
+1 NEW EVNDT,OUT2
+2 SET EVNDT=$PIECE(NODE,"^",3)
+3 IF $PIECE(EVNDT,".",2)=24
SET $PIECE(EVNDT,".",2)=2359
+4 SET EVNDT=$$HLDATE^HLFNC(EVNDT)
SET EVNDT=$PIECE(EVNDT,"-",1)
+5 SET OUT2="EVN"_FLD_ACTION_FLD_EVNDT_"|||"_$CHAR(13)
+6 SET CONT=CONT+1
+7 SET OUT(CONT)=OUT2
+8 QUIT
PID ;EP - BUILD PID
+1 NEW PID1,PNAM,BDAY,SEX,RACE,PHH,PHW,PAN,SSN,OUT3,ADR,BOPWHO,X
+2 SET PID1=$PIECE(NODE1,"^",2)
+3 SET X=$PIECE(NODE1,"^",3)
+4 SET PNAM=$$HLNAME^HLFNC(X)
+5 SET BDAY=$PIECE(NODE1,"^",4)
+6 IF $EXTRACT(BDAY,4,5)="00"
SET $EXTRACT(BDAY,4,5)="01"
+7 IF $EXTRACT(BDAY,6,7)="00"
SET $EXTRACT(BDAY,6,7)="01"
+8 SET BDAY=$$HLDATE^HLFNC(BDAY)
SET BDAY=$PIECE(BDAY,"-",1)
+9 SET SEX=$PIECE(NODE1,"^",5)
+10 SET RACE=$PIECE(NODE1,"^",6)
+11 SET ADR=$$ADRFIX(NODE1)
+12 SET PHH=$PIECE(NODE1,"^",12)
+13 SET PHW=$PIECE(NODE1,"^",13)
+14 SET PAN=$PIECE(NODE1,"^",14)
+15 SET SSN=$PIECE(NODE1,"^",15)
+16 ;
+17 ; for omnicell
+18 SET BOPWHO=$$INTFACE^BOPTU(1)
IF $GET(BOPWHO)="O"
SET (BDAY,SEX,ADDR,PHH,PHW)=""
+19 ;DUG 2/11/04
SET OUT3="PID"_FLD_$GET(BOPWHO)_FLD_FLD_PID1_COM_COM_COM_SITE_FLD_FLD_PNAM_FLD_FLD_BDAY
+20 SET OUT3=OUT3_FLD_SEX_FLD_FLD_FLD_ADR_FLD_FLD_PHH_FLD_PHW_FLD_FLD_FLD_FLD
+21 SET OUT3=OUT3_PAN_"|"_$CHAR(13)
+22 SET CONT=CONT+1
+23 SET OUT(CONT)=OUT3
+24 QUIT
+25 ;
ADRFIX(DATA) ;FIX ADDRESS TO HL7
+1 NEW ADR1,ADR2,ADR3,ADR4
+2 SET ADR1=$PIECE(DATA,"^",7)
+3 SET ADR2=$PIECE(DATA,"^",8)
+4 SET ADR3=$PIECE(DATA,"^",9)
+5 SET ADR4=$PIECE(DATA,"^",10)
+6 QUIT ADR1_COM_ADR2_COM_ADR3_COM_ADR4
+7 ;
PV1 ;EP - Build PV1
+1 NEW OUT4,PCLSS,LOCAT,LOCAT2,PLOCAT,PDOC,SERV,ACTSAT,ADMTM,BOPWHO
+2 SET NODE10=^BOP(90355.1,COUNTER,10)
+3 SET PCLSS=$PIECE(NODE10,"^",1)
+4 ;
+5 ;Location
+6 SET LOCAT=$PIECE(NODE10,"^",2)
+7 ;
+8 ;Room/Bed
+9 SET LOCAT2=$PIECE(NODE10,"^",3)
+10 ;
+11 SET OLDLOC=$PIECE(NODE10,"^",10)
+12 SET PTYPE=$PIECE(NODE10,U,11)
+13 ;handle room and bed
+14 SET X=$PIECE(NODE10,"^",4)
+15 SET PDOC=$$HLNAME^HLFNC(X)
+16 ; new code for consult doc
+17 SET X=$PIECE(NODE10,"^",20)
+18 SET CDOC=$$HLNAME^HLFNC(X)
IF CDOC'=""
SET CDOC=COM_CDOC
+19 ; end of code
+20 SET SERV=$PIECE(NODE10,"^",5)
+21 ;
+22 ;Defaults
+23 IF '$GET(BOPTYPE)
SET BOPTPE=0
+24 IF $GET(BOPITE)=""
SET BOPITE="AEC"
+25 ;
+26 ;Here is where location is paired with the room/bed and put into the
+27 ;string PLOCAT. PLOCAT is sent across the interface is its structure
+28 ;is: plocation ^ proom ^ pbed (as seen by the client)
+29 ;BOPTYPE is used for a calculation type
+30 ;
+31 ;TYPE=2 (Ex: Hines)
+32 ;
+33 ;The location is sent as the Plocation
+34 ;The VISTA room/bed can be in 3 formats: xxx-yyy converted to xxx^yyy
+35 ;xxx-yyy-NNNN converted to xxx^yyy or xxx-yyy-N converted to xxxyyy^N
+36 ;
+37 IF BOPTYPE=2
Begin DoDot:1
+38 SET LX=LOCAT2
SET LOCAT=$TRANSLATE(LOCAT,"-","")
+39 IF $LENGTH(LOCAT2,"-")=2
SET LX=$PIECE(LOCAT2,"-")_COM_$PIECE(LOCAT2,"-",2)
+40 IF $LENGTH(LOCAT2,"-")=3
IF $PIECE(LOCAT2,"-",3)?4N.N
SET LX=$PIECE(LOCAT2,"-")_COM_$PIECE(LOCAT2,"-",2)
+41 IF $LENGTH(LOCAT2,"-")=3
IF $PIECE(LOCAT2,"-",3)?1N
SET LX=$PIECE(LOCAT2,"-")_$PIECE(LOCAT2,"-",2)_COM_$PIECE(LOCAT2,"-",3)
+42 SET PLOCAT=LOCAT_COM_LX_COM_SITE
End DoDot:1
+43 ;
+44 ;The following code is for facilities that use the
+45 ;NursingUnit-Room-Bed as the format of the Room-Bed field.
+46 IF $SELECT(BOPTYPE=1:1,BOPITE["PALO-ALTO":1,1:0)
Begin DoDot:1
+47 NEW I,L
SET PLOCAT=""
+48 FOR I=1:1:3
SET L=$PIECE(LOCAT2,"-",I)
SET PLOCAT=PLOCAT_L_COM
+49 SET PLOCAT=PLOCAT_SITE
End DoDot:1
+50 ;
+51 ; The following is for sites where the ward location is
+52 ; 6DM but the nursing unit is 6D and they want the 6DM to go out to
+53 ; remote system
+54 IF BOPTYPE=3
SET PLOCAT=LOCAT_COM_$PIECE(LOCAT2,"-",2)_COM_$PIECE(LOCAT2,"-",3)_COM_SITE
+55 ;
+56 ; The following code is for type 4 sites. location room bed ignore '-' piece 3
+57 IF BOPTYPE=4
SET PLOCAT=LOCAT_COM_$PIECE(LOCAT2,"-")_COM_$PIECE(LOCAT2,"-",2)_COM_SITE
+58 ;
+59 ;The following code is for the default handling of Nursing Units,
+60 ;Rooms and Beds, BOPTYPE=0 (or ""). The Nursing Unit is
+61 ;correct and the Room-Bed can be separated as the first and second
+62 ;"-" pieces.
+63 IF +BOPTYPE=0!(BOPTYPE=5)
Begin DoDot:1
+64 IF BOPTYPE=5
IF $LENGTH(LOCAT2,"-")=3
SET LOCAT2=$PIECE(LOCAT2,"-")_$PIECE(LOCAT2,"-",2)
+65 SET PLOCAT=LOCAT_COM_$PIECE(LOCAT2,"-")_COM_$PIECE(LOCAT2,"-",2)_COM_SITE
End DoDot:1
+66 ;
+67 SET BFLD="||||||||||"
+68 SET ACTSAT=$PIECE(NODE10,"^",8)
+69 SET ADMTM=$PIECE(NODE10,"^",6)
+70 IF $PIECE(ADMTM,".",2)=24
SET $PIECE(ADMTM,".",2)=2359
+71 ;DO CHANGE FORMAT TO HL7 TIME
+72 SET ADMTM=$$HLDATE^HLFNC(ADMTM)
SET ADMTM=$PIECE(ADMTM,"-",1)
+73 SET DISDT=$PIECE(NODE10,"^",7)
+74 IF $PIECE(DISDT,".",2)=24
SET $PIECE(DISDT,".",2)=2359
+75 SET DISDT=$$HLDATE^HLFNC(DISDT)
SET DISDT=$PIECE(DISDT,"-",1)
+76 ;
+77 ; for omnicell
+78 SET BOPWHO=$$INTFACE^BOPTU(1)
IF $GET(BOPWHO)]""
SET (SERV,ACTSAT)=""
+79 ; S OUT4="PV1"_FLD_FLD_PCLSS_FLD_PLOCAT_FLD_FLD_FLD_COM_OLDLOC_FLD_COM_PDOC_FLD_FLD_FLD_SERV_BFLD_BFLD
+80 SET OUT4="PV1"_FLD_FLD_PCLSS_FLD_PLOCAT_FLD_FLD_FLD_COM_OLDLOC_FLD_COM_PDOC_FLD_FLD_CDOC_FLD_SERV_$EXTRACT(BFLD,1,7)_COM_PDOC_FLD_PTYPE_FLD_BFLD
+81 SET OUT4=OUT4_BFLD_ACTSAT_FLD_FLD_FLD_FLD_FLD_ADMTM
+82 SET OUT4=OUT4_FLD_DISDT_"|"_$CHAR(13)
+83 SET CONT=CONT+1
+84 SET OUT(CONT)=OUT4
+85 KILL OUT4,PCLSS,LOCAT,LOCAT2,PLOCAT,PDOC,SERV,ACTSAT,ADMTM,BOPWHO
+86 QUIT
MRG ;EP - Build a merge
+1 SET PRIOR=""
+2 QUIT
