Routine: BOPT2

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

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

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

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

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

MRG ;EP - Build a merge

 S PRIOR=""

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

BOPT2.m