- 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
