ALPBCBU ;OIFO-DALLAS/SED/KC/MW BCMA-BCBU INPT TO HL7 ;5/2/2002
;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
;This is the main routine for the BCBU software.
;It handles all the entries points for the BCBU software.
;It also handles error checking.
IPH(ALPMSG) ;CAPTURE MESSAGE ARRAY FROM PHARMACY
N ALPRSLT
Q:'$D(ALPMSG)
;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL
Q:+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLINE",1,"Q")'>0
S ALPRSLT=$$IPH^ALPBINP(.ALPMSG)
;I $P(ALPRSLT,U,2)'="" D ERRLG
Q
MEDL(ALPML) ;Use this entry to send MedLog messages
N ALPRSLT
;ALPML is the IEN of the MedLog for file #53.79
Q:'$D(ALPML)
;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL
Q:+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLINE",1,"Q")'>0
S ALPRSLT=$$MEDL^ALPBINP(ALPML)
I $P(ALPRSLT,U,2)'="" D ERRLG
Q
NURV(ALDFN,ALPORD) ;Use this entry to send verifying nursing.
N ALPRSLT
;ALDFN is the IEN of the patient
;ALPORDR is the order number
Q:'$D(ALDFN)
Q:'$D(ALPORD)
;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL
Q:+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLINE",1,"Q")'>0
K ALPB
D EN^PSJBCBU(ALDFN,ALPORD,.ALPB)
S ALPBI=0
F S ALPBI=$O(ALPB(ALPBI)) Q:ALPBI'>0 D
. I $E(ALPB(ALPBI),1,3)="MSH" S MSH=ALPBI
. I $E(ALPB(ALPBI),1,3)="PID" S PID=ALPBI
. I $E(ALPB(ALPBI),1,3)="PV1" S PV1=ALPBI
. I $E(ALPB(ALPBI),1,3)="ORC" S ORC=ALPBI
I +$G(MSH)'>0 Q ;MISSING MSH SEGMENT BAD MESSAGE
S MSCTR=$E(ALPB(MSH),4,8)
S ALPRSLT=$$INI^ALPBINP()
;I $P(ALPRSLT,U,2)'="" D ERRLG
K ALPB,ALPBI
Q
PMOV ;Entry Point to send patient movement
N ALPRSLT
;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL
Q:+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLINE",1,"Q")'>0
Q:'$D(DFN)!'$D(DGPMTYP)!'$D(DGPMUC)
;Screen out Lodgers
Q:DGPMUC["LODGER"
S ALPRSLT=$$PMOV^ALPBINP(DFN,DGPMTYP,DGPMUC,$P($G(DGPMA),U))
I $P(ALPRSLT,U,2)'="" D ERRLG
Q
ERRLG ;Error Log Message
;Alert
K XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLAG
S XQA("G.PSB BCBU ERRORS")=""
S XQAMSG="BCBU Contingency Error"
S XQADATA=ALPRSLT
S XQAROU="PERR^ALPBCBU"
;S XQAOPT="PSB BCBU ERROR LOG"
;S ALPBFERR("DIERR",1)=9999
;I $D(ALPMSG) M ALPBFERR("DIERR",1,"TEXT")=ALPMSG
;D ERRLOG^ALPBUTL1(9999,0,0,$P(XQADATA,U,2),$P(XQADATA,U,3),.ALPBFERR)
D SETUP^XQALERT
Q
PERR ;Process the error
W @IOF,!,"PSB BCBU Contingency Error",!
W ?10,$P(XQADATA,U,2)_" / "_$P(XQADATA,U,3)
Q
ALPBCBU ;OIFO-DALLAS/SED/KC/MW BCMA-BCBU INPT TO HL7 ;5/2/2002
+1 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
+2 ;This is the main routine for the BCBU software.
+3 ;It handles all the entries points for the BCBU software.
+4 ;It also handles error checking.
IPH(ALPMSG) ;CAPTURE MESSAGE ARRAY FROM PHARMACY
+1 NEW ALPRSLT
+2 IF '$DATA(ALPMSG)
QUIT
+3 ;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL
+4 IF +$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLINE",1,"Q")'>0
QUIT
+5 SET ALPRSLT=$$IPH^ALPBINP(.ALPMSG)
+6 ;I $P(ALPRSLT,U,2)'="" D ERRLG
+7 QUIT
MEDL(ALPML) ;Use this entry to send MedLog messages
+1 NEW ALPRSLT
+2 ;ALPML is the IEN of the MedLog for file #53.79
+3 IF '$DATA(ALPML)
QUIT
+4 ;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL
+5 IF +$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLINE",1,"Q")'>0
QUIT
+6 SET ALPRSLT=$$MEDL^ALPBINP(ALPML)
+7 IF $PIECE(ALPRSLT,U,2)'=""
DO ERRLG
+8 QUIT
NURV(ALDFN,ALPORD) ;Use this entry to send verifying nursing.
+1 NEW ALPRSLT
+2 ;ALDFN is the IEN of the patient
+3 ;ALPORDR is the order number
+4 IF '$DATA(ALDFN)
QUIT
+5 IF '$DATA(ALPORD)
QUIT
+6 ;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL
+7 IF +$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLINE",1,"Q")'>0
QUIT
+8 KILL ALPB
+9 DO EN^PSJBCBU(ALDFN,ALPORD,.ALPB)
+10 SET ALPBI=0
+11 FOR
SET ALPBI=$ORDER(ALPB(ALPBI))
IF ALPBI'>0
QUIT
Begin DoDot:1
+12 IF $EXTRACT(ALPB(ALPBI),1,3)="MSH"
SET MSH=ALPBI
+13 IF $EXTRACT(ALPB(ALPBI),1,3)="PID"
SET PID=ALPBI
+14 IF $EXTRACT(ALPB(ALPBI),1,3)="PV1"
SET PV1=ALPBI
+15 IF $EXTRACT(ALPB(ALPBI),1,3)="ORC"
SET ORC=ALPBI
End DoDot:1
+16 ;MISSING MSH SEGMENT BAD MESSAGE
IF +$GET(MSH)'>0
QUIT
+17 SET MSCTR=$EXTRACT(ALPB(MSH),4,8)
+18 SET ALPRSLT=$$INI^ALPBINP()
+19 ;I $P(ALPRSLT,U,2)'="" D ERRLG
+20 KILL ALPB,ALPBI
+21 QUIT
PMOV ;Entry Point to send patient movement
+1 NEW ALPRSLT
+2 ;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL
+3 IF +$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLINE",1,"Q")'>0
QUIT
+4 IF '$DATA(DFN)!'$DATA(DGPMTYP)!'$DATA(DGPMUC)
QUIT
+5 ;Screen out Lodgers
+6 IF DGPMUC["LODGER"
QUIT
+7 SET ALPRSLT=$$PMOV^ALPBINP(DFN,DGPMTYP,DGPMUC,$PIECE($GET(DGPMA),U))
+8 IF $PIECE(ALPRSLT,U,2)'=""
DO ERRLG
+9 QUIT
ERRLG ;Error Log Message
+1 ;Alert
+2 KILL XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLAG
+3 SET XQA("G.PSB BCBU ERRORS")=""
+4 SET XQAMSG="BCBU Contingency Error"
+5 SET XQADATA=ALPRSLT
+6 SET XQAROU="PERR^ALPBCBU"
+7 ;S XQAOPT="PSB BCBU ERROR LOG"
+8 ;S ALPBFERR("DIERR",1)=9999
+9 ;I $D(ALPMSG) M ALPBFERR("DIERR",1,"TEXT")=ALPMSG
+10 ;D ERRLOG^ALPBUTL1(9999,0,0,$P(XQADATA,U,2),$P(XQADATA,U,3),.ALPBFERR)
+11 DO SETUP^XQALERT
+12 QUIT
PERR ;Process the error
+1 WRITE @IOF,!,"PSB BCBU Contingency Error",!
+2 WRITE ?10,$PIECE(XQADATA,U,2)_" / "_$PIECE(XQADATA,U,3)
+3 QUIT
