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