| 1 | ALPBCBU ;OIFO-DALLAS/SED/KC/MW BCMA-BCBU INPT TO HL7 ;5/2/2002
|
|---|
| 2 | ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
|
|---|
| 3 | ;This is the main routine for the BCBU software.
|
|---|
| 4 | ;It handles all the entries points for the BCBU software.
|
|---|
| 5 | ;It also handles error checking.
|
|---|
| 6 | IPH(ALPMSG) ;CAPTURE MESSAGE ARRAY FROM PHARMACY
|
|---|
| 7 | N ALPRSLT
|
|---|
| 8 | Q:'$D(ALPMSG)
|
|---|
| 9 | ;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL
|
|---|
| 10 | Q:+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLINE",1,"Q")'>0
|
|---|
| 11 | S ALPRSLT=$$IPH^ALPBINP(.ALPMSG)
|
|---|
| 12 | ;I $P(ALPRSLT,U,2)'="" D ERRLG
|
|---|
| 13 | Q
|
|---|
| 14 | MEDL(ALPML) ;Use this entry to send MedLog messages
|
|---|
| 15 | N ALPRSLT
|
|---|
| 16 | ;ALPML is the IEN of the MedLog for file #53.79
|
|---|
| 17 | Q:'$D(ALPML)
|
|---|
| 18 | ;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL
|
|---|
| 19 | Q:+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLINE",1,"Q")'>0
|
|---|
| 20 | S ALPRSLT=$$MEDL^ALPBINP(ALPML)
|
|---|
| 21 | I $P(ALPRSLT,U,2)'="" D ERRLG
|
|---|
| 22 | Q
|
|---|
| 23 | NURV(ALDFN,ALPORD) ;Use this entry to send verifying nursing.
|
|---|
| 24 | N ALPRSLT
|
|---|
| 25 | ;ALDFN is the IEN of the patient
|
|---|
| 26 | ;ALPORDR is the order number
|
|---|
| 27 | Q:'$D(ALDFN)
|
|---|
| 28 | Q:'$D(ALPORD)
|
|---|
| 29 | ;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL
|
|---|
| 30 | Q:+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLINE",1,"Q")'>0
|
|---|
| 31 | K ALPB
|
|---|
| 32 | D EN^PSJBCBU(ALDFN,ALPORD,.ALPB)
|
|---|
| 33 | S ALPBI=0
|
|---|
| 34 | F S ALPBI=$O(ALPB(ALPBI)) Q:ALPBI'>0 D
|
|---|
| 35 | . I $E(ALPB(ALPBI),1,3)="MSH" S MSH=ALPBI
|
|---|
| 36 | . I $E(ALPB(ALPBI),1,3)="PID" S PID=ALPBI
|
|---|
| 37 | . I $E(ALPB(ALPBI),1,3)="PV1" S PV1=ALPBI
|
|---|
| 38 | . I $E(ALPB(ALPBI),1,3)="ORC" S ORC=ALPBI
|
|---|
| 39 | I +$G(MSH)'>0 Q ;MISSING MSH SEGMENT BAD MESSAGE
|
|---|
| 40 | S MSCTR=$E(ALPB(MSH),4,8)
|
|---|
| 41 | S ALPRSLT=$$INI^ALPBINP()
|
|---|
| 42 | ;I $P(ALPRSLT,U,2)'="" D ERRLG
|
|---|
| 43 | K ALPB,ALPBI
|
|---|
| 44 | Q
|
|---|
| 45 | PMOV ;Entry Point to send patient movement
|
|---|
| 46 | N ALPRSLT
|
|---|
| 47 | ;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL
|
|---|
| 48 | Q:+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLINE",1,"Q")'>0
|
|---|
| 49 | Q:'$D(DFN)!'$D(DGPMTYP)!'$D(DGPMUC)
|
|---|
| 50 | ;Screen out Lodgers
|
|---|
| 51 | Q:DGPMUC["LODGER"
|
|---|
| 52 | S ALPRSLT=$$PMOV^ALPBINP(DFN,DGPMTYP,DGPMUC,$P($G(DGPMA),U))
|
|---|
| 53 | I $P(ALPRSLT,U,2)'="" D ERRLG
|
|---|
| 54 | Q
|
|---|
| 55 | ERRLG ;Error Log Message
|
|---|
| 56 | ;Alert
|
|---|
| 57 | K XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLAG
|
|---|
| 58 | S XQA("G.PSB BCBU ERRORS")=""
|
|---|
| 59 | S XQAMSG="BCBU Contingency Error"
|
|---|
| 60 | S XQADATA=ALPRSLT
|
|---|
| 61 | S XQAROU="PERR^ALPBCBU"
|
|---|
| 62 | ;S XQAOPT="PSB BCBU ERROR LOG"
|
|---|
| 63 | ;S ALPBFERR("DIERR",1)=9999
|
|---|
| 64 | ;I $D(ALPMSG) M ALPBFERR("DIERR",1,"TEXT")=ALPMSG
|
|---|
| 65 | ;D ERRLOG^ALPBUTL1(9999,0,0,$P(XQADATA,U,2),$P(XQADATA,U,3),.ALPBFERR)
|
|---|
| 66 | D SETUP^XQALERT
|
|---|
| 67 | Q
|
|---|
| 68 | PERR ;Process the error
|
|---|
| 69 | W @IOF,!,"PSB BCBU Contingency Error",!
|
|---|
| 70 | W ?10,$P(XQADATA,U,2)_" / "_$P(XQADATA,U,3)
|
|---|
| 71 | Q
|
|---|
