IBRXUTL1 ;BP/BDM - PHARMACY API CALLS ; DECEMBER 20, 2006
;;2.0;INTEGRATED BILLING;**347,563**;21-MAR-94;Build 12
;;Per VA Directive 6402, this routine should not be modified.
;
;THIS ROUTINE IS A UTILITY FUNCTION FOR PHARMACY API'S
;
DATA(IBDRV) ;
N LIST,RXRET,RETURN
K ^TMP($J,"IBDRUG")
S LIST="IBDRUG" D ZERO^PSS50(IBDRV,,,,,LIST)
S RXRET=$G(^TMP($J,LIST,0))
I RXRET>0 S RETURN=1
E S RETURN=0
K ^TMP($J,LIST)
Q RETURN
;
DRUG(IBIEN) ;
N LIST
S LIST="DRUGTMP"
D DATA^PSS50(IBIEN,,,,,LIST)
S RETURN=$G(^TMP($J,LIST,IBIEN,.01))
K ^TMP($J,LIST)
Q RETURN
;
ICD(DFN,RXIEN,ICDCT,LIST) ;
N ICDOUT,NODE,IBTMPARR
I '$G(DFN) S ICDOUT="" Q ICDOUT
I '$G(RXIEN) S ICDOUT="" Q ICDOUT
I '$G(ICDCT) S ICDOUT="" Q ICDOUT
I $G(LIST)="" S ICDOUT="" Q ICDOUT
S IBTMPARR="ICDARR"
S $P(^TMP($J,IBTMPARR),"^",1)=$P($G(^TMP($J,LIST,DFN,RXIEN,"ICD",ICDCT,.01)),"^",1)
S $P(^TMP($J,IBTMPARR),"^",2)=$P($G(^TMP($J,LIST,DFN,RXIEN,"ICD",ICDCT,1)),"^",1)
S $P(^TMP($J,IBTMPARR),"^",3)=$P($G(^TMP($J,LIST,DFN,RXIEN,"ICD",ICDCT,2)),"^",1)
S $P(^TMP($J,IBTMPARR),"^",4)=$P($G(^TMP($J,LIST,DFN,RXIEN,"ICD",ICDCT,3)),"^",1)
S $P(^TMP($J,IBTMPARR),"^",5)=$P($G(^TMP($J,LIST,DFN,RXIEN,"ICD",ICDCT,4)),"^",1)
S $P(^TMP($J,IBTMPARR),"^",6)=$P($G(^TMP($J,LIST,DFN,RXIEN,"ICD",ICDCT,5)),"^",1)
S $P(^TMP($J,IBTMPARR),"^",7)=$P($G(^TMP($J,LIST,DFN,RXIEN,"ICD",ICDCT,6)),"^",1)
S $P(^TMP($J,IBTMPARR),"^",8)=$P($G(^TMP($J,LIST,DFN,RXIEN,"ICD",ICDCT,7)),"^",1)
S ICDOUT=^TMP($J,IBTMPARR)
K ^TMP($J,IBTMPARR)
Q ICDOUT
;
DRUGF(IBDRUG,IBFLD) ; - returns a specific field from the Drug file
N LIST,RETURN
S LIST="IBDRUG" K ^TMP($J,LIST)
D DATA^PSS50(IBDRUG,,,,,LIST)
S RETURN=$G(^TMP($J,LIST,IBDRUG,IBFLD))
K ^TMP($J,LIST)
Q RETURN
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBRXUTL1 1785 printed Oct 16, 2024@18:27:39 Page 2
IBRXUTL1 ;BP/BDM - PHARMACY API CALLS ; DECEMBER 20, 2006
+1 ;;2.0;INTEGRATED BILLING;**347,563**;21-MAR-94;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;THIS ROUTINE IS A UTILITY FUNCTION FOR PHARMACY API'S
+5 ;
DATA(IBDRV) ;
+1 NEW LIST,RXRET,RETURN
+2 KILL ^TMP($JOB,"IBDRUG")
+3 SET LIST="IBDRUG"
DO ZERO^PSS50(IBDRV,,,,,LIST)
+4 SET RXRET=$GET(^TMP($JOB,LIST,0))
+5 IF RXRET>0
SET RETURN=1
+6 IF '$TEST
SET RETURN=0
+7 KILL ^TMP($JOB,LIST)
+8 QUIT RETURN
+9 ;
DRUG(IBIEN) ;
+1 NEW LIST
+2 SET LIST="DRUGTMP"
+3 DO DATA^PSS50(IBIEN,,,,,LIST)
+4 SET RETURN=$GET(^TMP($JOB,LIST,IBIEN,.01))
+5 KILL ^TMP($JOB,LIST)
+6 QUIT RETURN
+7 ;
ICD(DFN,RXIEN,ICDCT,LIST) ;
+1 NEW ICDOUT,NODE,IBTMPARR
+2 IF '$GET(DFN)
SET ICDOUT=""
QUIT ICDOUT
+3 IF '$GET(RXIEN)
SET ICDOUT=""
QUIT ICDOUT
+4 IF '$GET(ICDCT)
SET ICDOUT=""
QUIT ICDOUT
+5 IF $GET(LIST)=""
SET ICDOUT=""
QUIT ICDOUT
+6 SET IBTMPARR="ICDARR"
+7 SET $PIECE(^TMP($JOB,IBTMPARR),"^",1)=$PIECE($GET(^TMP($JOB,LIST,DFN,RXIEN,"ICD",ICDCT,.01)),"^",1)
+8 SET $PIECE(^TMP($JOB,IBTMPARR),"^",2)=$PIECE($GET(^TMP($JOB,LIST,DFN,RXIEN,"ICD",ICDCT,1)),"^",1)
+9 SET $PIECE(^TMP($JOB,IBTMPARR),"^",3)=$PIECE($GET(^TMP($JOB,LIST,DFN,RXIEN,"ICD",ICDCT,2)),"^",1)
+10 SET $PIECE(^TMP($JOB,IBTMPARR),"^",4)=$PIECE($GET(^TMP($JOB,LIST,DFN,RXIEN,"ICD",ICDCT,3)),"^",1)
+11 SET $PIECE(^TMP($JOB,IBTMPARR),"^",5)=$PIECE($GET(^TMP($JOB,LIST,DFN,RXIEN,"ICD",ICDCT,4)),"^",1)
+12 SET $PIECE(^TMP($JOB,IBTMPARR),"^",6)=$PIECE($GET(^TMP($JOB,LIST,DFN,RXIEN,"ICD",ICDCT,5)),"^",1)
+13 SET $PIECE(^TMP($JOB,IBTMPARR),"^",7)=$PIECE($GET(^TMP($JOB,LIST,DFN,RXIEN,"ICD",ICDCT,6)),"^",1)
+14 SET $PIECE(^TMP($JOB,IBTMPARR),"^",8)=$PIECE($GET(^TMP($JOB,LIST,DFN,RXIEN,"ICD",ICDCT,7)),"^",1)
+15 SET ICDOUT=^TMP($JOB,IBTMPARR)
+16 KILL ^TMP($JOB,IBTMPARR)
+17 QUIT ICDOUT
+18 ;
DRUGF(IBDRUG,IBFLD) ; - returns a specific field from the Drug file
+1 NEW LIST,RETURN
+2 SET LIST="IBDRUG"
KILL ^TMP($JOB,LIST)
+3 DO DATA^PSS50(IBDRUG,,,,,LIST)
+4 SET RETURN=$GET(^TMP($JOB,LIST,IBDRUG,IBFLD))
+5 KILL ^TMP($JOB,LIST)
+6 QUIT RETURN
+7 ;
