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. 
  1. ALPBCBU ;OIFO-DALLAS/SED/KC/MW  BCMA-BCBU INPT TO HL7 ;Jan 10, 2024@11:10
  1.  ;;3.0;BAR CODE MED ADMIN;**8,102,105,110,146**;Mar 2004;Build 2
  1.  ;
  1.  ; Reference to ^DPT(DFN.,1) in ICR #10035
  1.  ; Reference to EN^PSJBCBU in ICR #3876
  1.  ;
  1.  ;This is the main routine for the BCBU software.
  1.  ;It handles all the entries points for the BCBU software. 
  1.  ;It also handles error checking.
  1. IPH(ALPMSG) ;CAPTURE MESSAGE ARRAY FROM PHARMACY
  1.  N ALPRSLT,HL,HLA,HLECH,HLQ
  1.  Q:'$D(ALPMSG)
  1.  ;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL
  1.  Q:+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLINE",1,"Q")'>0
  1.  S ALPRSLT=$$IPH^ALPBINP(.ALPMSG)
  1.  ;I $P(ALPRSLT,U,2)'="" D ERRLG
  1.  Q
  1. MEDL(ALPML) ;Use this entry to send MedLog messages
  1.  N ALPRSLT
  1.  ;ALPML is the IEN of the MedLog for file #53.79
  1.  Q:'$D(ALPML)
  1.  ;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL
  1.  Q:+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLINE",1,"Q")'>0
  1.  S ALPRSLT=$$MEDL^ALPBINP(ALPML)
  1.  I $P(ALPRSLT,U,2)'="" D ERRLG
  1.  Q
  1. NURV(ALDFN,ALPORD) ;Use this entry to send verifying nursing.
  1.  N ALPRSLT
  1.  ;ALDFN is the IEN of the patient
  1.  ;ALPORDR is the order number
  1.  Q:'$D(ALDFN)
  1.  Q:'$D(ALPORD)
  1.  ;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL
  1.  Q:+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLINE",1,"Q")'>0
  1.  K ALPB
  1.  D EN^PSJBCBU(ALDFN,ALPORD,.ALPB)
  1.  S ALPBI=0
  1.  F  S ALPBI=$O(ALPB(ALPBI)) Q:ALPBI'>0  D
  1.  . I $E(ALPB(ALPBI),1,3)="MSH" S MSH=ALPBI
  1.  . I $E(ALPB(ALPBI),1,3)="PID" S PID=ALPBI
  1.  . I $E(ALPB(ALPBI),1,3)="PV1" S PV1=ALPBI
  1.  . I $E(ALPB(ALPBI),1,3)="ORC" S ORC=ALPBI
  1.  I +$G(MSH)'>0 Q   ;MISSING MSH SEGMENT BAD MESSAGE
  1.  S MSCTR=$E(ALPB(MSH),4,8)
  1.  S ALPRSLT=$$INI^ALPBINP()
  1.  K ALPB,ALPBI
  1.  Q
  1. PMOV ;Entry Point to send patient movement
  1.  N ALPRSLT
  1.  ;CHECK IF BCBU IS ACTIVE AT PACKAGE LEVEL
  1.  Q:+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP ONLINE",1,"Q")'>0
  1.  Q:'$D(DFN)!'$D(DGPMTYP)!'$D(DGPMUC)
  1.  ;Screen out Lodgers
  1.  Q:DGPMUC["LODGER"
  1.  ; PSB*3.0*146: Added line below
  1.  I DGPMUC="DISCHARGE",$G(^DPT(DFN,.1))]"" Q
  1.  S ALPRSLT=$$PMOV^ALPBINP(DFN,DGPMTYP,DGPMUC,$P($G(DGPMA),U))
  1.  I $P(ALPRSLT,U,2)'="" D ERRLG
  1.  Q
  1. ERRLG ;Error Log Message
  1.  ; Retrieving the Patient's division name to include on the alert
  1.  N ALPDFN,ALPDIV,ALPDIVST,ALPINST
  1.  S ALPDIVST=""
  1.  S ALPDFN=+$P($G(^PSB(53.79,+$G(ALPML),0)),U,1)
  1.  ;If Patient Movement (not discharge), checking if the patient is still admitted, if not, QUIT
  1.  I $D(DGPMTYP),'$G(PSJDCA) D INP^VADPT I '$P($G(VAIN(4)),"^") Q
  1.  ; If Patient is deceased don't generate alert
  1.  I $$DECEASED(ALPDFN) Q
  1.  I ALPDFN>0 D
  1.  . S ALPDIV=$$DIV^ALPBUTL1(ALPDFN,0)
  1.  . I 'ALPDIV,$G(ALPML) S ALPDIV=$$CDIV^ALPBINP(ALPML)
  1.  . S ALPDIVST=$$GET1^DIQ(40.8,ALPDIV,1)
  1.  I ALPDIVST="" S ALPINST=+$$GET1^DIQ(53.79,+$G(ALPML),.03,"I"),ALPDIVST=$$GET1^DIQ(4,ALPINST,99)
  1.  ;Alert
  1.  K XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLAG
  1.  S XQA("G.PSB BCBU ERRORS")=""
  1.  S XQAMSG="BCBU Contingency Error"_$S(ALPDIVST:" / Site: "_ALPDIVST,1:"")_$S(ALPDFN:" / DFN: "_ALPDFN,1:"")
  1.  S XQADATA=ALPRSLT
  1.  S XQAROU="PERR^ALPBCBU"
  1.  D SETUP^XQALERT
  1.  Q
  1. PERR ;Process the error
  1.  W @IOF,!,"PSB BCBU Contingency Error",!
  1.  W ?10,$P(XQADATA,U,2)_" / "_$P(XQADATA,U,3)
  1.  Q
  1.  ;
  1. DECEASED(DFN) ; Patient Deceased?
  1.  ; Return: 1 (YES) or 0 (NO)
  1.  N VADM
  1.  D DEM^VADPT
  1.  Q $S('$G(VADM(6)):0,1:1)