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

ALPBUTL1.m

Go to the documentation of this file. 
  1. ALPBUTL1 ;OIFO-DALLAS MW,SED,KC-BCBU BACKUP REPORT FUNCTIONS AND UTILITIES  ;01/01/03
  1.  ;;3.0;BAR CODE MED ADMIN;**8,37**;Mar 2004;Build 10
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; Reference/IA
  1.  ; INP^VADPT/10061
  1.  ; DIC(42/10039
  1.  ; DIC(42/2440
  1.  ;
  1. ERRBLD(SEG,MSG,ERR) ; build an error array for non-FileMan-related errors...
  1.  ; SEG = HL7 segment name
  1.  ; MSG = a message that will be used in the error text portion of the array (optional -- if not passed, the
  1.  ;       default will be used)
  1.  ; ERR = array passed by reference in which error will be returned
  1.  ; note:  code 999 is a code indicating a non-FileMan error for filing the error message in file 53.71
  1.  S ERR("DIERR")=1
  1.  S ERR("DIERR",1)=999
  1.  S ERR("DIERR",1,"TEXT",1)=$S($G(MSG)'="":MSG,1:"Invalid parameter passed to "_SEG_" module in routine ALPBHL1U")
  1.  Q
  1.  ;
  1. ERRLOG(IEN,OIEN,MSGREC,SEGNAME,SEGDATA,ERRTEXT) ; log filing errors...
  1.  ; this module logs error data in the BCMA BACKUP PARAMETERS file (53.71).  These
  1.  ; errors usually occur as the result of missing or bad data passed to one of the
  1.  ; File Manager DBS calls used by this package.
  1.  ; 
  1.  ; IEN       = the patient's record number in file 53.7
  1.  ; OIEN      = the order number's sub-file record number in file 53.7
  1.  ; MSGREC    = the HL7 message's record number in file 772
  1.  ; SEGNAME   = the HL7 segment associated with the error (optional)
  1.  ; SEGDATA   = the HL7 segment's data (optional)
  1.  ; ERRTEXT   = an array passed by reference which contains the error
  1.  ;             code (numeric) and the error text to be filed.  It is
  1.  ;             expected that this is usually the error array returned
  1.  ;             from a FileMan DBS call, so the format is specific:
  1.  ;
  1.  ;             ERRTEXT("DIERR",n)=error code (numeric)
  1.  ;             ERRTEXT("DIERR",n,"TEXT",1)=first line of error text
  1.  ;             ERRTEXT("DIERR",n,"TEXT",2)=second line of error text
  1.  ;             ERRTEXT("DIERR",n,"TEXT",n)=last line of error text
  1.  ;
  1.  ;             However, any error message can be passed to this module
  1.  ;             as long as the above format is used.
  1.  N ALPBCODE,ALPBFERR,ALPBFILE,ALPBLOGD,ALPBN1,ALPBN2,ALPBPIEN,ALPBTEXT,ALPBX
  1.  S ALPBLOGD=$$NOW^XLFDT()
  1.  S ALPBPIEN=+$O(^ALPB(53.71,0))
  1.  I ALPBPIEN=0 D
  1.  .S X="ONE"
  1.  .S DIC="^ALPB(53.71,"
  1.  .S DIC(0)="LZ"
  1.  .S DIC("DR")="1///^S X=3"
  1.  .S DINUM=1
  1.  .S DLAYGO=53.71
  1.  .D FILE^DICN K DIC
  1.  .S ALPBPIEN=+Y
  1.  I ALPBPIEN'>0 Q
  1.  S ALPBN1=+$O(^ALPB(53.71,ALPBPIEN,1," "),-1)+1
  1.  S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",.01)=ALPBLOGD
  1.  S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",1)=+$G(IEN)
  1.  S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",2)=+$G(OIEN)
  1.  S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3)=+$G(MSGREC)
  1.  S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3.1)=$G(SEGNAME)
  1.  S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3.2)=$G(SEGDATA)
  1.  D UPDATE^DIE("","ALPBFILE","ALPBN1","ALPBFERR")
  1.  K ALPBFERR,ALPBFILE
  1.  S ALPBX=0
  1.  F  S ALPBX=$O(ERRTEXT("DIERR",ALPBX)) Q:'ALPBX  D
  1.  .S ALPBCODE=ERRTEXT("DIERR",ALPBX)
  1.  .; file the error code...
  1.  .S ALPBN2=+$O(^ALPB(53.71,ALPBPIEN,1,ALPBN1,2," "),-1)+1
  1.  .S ALPBFILE(53.7135,"+"_ALPBN2_","_ALPBN1_","_ALPBPIEN_",",.01)=ALPBCODE
  1.  .D UPDATE^DIE("","ALPBFILE","ALPBN2","ALPBFERR")
  1.  .K ALPBFERR,ALPBFILE
  1.  .; file the error text...
  1.  .M ALPBTEXT=ERRTEXT("DIERR",ALPBX,"TEXT")
  1.  .D WP^DIE(53.7135,ALPBN2_","_ALPBN1_","_ALPBPIEN_",",1,"","ALPBTEXT","ALPBFERR")
  1.  .;S ALPBFILE(53.7135,"+"_ALPBN2_","_ALPBN1_","_ALPBPIEN_",",1)=ALPBTEXT
  1.  .;D UPDATE^DIE("","ALPBFILE","ALPBN2","ALPBFERR")
  1.  .K ALPBCODE,ALPBFERR,ALPBFILE,ALPBN2,ALPBTEXT
  1.  Q
  1.  ;
  1. CLEAN(IEN) ; check error log records to see if the patients' whose records
  1.  ; are noted still exist in file 53.7.  if not, delete the error log
  1.  ; record(s) in file 53.71...
  1.  ; IEN = patient record number in file 53.7
  1.  ; Note:  this function is also called from DELPT^ALPBUTL when a patient's
  1.  ; record is deleted (as a result of a discharge action) from 53.7.
  1.  ;
  1.  N ALPBX,ALPBY,DA,DIK,X,Y
  1.  ; patient still has record in 53.7?  if so, quit...
  1.  I $G(^ALPB(53.7,IEN,0))'="" Q
  1.  S ALPBX=0
  1.  F  S ALPBX=$O(^ALPB(53.71,"C",IEN,ALPBX)) Q:'ALPBX  D
  1.  .S ALPBY=0
  1.  .F  S ALPBY=$O(^ALPB(53.71,"C",IEN,ALPBX,ALPBY)) Q:'ALPBY  D
  1.  ..S DA=ALPBY
  1.  ..S DA(1)=ALPBX
  1.  ..S DIK="^ALPB(53.71,"_DA(1)_",1,"
  1.  ..D ^DIK
  1.  ..K DA,DIK
  1.  .K ALPBY
  1.  K ALPBX
  1.  Q
  1.  ;
  1. DELERR(ERRIEN) ; delete an error log entry from file 53.71...
  1.  ; ERRIEN = error log entry's internal record number
  1.  N ALPBPARM,DA,DIK,X,Y
  1.  S ALPBPARM=+$O(^ALPB(53.71,0))
  1.  I ALPBPARM'>0 Q
  1.  S DA=ERRIEN
  1.  S DA(1)=ALPBPARM
  1.  S DIK="^ALPB(53.71,"_DA(1)_",1,"
  1.  D ^DIK
  1.  Q
  1.  ;
  1. PTLIST(LTYPE,RESULTS) ; get list of patients in file 53.7...
  1.  ; LTYPE   = passed = "ALL" to list all patients or
  1.  ;                  = <wardname> to list patients on a selected ward
  1.  ; RESULTS = an array passed by reference in which data will be returned
  1.  N ALPBDATA,ALPBIEN,ALPBPTN,ALPBX
  1.  I $G(LTYPE)="" S LTYPE="ALL"
  1.  S ALPBX=0
  1.  I LTYPE="ALL" D
  1.  .S ALPBPTN=""
  1.  .F  S ALPBPTN=$O(^ALPB(53.7,"B",ALPBPTN)) Q:ALPBPTN=""  D
  1.  ..S ALPBIEN=0
  1.  ..F  S ALPBIEN=$O(^ALPB(53.7,"B",ALPBPTN,ALPBIEN)) Q:'ALPBIEN  D
  1.  ...S ALPBDATA=$G(^ALPB(53.7,ALPBIEN,0))
  1.  ...I ALPBDATA="" K ALPBDATA Q
  1.  ...S ALPBX=ALPBX+1
  1.  ...S RESULTS(ALPBX)=ALPBPTN_"^"_$P(ALPBDATA,"^",2)_"^"_$P(ALPBDATA,"^",5)_"^"_$P(ALPBDATA,"^",6)_"^"_$P(ALPBDATA,"^",7)
  1.  ...K ALPBDATA
  1.  ..K ALPBIEN
  1.  .K ALPBPTN
  1.  I LTYPE'="ALL" D
  1.  .S ALPBPTN=""
  1.  .F  S ALPBPTN=$O(^ALPB(53.7,"AW",LTYPE,ALPBPTN)) Q:ALPBPTN=""  D
  1.  ..S ALPBIEN=0
  1.  ..F  S ALPBIEN=$O(^ALPB(53.7,"AW",LTYPE,ALPBPTN,ALPBIEN)) Q:'ALPBIEN  D
  1.  ...S ALPBDATA=$G(^ALPB(53.7,ALPBIEN,0))
  1.  ...I ALPBDATA="" K ALPBDATA Q
  1.  ...S ALPBX=ALPBX+1
  1.  ...S RESULTS(ALPBX)=ALPBPTN_"^"_$P(ALPBDATA,"^",2)_"^"_$P(ALPBDATA,"^",5)_"^"_$P(ALPBDATA,"^",6)_"^"_$P(ALPBDATA,"^",7)
  1.  ...K ALPBDATA
  1.  ..K ALPBIEN
  1.  .K ALPBPTN
  1.  Q
  1.  ;
  1. STAT(ST) ;This will return the value of a status code for pharmacy
  1.  I $G(ST)="" Q ""
  1.  I $L($T(@ST)) G @ST
  1.  Q ""
  1. IP Q "pending"
  1. CM Q "finished/verified by pharmacist(active)"
  1. DC Q "discontinued"
  1. RP Q "replaced"
  1. HD Q "on hold"
  1. ZE Q "expired"
  1. ZS Q "suspended(active)"
  1. ZU Q "un-suspended(active)"
  1. ZX Q "unreleased"
  1. ZZ Q "renewed"
  1.  ;
  1. STAT2(CODE) ; convert order status code for output...
  1.  ; this function is used primarily by the workstation software
  1.  ; CODE = an order status code
  1.  ; returns printable status code
  1.  I $G(CODE)="" Q "Unknown"
  1.  I CODE="IP"!(CODE="ZX") Q "Pending"
  1.  I CODE="CM"!(CODE="ZU")!(CODE="ZZ") Q "Active"
  1.  I CODE="HD"!(CODE="ZS") Q "Hold"
  1.  I CODE="DC"!(CODE="RP")!(CODE="ZE") Q "Expired"
  1.  Q "Unknown"
  1.  ;
  1. DIV(DFN,ALPBMDT) ;get the Division for a patient
  1.  I +$G(DFN)'>0 Q ""
  1.  N ALPBDIV,ALPWRD,VAIN,VAINDT
  1.  S:+$G(ALPBMDT)>0 VAINDT=$P(ALPBMDT,".",1)
  1.  K ALPBMDT
  1.  D INP^VADPT
  1.  S ALPWRD=$P($G(VAIN(4)),U,1)
  1.  Q:+ALPWRD'>0 ""
  1.  ;Check to see if ward is a DOMICILIARY 
  1.  I $P($G(^DIC(42,ALPWRD,0)),U,3)="D",+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP DOM FILTER",1,"Q")>0 Q "DOM"
  1.  S ALPBDIV=$P($G(^DIC(42,ALPWRD,0)),U,11)
  1.  Q:+ALPBDIV'>0 ""
  1.  Q ALPBDIV
  1.  ;
  1. CNV(A,B,X) ;CONVERT A STRING
  1.  ;This API will take a HL7 segment and convert characters
  1.  ;defined in the input
  1.  ;Example:
  1.  ;Single encoding characters can be converted such as ^ to ~
  1.  ;or multiple encoding characters can be converted such as
  1.  ;  |~^@/ to ^~|/@
  1.  ;A is the string of HL7 encoding characters to be converted
  1.  ;B is the string of HL7 encoding characters to be converted to
  1.  ;X is te message string to be converted
  1.  I A=""!B=""!X="" Q ""
  1.  F I=1:1:$L(A) S A(I)=$E(A,I,I),A(I,1)=""
  1.  F I=1:1:$L(B) S B(I)=$E(B,I,I)
  1.  S J=0
  1.  F  S J=$O(A(J)) Q:+J'>0  D
  1.  . F I=1:1:$L(X) S:$E(X,I,I)=A(J) A(J,1)=A(J,1)_I_U
  1.  S J=0
  1.  F  S J=$O(A(J)) Q:+J'>0  D
  1.  . Q:'$D(A(J,1))!'$D(B(J))
  1.  . F I=1:1:$L(A(J,1),U) S C=$P(A(J,1),U,I) S:+C>0 $E(X,C,C)=B(J)
  1.  Q X