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

BPSUTIL1.m

Go to the documentation of this file.
  1. BPSUTIL1 ;BHAM ISC/SS - General Utility functions ;08/01/2006
  1. ;;1.0;E CLAIMS MGMT ENGINE;**5**;JUN 2004;Build 45
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. Q
  1. ;Function to return field data from DRUG file (#50)
  1. ; Parameters
  1. ; BPSIEN50 - IEN of DRUG FILE #50
  1. ; BPSFLDN - Field Number(s) (like .01)
  1. ; BPSEXIN - Specifies internal or external value of returned field
  1. ; - optional, defaults to "I"
  1. ; BPSARR50 - Array to return value(s). Optional. Pass by reference.
  1. ; See EN^DIQ documentation for variable DIQ
  1. ;
  1. ; Function returns field data if one field is specified. If
  1. ; multiple fields, the function will return "" and the field
  1. ; values are returned in BPSARR50
  1. ; Example: W $$DRUGDIE^BPSUTIL1(134,25,"E",.ARR)
  1. DRUGDIE(BPSIEN50,BPSFLDN,BPSEXIN,BPSARR50) ; Return field values for Drug file
  1. I $G(BPSIEN50)=""!($G(BPSFLDN)="") Q ""
  1. N DIQ,PSSDIY
  1. N BPSDIQ
  1. I $G(BPSEXIN)'="E" S BPSEXIN="I"
  1. S BPSDIQ="BPSARR50",BPSDIQ(0)=BPSEXIN
  1. D EN^PSSDI(50,"BPS",50,.BPSFLDN,.BPSIEN50,.BPSDIQ)
  1. Q $G(BPSARR50(50,BPSIEN50,BPSFLDN,BPSEXIN))
  1. ;
  1. ;Function to do lookup on DRUG file (#50)
  1. ; Paramters
  1. ; BPSDIC - Setup per fileman documentation for call to ^DIC
  1. ;
  1. ; Returns variables as documented for call to ^DIC except X
  1. ; will not be returned.
  1. DRUGDIC(BPSDIC) ; Look up on DRUG FILE (#50)
  1. I '$G(BPSDIC) Q
  1. N PSSDIY
  1. D DIC^PSSDI(50,"BPS",.BPSDIC)
  1. Q
  1. ;/*
  1. ;Subroutine to return values from MULTIPLE fields of file #52
  1. ;DBIA 4858
  1. ;input:
  1. ; IEN - ien of file #52
  1. ; BPSFLDN - one or more fields, for example ".01;2;5"
  1. ; BPSRET - contains a name for a local array to return results,
  1. ; Note: the name of the array should't be "BPSRET" otherwise it will
  1. ; be "newed" since the parameter has the same name
  1. ; BPFORMAT -
  1. ; "E" for external format
  1. ; "I" - internal
  1. ; "N" - do not return nulls
  1. ; default is "E"
  1. ;output:
  1. ; result will be put into array with the name specified by BPSRET
  1. ; examples:
  1. ;D RXAPI^BPSUTIL1(504733,".01;1;6","ARR","IE")
  1. ;ZW ARR
  1. ;ARR(52,504733,.01,"E")=100004099
  1. ;ARR(52,504733,.01,"I")=100004099
  1. ;ARR(52,504733,1,"E")="JUL 21, 2006"
  1. ;ARR(52,504733,1,"I")=3060721
  1. ;ARR(52,504733,6,"E")="ALBUMIN 25% 50ML"
  1. ;ARR(52,504733,6,"I")=134
  1. RXAPI(BPSIEN52,BPSFLDN,BPSRET,BPFORMAT) ;*/
  1. I ($G(BPSIEN52)="")!($G(BPSFLDN)="")!($G(BPSRET)="") Q
  1. N DIQ,DIC,X,Y,D0,PSODIY
  1. N I,J,C,DA,DRS,DIL,DI,DIQ1
  1. N BPSDIQ
  1. S BPSDIQ=$NA(@BPSRET)
  1. S BPSDIQ(0)=$S($G(BPFORMAT)="":"E",1:BPFORMAT)
  1. D DIQ^PSODI(52,52,.BPSFLDN,.BPSIEN52,.BPSDIQ) ;DBIA 4858
  1. Q
  1. ;
  1. ;/*
  1. ;Function to return a value for a SINGLE field of file #52
  1. ;DBIA 4858
  1. ;input:
  1. ; BPSIEN52 - ien of file #52
  1. ; BPSFLDN - one single field, for example ".01"
  1. ; BPFORMAT - optional parameter,
  1. ; "E" for external format
  1. ; "I" - internal
  1. ; "N" - do not return nulls
  1. ; default is "E"
  1. ;output:
  1. ; returns a field value or null (empty string)
  1. ; examples:
  1. ;W $$RXAPI1^BPSUTIL1(504733,6,"E")
  1. ;ALBUMIN 25% 50ML
  1. ;W $$RXAPI1^BPSUTIL1(504733,6,"I")
  1. ;134
  1. RXAPI1(BPSIEN52,BPSFLDN,BPFORMAT) ;*/
  1. I ($G(BPSIEN52)="")!($G(BPSFLDN)="") Q ""
  1. N DIQ,DIC,BPSARR,X,Y,D0,PSODIY
  1. N I,J,C,DA,DRS,DIL,DI,DIQ1
  1. N BPSDIQ
  1. S BPSDIQ="BPSARR"
  1. S BPSDIQ(0)=$S($G(BPFORMAT)="":"E",1:BPFORMAT)
  1. D DIQ^PSODI(52,52,.BPSFLDN,.BPSIEN52,.BPSDIQ) ;DBIA 4858
  1. Q $S(BPSDIQ(0)="N":$G(BPSARR(52,BPSIEN52,BPSFLDN)),1:$G(BPSARR(52,BPSIEN52,BPSFLDN,BPSDIQ(0))))
  1. ;
  1. ;/*
  1. ;Subroutine to return values from MULTIPLE fields of a subfile of the file #52
  1. ;DBIA 4858
  1. ;input:
  1. ; BPSIEN52 - ien of file #52
  1. ; BPSFLD52 - field # that relates to this subfile
  1. ; BPSUBFNO - subfile number (like 52.052311)
  1. ; BPSUBIEN - ien of the subfile record you're interested in
  1. ; BPSUBFLD - one or more fields, for example ".01;2;5"
  1. ; BPSRET - name for a local array to return results
  1. ; BPFORMAT - optional parameter.
  1. ; "E" for external format
  1. ; "I" - internal
  1. ; "N" - do not return nulls
  1. ; default is "E"
  1. ;output:
  1. ; returns results in array BPSRET in the form:
  1. ; BPSRET (BPSUBFNO, BPSUBIEN, BPSUBFLD,BPFORMAT)=value
  1. ;
  1. ;example for (#52311) ICD DIAGNOSIS subfile
  1. ;D RXSUBF^BPSUTIL1(504740,52311,52.052311,1,".01;1;2","ARR","I")
  1. ;ZW ARR
  1. ;ARR(52.052311,1,.01,"I")=816
  1. ;ARR(52.052311,1,1,"I")=1
  1. ;ARR(52.052311,1,2,"I")=1
  1. ;
  1. RXSUBF(BPSIEN52,BPSFLD52,BPSUBFNO,BPSUBIEN,BPSUBFLD,BPSRET,BPFORMAT) ;
  1. I ($G(BPSIEN52)="")!($G(BPSFLD52)="")!($G(BPSUBFNO)="")!($G(BPSUBIEN)="")!($G(BPSUBFLD)="")!($G(BPSRET)="") Q
  1. N DIQ,DIC,DA,DR,X,Y,D0,PSODIY
  1. N I,J,C,DA,DRS,DIL,DI,DIQ1
  1. N BPSDIC,BPSDR,BPSDA,BPSDIQ
  1. S BPSDIC=52 ;main file #52
  1. S BPSDA=BPSIEN52 ;ien in main file #52
  1. S BPSDA(BPSUBFNO)=BPSUBIEN ;ien in subfile
  1. S BPSDR=BPSFLD52 ;field# of the subfile in the main file
  1. S BPSDR(BPSUBFNO)=BPSUBFLD ;field# in the subfile that we need to get a value for
  1. S BPSDIQ=$NA(@BPSRET) ;output array
  1. S BPSDIQ(0)=$S($G(BPFORMAT)="":"E",1:BPFORMAT)
  1. D DIQ^PSODI(52,.BPSDIC,.BPSDR,.BPSDA,.BPSDIQ) ;DBIA 4858
  1. Q
  1. ;
  1. ;/*
  1. ;Function to return a value for a SINGLE field of a subfile of the file #52
  1. ;DBIA 4858
  1. ;input:
  1. ; BPSIEN52 - ien of file #52
  1. ; BPSFLD52 - field # that relates to this subfile
  1. ; BPSUBFNO - subfile number (like 52.052311)
  1. ; BPSUBIEN - ien of the subfile record you're interested in
  1. ; BPSUBFLD - one single field, for example ".01"
  1. ; BPFORMAT - optional parameter,
  1. ; "E" for external format
  1. ; "I" - internal
  1. ; "N" - do not return nulls
  1. ; default is "E"
  1. ;output:
  1. ; returns a field value or null (empty string)
  1. ;
  1. ;example for (#52311) ICD DIAGNOSIS subfile
  1. ;W $$RXSUBF1^BPSUTIL1(504740,52311,52.052311,1,1,"I")
  1. ;1
  1. ;W $$RXSUBF1^BPSUTIL1(504740,52311,52.052311,1,.01,"E")
  1. ;239.1
  1. ;
  1. RXSUBF1(BPSIEN52,BPSFLD52,BPSUBFNO,BPSUBIEN,BPSUBFLD,BPFORMAT) ;*/
  1. I ($G(BPSIEN52)="")!($G(BPSFLD52)="")!($G(BPSUBFNO)="")!($G(BPSUBIEN)="")!($G(BPSUBFLD)="") Q ""
  1. N DIQ,DIC,BPSARR,DA,DR,X,Y,D0,PSODIY
  1. N I,J,C,DRS,DIL,DI,DIQ1
  1. N BPSDIC,BPSDA,BPSDR
  1. S BPSDIC=52 ;main file #52
  1. S BPSDA=BPSIEN52 ;ien in main file #52
  1. S BPSDA(BPSUBFNO)=BPSUBIEN ;ien in subfile
  1. S BPSDR=BPSFLD52 ;field# of the subfile in the main file
  1. S BPSDR(BPSUBFNO)=BPSUBFLD ;field# in the subfile that we need to get a value for
  1. S BPSDIQ="BPSARR" ;output array
  1. S BPSDIQ(0)=$S($G(BPFORMAT)="":"E",1:BPFORMAT)
  1. D DIQ^PSODI(52,.BPSDIC,.BPSDR,.BPSDA,.BPSDIQ) ;DBIA 4858
  1. Q $S(BPSDIQ(0)="N":$G(BPSARR(BPSUBFNO,BPSUBIEN,BPSUBFLD)),1:$G(BPSARR(BPSUBFNO,BPSUBIEN,BPSUBFLD,BPSDIQ(0))))
  1. ;
  1. ;
  1. ;Function to return a value for a single field of subfile #52.1
  1. ;DBIA 4858
  1. ;input:
  1. ; BPSIEN52 - ien of file #52
  1. ; REFIEN - refill ien of subfile #52.1
  1. ; BPSFLDN - one single field, for example ".01"
  1. ; BPFORMAT - (optional)
  1. ; "E" for external format
  1. ; "I" - internal
  1. ; "N" - do not return nulls
  1. ; default is "E"
  1. ;output:
  1. ; returns a field value or null (empty string)
  1. ; examples:
  1. ;W $$REFAPI1^BPSUTIL1(401777,1,.01,"I")
  1. ;3000526
  1. REFAPI1(BPSIEN52,REFIEN,BPSFLDN,BPFORMAT) ;
  1. I ($G(BPSIEN52)="")!($G(REFIEN)="")!($G(BPSFLDN)="") Q ""
  1. Q $$RXSUBF1(BPSIEN52,52,52.1,REFIEN,BPSFLDN,$G(BPFORMAT))
  1. ;
  1. ;
  1. ;/**
  1. ;DBIA 4858
  1. ;prompts for RX selection
  1. ;input:
  1. ; BPSPROM - prompt message
  1. ; BPSDFLT - default value for the prompt (optional parameter)
  1. ;output:
  1. ; returns selection (IEN of file #52)
  1. ; OR -1 when timeout and/or uparrow
  1. ; OR -2 when incorrect parameters
  1. ;Example:
  1. ;W $$PROMPTRX^BPSUTIL1("Select RX:",100003784)
  1. ;Select RX:: 100003784// ??
  1. ; Choose from:
  1. ;200168 200081A MYLANTA II LIQUID 5 OZ
  1. ;200291 300110B IBUPROFEN 600MG
  1. PROMPTRX(BPSPROM,BPSDFLT) ;*/
  1. N Y,X,DUOUT,DTOUT,DIROUT,DIC,PSODIY,DILN,I
  1. N BPSDIC
  1. S BPSDIC=52,X=""
  1. S BPSDIC(0)="AEMNQ"
  1. S:$L($G(BPSDFLT))>0 BPSDIC("B")=BPSDFLT
  1. S:$G(BPSPROM)]"" BPSDIC("A")=BPSPROM_": "
  1. D DIC^PSODI(52,.BPSDIC,X) ;DBIA 4858
  1. I (Y=-1)!$D(DUOUT)!$D(DTOUT) Q -1
  1. Q $P(Y,U)
  1. ;