IBRXUTL ;ALB/MAF - PHARMACY API CALLS ;1/9/08 14:45
;;2.0;INTEGRATED BILLING;**309,347,383**;21-MAR-94;Build 11
;
ZERO(IBDRV) ;
N X
K ^TMP($J,"IBDRUG")
S X="IBDRUG" D ZERO^PSS50(IBDRV,,,,,X)
Q
DATA(IBDRV) ;
N X
K ^TMP($J,"IBDRUG")
S X="IBDRUG" D DATA^PSS50(IBDRV,,,,,X)
Q
FILE(DA,DR,INTEXT) ;Returns single field from file 52
N RETURN,PSOFILE
I '$G(DA) S RETURN="" Q RETURN
I '$G(DR) S RETURN="" Q RETURN
S PSOFILE=52
S DA=+DA
I $G(INTEXT)="" S INTEXT="I"
S RETURN=$$GET1^PSODI(PSOFILE,DA,DR,INTEXT)
I $P($G(RETURN),"^",1)=0 S RETURN="" Q RETURN
Q $P(RETURN,"^",2)
SUBFILE(DA,DASUB,DR,DRSUB,INTEXT) ;Returns single field from subfile 52.1
;The DR variable isn't being used because Pharmacy API changed after IB*2.0*347 went
;to test site. Rather than changing all the routines that call this API this
;input variable is now not used.
N RETSUB,PSOFILE,IENS
I '$G(DA) S RETSUB="" Q RETSUB
I '$G(DASUB) S RETSUB="" Q RETSUB
I '$G(DRSUB) S RETSUB="" Q RETSUB
S PSOFILE=52.1
S IENS=+DASUB_","_+DA
I $G(INTEXT)="" S INTEXT="I"
S RETSUB=$$GET1^PSODI(PSOFILE,IENS,DRSUB,INTEXT)
I $P($G(RETSUB),"^",1)=0 S RETSUB="" Q RETSUB
Q $P(RETSUB,"^",2)
RXZERO(PDFN,RXIEN) ;Returns zero node of file 52
N ZEROOUT,LIST,IBTMPARR,NODE
I '$G(PDFN) S ZEROOUT="" Q ZEROOUT
I '$G(RXIEN) S ZEROOUT="" Q ZEROOUT
S NODE=0
S LIST="IBZEROARR"
S IBTMPARR="IBTMPZERO"
D RX^PSO52API(PDFN,LIST,RXIEN,,NODE,,)
I $P(^TMP($J,LIST,PDFN,0),"^",1)>0 D
.S $P(^TMP($J,IBTMPARR),"^",1)=$G(^TMP($J,LIST,PDFN,RXIEN,.01))
.S $P(^TMP($J,IBTMPARR),"^",2)=$P($G(^TMP($J,LIST,PDFN,RXIEN,2)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",3)=$P($G(^TMP($J,LIST,PDFN,RXIEN,3)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",4)=$P($G(^TMP($J,LIST,PDFN,RXIEN,4)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",5)=$P($G(^TMP($J,LIST,PDFN,RXIEN,5)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",6)=$P($G(^TMP($J,LIST,PDFN,RXIEN,6)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",7)=$G(^TMP($J,LIST,PDFN,RXIEN,7))
.S $P(^TMP($J,IBTMPARR),"^",8)=$G(^TMP($J,LIST,PDFN,RXIEN,8))
.S $P(^TMP($J,IBTMPARR),"^",9)=$G(^TMP($J,LIST,PDFN,RXIEN,9))
.S $P(^TMP($J,IBTMPARR),"^",10)=""
.S $P(^TMP($J,IBTMPARR),"^",11)=$P($G(^TMP($J,LIST,PDFN,RXIEN,11)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",12)=""
.S $P(^TMP($J,IBTMPARR),"^",13)=$P($G(^TMP($J,LIST,PDFN,RXIEN,1)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",14)=""
.S $P(^TMP($J,IBTMPARR),"^",15)=""
.S $P(^TMP($J,IBTMPARR),"^",16)=$P($G(^TMP($J,LIST,PDFN,RXIEN,16)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",17)=$G(^TMP($J,LIST,PDFN,RXIEN,17))
.S $P(^TMP($J,IBTMPARR),"^",18)=$G(^TMP($J,LIST,PDFN,RXIEN,10.6))
.S $P(^TMP($J,IBTMPARR),"^",19)=$P($G(^TMP($J,LIST,PDFN,RXIEN,10.3)),"^",1)
.S ZEROOUT=^TMP($J,IBTMPARR)
.K ^TMP($J,IBTMPARR)
E S ZEROOUT=""
K ^TMP($J,LIST)
Q ZEROOUT
RXSEC(PDFN,RXIEN) ;Returns second node of file 52
N SECOUT,LIST,IBTMPARR,NODE
I '$G(PDFN) S SECOUT="" Q SECOUT
I '$G(RXIEN) S SECOUT="" Q SECOUT
S NODE=2
S LIST="IBSECARR"
S IBTMPARR="IBTMPSEC"
D RX^PSO52API(PDFN,LIST,RXIEN,,NODE,,)
I $P(^TMP($J,LIST,PDFN,0),"^",1)>0 D
.S $P(^TMP($J,IBTMPARR),"^",1)=$P($G(^TMP($J,LIST,PDFN,RXIEN,21)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",2)=$P($G(^TMP($J,LIST,PDFN,RXIEN,22)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",3)=$P($G(^TMP($J,LIST,PDFN,RXIEN,23)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",4)=$G(^TMP($J,LIST,PDFN,RXIEN,24))
.S $P(^TMP($J,IBTMPARR),"^",5)=$P($G(^TMP($J,LIST,PDFN,RXIEN,25)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",6)=$P($G(^TMP($J,LIST,PDFN,RXIEN,26)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",7)=$G(^TMP($J,LIST,PDFN,RXIEN,27))
.S $P(^TMP($J,IBTMPARR),"^",8)=$G(^TMP($J,LIST,PDFN,RXIEN,28))
.S $P(^TMP($J,IBTMPARR),"^",9)=$P($G(^TMP($J,LIST,PDFN,RXIEN,20)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",10)=$P($G(^TMP($J,LIST,PDFN,RXIEN,104)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",11)=$P($G(^TMP($J,LIST,PDFN,RXIEN,29)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",12)=$G(^TMP($J,LIST,PDFN,RXIEN,30))
.S $P(^TMP($J,IBTMPARR),"^",13)=$P($G(^TMP($J,LIST,PDFN,RXIEN,31)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",14)=$P($G(^TMP($J,LIST,PDFN,RXIEN,32.2)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",15)=$P($G(^TMP($J,LIST,PDFN,RXIEN,32.1)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",16)=$G(^TMP($J,LIST,PDFN,RXIEN,32.3))
.S SECOUT=^TMP($J,IBTMPARR)
.K ^TMP($J,IBTMPARR)
E S SECOUT=""
K ^TMP($J,LIST)
Q SECOUT
RX3(PDFN,RXIEN) ;Returns third node of file 52
N THRDOUT,LIST,IBTMPARR,NODE
I '$G(PDFN) S THRDOUT="" Q THRDOUT
I '$G(RXIEN) S THRDOUT="" Q THRDOUT
S NODE=3
S LIST="IBARRTHRD"
S IBTMPARR="IBTMP3"
D RX^PSO52API(PDFN,LIST,RXIEN,,NODE,,)
I $P(^TMP($J,LIST,PDFN,0),"^",1)>0 D
.S $P(^TMP($J,IBTMPARR),"^",1)=$P($G(^TMP($J,LIST,PDFN,RXIEN,101)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",2)=$P($G(^TMP($J,LIST,PDFN,RXIEN,102)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",3)=$P($G(^TMP($J,LIST,PDFN,RXIEN,109)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",4)=$P($G(^TMP($J,LIST,PDFN,RXIEN,102.1)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",5)=$P($G(^TMP($J,LIST,PDFN,RXIEN,26.1)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",6)=$P($G(^TMP($J,LIST,PDFN,RXIEN,34.1)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",7)=$G(^TMP($J,LIST,PDFN,RXIEN,12))
.S $P(^TMP($J,IBTMPARR),"^",8)=$G(^TMP($J,LIST,PDFN,RXIEN,102.2))
.S $P(^TMP($J,IBTMPARR),"^",9)=$G(^TMP($J,LIST,PDFN,RXIEN,112))
.S THRDOUT=^TMP($J,IBTMPARR)
.K ^TMP($J,IBTMPARR)
E S THRDOUT=""
K ^TMP($J,LIST)
Q THRDOUT
ZEROSUB(PDFN,RXIEN,RXSUB) ;Returns zero node of subfile 52.1
N ZSUBOUT,LIST,IBTMPARR,NODE
I '$G(PDFN) S ZSUBOUT="" Q ZSUBOUT
I '$G(RXIEN) S ZSUBOUT="" Q ZSUBOUT
I '$G(RXSUB) S ZSUBOUT="" Q ZSUBOUT
S NODE="R^^"_RXSUB
S LIST="IBSUBARR"
S IBTMPARR="IBTMPSUB"
D RX^PSO52API(PDFN,LIST,RXIEN,,NODE,,)
I $P(^TMP($J,LIST,PDFN,RXIEN,"RF",0),"^",1)>0 D
.S $P(^TMP($J,IBTMPARR),"^",1)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,.01)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",2)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,2)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",3)=$G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,3))
.S $P(^TMP($J,IBTMPARR),"^",4)=$G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,1))
.S $P(^TMP($J,IBTMPARR),"^",5)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,4)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",6)=$G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,5))
.S $P(^TMP($J,IBTMPARR),"^",7)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,6)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",8)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,7)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",9)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,8)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",10)=$G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,1.1))
.S $P(^TMP($J,IBTMPARR),"^",11)=$G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,1.2))
.S $P(^TMP($J,IBTMPARR),"^",12)=""
.S $P(^TMP($J,IBTMPARR),"^",13)=""
.S $P(^TMP($J,IBTMPARR),"^",14)=$G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,12))
.S $P(^TMP($J,IBTMPARR),"^",15)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,13)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",16)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,14)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",17)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,15)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",18)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,17)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",19)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,10.1)),"^",1)
.S ZSUBOUT=^TMP($J,IBTMPARR)
.K ^TMP($J,IBTMPARR)
E S ZSUBOUT=""
K ^TMP($J,LIST)
Q ZSUBOUT
RFNUM(RXIEN) ;
N PDFN,RXSUB,LIST,IBTMPARR,NODE
I '$G(RXIEN) S RXSUB="" Q RXSUB
S PDFN=$$FILE^IBRXUTL(RXIEN,2)
S LIST="IBRFNARR"
S IBTMPARR="IBTMPRFN"
S NODE="R"
D RX^PSO52API(PDFN,LIST,RXIEN,,NODE,,)
I $P(^TMP($J,LIST,PDFN,RXIEN,"RF",0),"^",1)>0 D
.S RXSUB=^TMP($J,LIST,PDFN,RXIEN,"RF",0)
E S RXSUB=""
K ^TMP($J,LIST)
Q RXSUB
IBND(DFN,RXIEN) ;Returns IB node
N IBNDOUT,LIST,NODE,IBTMPARR
I '$G(DFN) S IBNDOUT="" Q IBNDOUT
I '$G(RXIEN) S IBNDOUT="" Q IBNDOUT
S LIST="IBIBNDARR"
S NODE="I^O"
S IBTMPARR="IBTMPIBND"
D RX^PSO52API(DFN,LIST,RXIEN,,NODE,,)
I $P(^TMP($J,LIST,DFN,0),"^",1)>0 D
.S $P(^TMP($J,IBTMPARR),"^",1)=$P($G(^TMP($J,LIST,DFN,RXIEN,105)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",2)=$P($G(^TMP($J,LIST,DFN,RXIEN,106)),"^",1)
.S $P(^TMP($J,IBTMPARR),"^",3)=$G(^TMP($J,LIST,DFN,RXIEN,106.5))
.S $P(^TMP($J,IBTMPARR),"^",4)=$G(^TMP($J,LIST,DFN,RXIEN,106.6))
.S IBNDOUT=^TMP($J,IBTMPARR)
.S:IBNDOUT="^^^" IBNDOUT=""
.K ^TMP($J,IBTMPARR)
E S IBNDOUT=""
K ^TMP($J,LIST)
Q IBNDOUT
IBNDFL(DFN,RXIEN,RXRFL) ;
N IBNDFL,LIST,NODE,IBTMPARR
I '$G(DFN) S IBNDFL="" Q IBNDFL
I '$G(RXIEN) S IBNDFL="" Q IBNDFL
I '$G(RXRFL) S IBNDFL="" Q IBNDFL
S LIST="IBIBNDFLARR"
S NODE="I^R^"_RXRFL
S IBTMPARR="IBTMPIBNDFL"
D RX^PSO52API(DFN,LIST,RXIEN,,NODE,,)
I ^TMP($J,LIST,DFN,RXIEN,"IB",0)>0 D
.S $P(^TMP($J,IBTMPARR),"^",1)=$G(^TMP($J,LIST,DFN,RXIEN,"IB",RXRFL,9))
.S $P(^TMP($J,IBTMPARR),"^",2)=$G(^TMP($J,LIST,DFN,RXIEN,"IB",RXRFL,9.1))
.S IBNDFL=^TMP($J,IBTMPARR)
.K ^TMP($J,IBTMPARR)
E S IBNDFL=""
K ^TMP($J,LIST)
Q IBNDFL
;
RFLNUM(IBRXN,FLDT,IBFLG) ; find the refill number in file 52 for the given date
N NUMOUT,NUM,DFN,LIST,NODE
I '$G(IBRXN) S NUMOUT="" Q NUMOUT
I '$G(FLDT) S NUMOUT="" Q NUMOUT
S LIST="IBRTMP"
K ^TMP($J,LIST)
S NUM=0
S DFN=$$FILE(IBRXN,2)
S NODE="R^^"
D RX^PSO52API(DFN,LIST,IBRXN,,NODE,,)
F S NUM=$O(^TMP($J,LIST,DFN,IBRXN,"RF",NUM)) Q:'NUM D
.I $P(^TMP($J,LIST,DFN,IBRXN,"RF",NUM,.01),"^",1)=FLDT S NUMOUT=NUM
K ^TMP($J,LIST)
S:'$G(NUMOUT) NUMOUT=""
Q NUMOUT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBRXUTL 9468 printed Jan 18, 2025@03:28:12 Page 2
IBRXUTL ;ALB/MAF - PHARMACY API CALLS ;1/9/08 14:45
+1 ;;2.0;INTEGRATED BILLING;**309,347,383**;21-MAR-94;Build 11
+2 ;
ZERO(IBDRV) ;
+1 NEW X
+2 KILL ^TMP($JOB,"IBDRUG")
+3 SET X="IBDRUG"
DO ZERO^PSS50(IBDRV,,,,,X)
+4 QUIT
DATA(IBDRV) ;
+1 NEW X
+2 KILL ^TMP($JOB,"IBDRUG")
+3 SET X="IBDRUG"
DO DATA^PSS50(IBDRV,,,,,X)
+4 QUIT
FILE(DA,DR,INTEXT) ;Returns single field from file 52
+1 NEW RETURN,PSOFILE
+2 IF '$GET(DA)
SET RETURN=""
QUIT RETURN
+3 IF '$GET(DR)
SET RETURN=""
QUIT RETURN
+4 SET PSOFILE=52
+5 SET DA=+DA
+6 IF $GET(INTEXT)=""
SET INTEXT="I"
+7 SET RETURN=$$GET1^PSODI(PSOFILE,DA,DR,INTEXT)
+8 IF $PIECE($GET(RETURN),"^",1)=0
SET RETURN=""
QUIT RETURN
+9 QUIT $PIECE(RETURN,"^",2)
SUBFILE(DA,DASUB,DR,DRSUB,INTEXT) ;Returns single field from subfile 52.1
+1 ;The DR variable isn't being used because Pharmacy API changed after IB*2.0*347 went
+2 ;to test site. Rather than changing all the routines that call this API this
+3 ;input variable is now not used.
+4 NEW RETSUB,PSOFILE,IENS
+5 IF '$GET(DA)
SET RETSUB=""
QUIT RETSUB
+6 IF '$GET(DASUB)
SET RETSUB=""
QUIT RETSUB
+7 IF '$GET(DRSUB)
SET RETSUB=""
QUIT RETSUB
+8 SET PSOFILE=52.1
+9 SET IENS=+DASUB_","_+DA
+10 IF $GET(INTEXT)=""
SET INTEXT="I"
+11 SET RETSUB=$$GET1^PSODI(PSOFILE,IENS,DRSUB,INTEXT)
+12 IF $PIECE($GET(RETSUB),"^",1)=0
SET RETSUB=""
QUIT RETSUB
+13 QUIT $PIECE(RETSUB,"^",2)
RXZERO(PDFN,RXIEN) ;Returns zero node of file 52
+1 NEW ZEROOUT,LIST,IBTMPARR,NODE
+2 IF '$GET(PDFN)
SET ZEROOUT=""
QUIT ZEROOUT
+3 IF '$GET(RXIEN)
SET ZEROOUT=""
QUIT ZEROOUT
+4 SET NODE=0
+5 SET LIST="IBZEROARR"
+6 SET IBTMPARR="IBTMPZERO"
+7 DO RX^PSO52API(PDFN,LIST,RXIEN,,NODE,,)
+8 IF $PIECE(^TMP($JOB,LIST,PDFN,0),"^",1)>0
Begin DoDot:1
+9 SET $PIECE(^TMP($JOB,IBTMPARR),"^",1)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,.01))
+10 SET $PIECE(^TMP($JOB,IBTMPARR),"^",2)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,2)),"^",1)
+11 SET $PIECE(^TMP($JOB,IBTMPARR),"^",3)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,3)),"^",1)
+12 SET $PIECE(^TMP($JOB,IBTMPARR),"^",4)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,4)),"^",1)
+13 SET $PIECE(^TMP($JOB,IBTMPARR),"^",5)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,5)),"^",1)
+14 SET $PIECE(^TMP($JOB,IBTMPARR),"^",6)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,6)),"^",1)
+15 SET $PIECE(^TMP($JOB,IBTMPARR),"^",7)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,7))
+16 SET $PIECE(^TMP($JOB,IBTMPARR),"^",8)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,8))
+17 SET $PIECE(^TMP($JOB,IBTMPARR),"^",9)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,9))
+18 SET $PIECE(^TMP($JOB,IBTMPARR),"^",10)=""
+19 SET $PIECE(^TMP($JOB,IBTMPARR),"^",11)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,11)),"^",1)
+20 SET $PIECE(^TMP($JOB,IBTMPARR),"^",12)=""
+21 SET $PIECE(^TMP($JOB,IBTMPARR),"^",13)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,1)),"^",1)
+22 SET $PIECE(^TMP($JOB,IBTMPARR),"^",14)=""
+23 SET $PIECE(^TMP($JOB,IBTMPARR),"^",15)=""
+24 SET $PIECE(^TMP($JOB,IBTMPARR),"^",16)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,16)),"^",1)
+25 SET $PIECE(^TMP($JOB,IBTMPARR),"^",17)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,17))
+26 SET $PIECE(^TMP($JOB,IBTMPARR),"^",18)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,10.6))
+27 SET $PIECE(^TMP($JOB,IBTMPARR),"^",19)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,10.3)),"^",1)
+28 SET ZEROOUT=^TMP($JOB,IBTMPARR)
+29 KILL ^TMP($JOB,IBTMPARR)
End DoDot:1
+30 IF '$TEST
SET ZEROOUT=""
+31 KILL ^TMP($JOB,LIST)
+32 QUIT ZEROOUT
RXSEC(PDFN,RXIEN) ;Returns second node of file 52
+1 NEW SECOUT,LIST,IBTMPARR,NODE
+2 IF '$GET(PDFN)
SET SECOUT=""
QUIT SECOUT
+3 IF '$GET(RXIEN)
SET SECOUT=""
QUIT SECOUT
+4 SET NODE=2
+5 SET LIST="IBSECARR"
+6 SET IBTMPARR="IBTMPSEC"
+7 DO RX^PSO52API(PDFN,LIST,RXIEN,,NODE,,)
+8 IF $PIECE(^TMP($JOB,LIST,PDFN,0),"^",1)>0
Begin DoDot:1
+9 SET $PIECE(^TMP($JOB,IBTMPARR),"^",1)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,21)),"^",1)
+10 SET $PIECE(^TMP($JOB,IBTMPARR),"^",2)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,22)),"^",1)
+11 SET $PIECE(^TMP($JOB,IBTMPARR),"^",3)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,23)),"^",1)
+12 SET $PIECE(^TMP($JOB,IBTMPARR),"^",4)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,24))
+13 SET $PIECE(^TMP($JOB,IBTMPARR),"^",5)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,25)),"^",1)
+14 SET $PIECE(^TMP($JOB,IBTMPARR),"^",6)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,26)),"^",1)
+15 SET $PIECE(^TMP($JOB,IBTMPARR),"^",7)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,27))
+16 SET $PIECE(^TMP($JOB,IBTMPARR),"^",8)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,28))
+17 SET $PIECE(^TMP($JOB,IBTMPARR),"^",9)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,20)),"^",1)
+18 SET $PIECE(^TMP($JOB,IBTMPARR),"^",10)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,104)),"^",1)
+19 SET $PIECE(^TMP($JOB,IBTMPARR),"^",11)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,29)),"^",1)
+20 SET $PIECE(^TMP($JOB,IBTMPARR),"^",12)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,30))
+21 SET $PIECE(^TMP($JOB,IBTMPARR),"^",13)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,31)),"^",1)
+22 SET $PIECE(^TMP($JOB,IBTMPARR),"^",14)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,32.2)),"^",1)
+23 SET $PIECE(^TMP($JOB,IBTMPARR),"^",15)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,32.1)),"^",1)
+24 SET $PIECE(^TMP($JOB,IBTMPARR),"^",16)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,32.3))
+25 SET SECOUT=^TMP($JOB,IBTMPARR)
+26 KILL ^TMP($JOB,IBTMPARR)
End DoDot:1
+27 IF '$TEST
SET SECOUT=""
+28 KILL ^TMP($JOB,LIST)
+29 QUIT SECOUT
RX3(PDFN,RXIEN) ;Returns third node of file 52
+1 NEW THRDOUT,LIST,IBTMPARR,NODE
+2 IF '$GET(PDFN)
SET THRDOUT=""
QUIT THRDOUT
+3 IF '$GET(RXIEN)
SET THRDOUT=""
QUIT THRDOUT
+4 SET NODE=3
+5 SET LIST="IBARRTHRD"
+6 SET IBTMPARR="IBTMP3"
+7 DO RX^PSO52API(PDFN,LIST,RXIEN,,NODE,,)
+8 IF $PIECE(^TMP($JOB,LIST,PDFN,0),"^",1)>0
Begin DoDot:1
+9 SET $PIECE(^TMP($JOB,IBTMPARR),"^",1)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,101)),"^",1)
+10 SET $PIECE(^TMP($JOB,IBTMPARR),"^",2)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,102)),"^",1)
+11 SET $PIECE(^TMP($JOB,IBTMPARR),"^",3)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,109)),"^",1)
+12 SET $PIECE(^TMP($JOB,IBTMPARR),"^",4)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,102.1)),"^",1)
+13 SET $PIECE(^TMP($JOB,IBTMPARR),"^",5)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,26.1)),"^",1)
+14 SET $PIECE(^TMP($JOB,IBTMPARR),"^",6)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,34.1)),"^",1)
+15 SET $PIECE(^TMP($JOB,IBTMPARR),"^",7)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,12))
+16 SET $PIECE(^TMP($JOB,IBTMPARR),"^",8)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,102.2))
+17 SET $PIECE(^TMP($JOB,IBTMPARR),"^",9)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,112))
+18 SET THRDOUT=^TMP($JOB,IBTMPARR)
+19 KILL ^TMP($JOB,IBTMPARR)
End DoDot:1
+20 IF '$TEST
SET THRDOUT=""
+21 KILL ^TMP($JOB,LIST)
+22 QUIT THRDOUT
ZEROSUB(PDFN,RXIEN,RXSUB) ;Returns zero node of subfile 52.1
+1 NEW ZSUBOUT,LIST,IBTMPARR,NODE
+2 IF '$GET(PDFN)
SET ZSUBOUT=""
QUIT ZSUBOUT
+3 IF '$GET(RXIEN)
SET ZSUBOUT=""
QUIT ZSUBOUT
+4 IF '$GET(RXSUB)
SET ZSUBOUT=""
QUIT ZSUBOUT
+5 SET NODE="R^^"_RXSUB
+6 SET LIST="IBSUBARR"
+7 SET IBTMPARR="IBTMPSUB"
+8 DO RX^PSO52API(PDFN,LIST,RXIEN,,NODE,,)
+9 IF $PIECE(^TMP($JOB,LIST,PDFN,RXIEN,"RF",0),"^",1)>0
Begin DoDot:1
+10 SET $PIECE(^TMP($JOB,IBTMPARR),"^",1)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,"RF",RXSUB,.01)),"^",1)
+11 SET $PIECE(^TMP($JOB,IBTMPARR),"^",2)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,"RF",RXSUB,2)),"^",1)
+12 SET $PIECE(^TMP($JOB,IBTMPARR),"^",3)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,"RF",RXSUB,3))
+13 SET $PIECE(^TMP($JOB,IBTMPARR),"^",4)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,"RF",RXSUB,1))
+14 SET $PIECE(^TMP($JOB,IBTMPARR),"^",5)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,"RF",RXSUB,4)),"^",1)
+15 SET $PIECE(^TMP($JOB,IBTMPARR),"^",6)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,"RF",RXSUB,5))
+16 SET $PIECE(^TMP($JOB,IBTMPARR),"^",7)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,"RF",RXSUB,6)),"^",1)
+17 SET $PIECE(^TMP($JOB,IBTMPARR),"^",8)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,"RF",RXSUB,7)),"^",1)
+18 SET $PIECE(^TMP($JOB,IBTMPARR),"^",9)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,"RF",RXSUB,8)),"^",1)
+19 SET $PIECE(^TMP($JOB,IBTMPARR),"^",10)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,"RF",RXSUB,1.1))
+20 SET $PIECE(^TMP($JOB,IBTMPARR),"^",11)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,"RF",RXSUB,1.2))
+21 SET $PIECE(^TMP($JOB,IBTMPARR),"^",12)=""
+22 SET $PIECE(^TMP($JOB,IBTMPARR),"^",13)=""
+23 SET $PIECE(^TMP($JOB,IBTMPARR),"^",14)=$GET(^TMP($JOB,LIST,PDFN,RXIEN,"RF",RXSUB,12))
+24 SET $PIECE(^TMP($JOB,IBTMPARR),"^",15)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,"RF",RXSUB,13)),"^",1)
+25 SET $PIECE(^TMP($JOB,IBTMPARR),"^",16)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,"RF",RXSUB,14)),"^",1)
+26 SET $PIECE(^TMP($JOB,IBTMPARR),"^",17)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,"RF",RXSUB,15)),"^",1)
+27 SET $PIECE(^TMP($JOB,IBTMPARR),"^",18)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,"RF",RXSUB,17)),"^",1)
+28 SET $PIECE(^TMP($JOB,IBTMPARR),"^",19)=$PIECE($GET(^TMP($JOB,LIST,PDFN,RXIEN,"RF",RXSUB,10.1)),"^",1)
+29 SET ZSUBOUT=^TMP($JOB,IBTMPARR)
+30 KILL ^TMP($JOB,IBTMPARR)
End DoDot:1
+31 IF '$TEST
SET ZSUBOUT=""
+32 KILL ^TMP($JOB,LIST)
+33 QUIT ZSUBOUT
RFNUM(RXIEN) ;
+1 NEW PDFN,RXSUB,LIST,IBTMPARR,NODE
+2 IF '$GET(RXIEN)
SET RXSUB=""
QUIT RXSUB
+3 SET PDFN=$$FILE^IBRXUTL(RXIEN,2)
+4 SET LIST="IBRFNARR"
+5 SET IBTMPARR="IBTMPRFN"
+6 SET NODE="R"
+7 DO RX^PSO52API(PDFN,LIST,RXIEN,,NODE,,)
+8 IF $PIECE(^TMP($JOB,LIST,PDFN,RXIEN,"RF",0),"^",1)>0
Begin DoDot:1
+9 SET RXSUB=^TMP($JOB,LIST,PDFN,RXIEN,"RF",0)
End DoDot:1
+10 IF '$TEST
SET RXSUB=""
+11 KILL ^TMP($JOB,LIST)
+12 QUIT RXSUB
IBND(DFN,RXIEN) ;Returns IB node
+1 NEW IBNDOUT,LIST,NODE,IBTMPARR
+2 IF '$GET(DFN)
SET IBNDOUT=""
QUIT IBNDOUT
+3 IF '$GET(RXIEN)
SET IBNDOUT=""
QUIT IBNDOUT
+4 SET LIST="IBIBNDARR"
+5 SET NODE="I^O"
+6 SET IBTMPARR="IBTMPIBND"
+7 DO RX^PSO52API(DFN,LIST,RXIEN,,NODE,,)
+8 IF $PIECE(^TMP($JOB,LIST,DFN,0),"^",1)>0
Begin DoDot:1
+9 SET $PIECE(^TMP($JOB,IBTMPARR),"^",1)=$PIECE($GET(^TMP($JOB,LIST,DFN,RXIEN,105)),"^",1)
+10 SET $PIECE(^TMP($JOB,IBTMPARR),"^",2)=$PIECE($GET(^TMP($JOB,LIST,DFN,RXIEN,106)),"^",1)
+11 SET $PIECE(^TMP($JOB,IBTMPARR),"^",3)=$GET(^TMP($JOB,LIST,DFN,RXIEN,106.5))
+12 SET $PIECE(^TMP($JOB,IBTMPARR),"^",4)=$GET(^TMP($JOB,LIST,DFN,RXIEN,106.6))
+13 SET IBNDOUT=^TMP($JOB,IBTMPARR)
+14 if IBNDOUT="^^^"
SET IBNDOUT=""
+15 KILL ^TMP($JOB,IBTMPARR)
End DoDot:1
+16 IF '$TEST
SET IBNDOUT=""
+17 KILL ^TMP($JOB,LIST)
+18 QUIT IBNDOUT
IBNDFL(DFN,RXIEN,RXRFL) ;
+1 NEW IBNDFL,LIST,NODE,IBTMPARR
+2 IF '$GET(DFN)
SET IBNDFL=""
QUIT IBNDFL
+3 IF '$GET(RXIEN)
SET IBNDFL=""
QUIT IBNDFL
+4 IF '$GET(RXRFL)
SET IBNDFL=""
QUIT IBNDFL
+5 SET LIST="IBIBNDFLARR"
+6 SET NODE="I^R^"_RXRFL
+7 SET IBTMPARR="IBTMPIBNDFL"
+8 DO RX^PSO52API(DFN,LIST,RXIEN,,NODE,,)
+9 IF ^TMP($JOB,LIST,DFN,RXIEN,"IB",0)>0
Begin DoDot:1
+10 SET $PIECE(^TMP($JOB,IBTMPARR),"^",1)=$GET(^TMP($JOB,LIST,DFN,RXIEN,"IB",RXRFL,9))
+11 SET $PIECE(^TMP($JOB,IBTMPARR),"^",2)=$GET(^TMP($JOB,LIST,DFN,RXIEN,"IB",RXRFL,9.1))
+12 SET IBNDFL=^TMP($JOB,IBTMPARR)
+13 KILL ^TMP($JOB,IBTMPARR)
End DoDot:1
+14 IF '$TEST
SET IBNDFL=""
+15 KILL ^TMP($JOB,LIST)
+16 QUIT IBNDFL
+17 ;
RFLNUM(IBRXN,FLDT,IBFLG) ; find the refill number in file 52 for the given date
+1 NEW NUMOUT,NUM,DFN,LIST,NODE
+2 IF '$GET(IBRXN)
SET NUMOUT=""
QUIT NUMOUT
+3 IF '$GET(FLDT)
SET NUMOUT=""
QUIT NUMOUT
+4 SET LIST="IBRTMP"
+5 KILL ^TMP($JOB,LIST)
+6 SET NUM=0
+7 SET DFN=$$FILE(IBRXN,2)
+8 SET NODE="R^^"
+9 DO RX^PSO52API(DFN,LIST,IBRXN,,NODE,,)
+10 FOR
SET NUM=$ORDER(^TMP($JOB,LIST,DFN,IBRXN,"RF",NUM))
if 'NUM
QUIT
Begin DoDot:1
+11 IF $PIECE(^TMP($JOB,LIST,DFN,IBRXN,"RF",NUM,.01),"^",1)=FLDT
SET NUMOUT=NUM
End DoDot:1
+12 KILL ^TMP($JOB,LIST)
+13 if '$GET(NUMOUT)
SET NUMOUT=""
+14 QUIT NUMOUT
