Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ALPBCBU

ALPBCBU.m

Go to the documentation of this file.
ALPBCBU ;OIFO-DALLAS/SED/KC/MW  BCMA-BCBU INPT TO HL7 ;5/2/2002
 ;;3.0;BAR CODE MED ADMIN;**8,102,105,110**;Mar 2004;Build 3
 ;
 ; Reference/IA
 ; EN^PSJBCBU/3876
 ;
 ;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,HL,HLA,HLECH,HLQ
 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()
 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
 ; Retrieving the Patient's division name to include on the alert
 N ALPDFN,ALPDIV,ALPDIVST,ALPINST
 S ALPDIVST=""
 S ALPDFN=+$P($G(^PSB(53.79,+$G(ALPML),0)),U,1)
 ;If Patient Movement (not discharge), checking if the patient is still admitted, if not, QUIT
 I $D(DGPMTYP),'$G(PSJDCA) D INP^VADPT I '$P($G(VAIN(4)),"^") Q
 ; If Patient is deceased don't generate alert
 I $$DECEASED(ALPDFN) Q
 I ALPDFN>0 D
 . S ALPDIV=$$DIV^ALPBUTL1(ALPDFN,0)
 . I 'ALPDIV,$G(ALPML) S ALPDIV=$$CDIV^ALPBINP(ALPML)
 . S ALPDIVST=$$GET1^DIQ(40.8,ALPDIV,1)
 I ALPDIVST="" S ALPINST=+$$GET1^DIQ(53.79,+$G(ALPML),.03,"I"),ALPDIVST=$$GET1^DIQ(4,ALPINST,99)
 ;Alert
 K XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLAG
 S XQA("G.PSB BCBU ERRORS")=""
 S XQAMSG="BCBU Contingency Error"_$S(ALPDIVST:" / Site: "_ALPDIVST,1:"")_$S(ALPDFN:" / DFN: "_ALPDFN,1:"")
 S XQADATA=ALPRSLT
 S XQAROU="PERR^ALPBCBU"
 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
 ;
DECEASED(DFN) ; Patient Deceased?
 ; Return: 1 (YES) or 0 (NO)
 N VADM
 D DEM^VADPT
 Q $S('$G(VADM(6)):0,1:1)