RMPRPI03 ;HINCIO/ODJ - PIP Report APIs ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
; THIS - returns a ^TMP array structured as follows:-
; ^TMP($J,N,H,I,S)=data (^ delimiter)
;
; where N = ^TMP array name (eg. RMPRPI03)
; H = HCPCS code (eg. L5000)
; A = Item name
; I = Item number (eg. 1)
; S = Sequence (1,2,etc)
;
; data pc 1 = Date
; 2 = Time
; 3 = Opening Balance
; 4 = Closing Balance
; 5 = Quantity
; 6 = Value
; 7 = Transaction Type desc.
; 8 = Patient Name (if patient issue, else null)
; 9 = Patient SSN (if patient issue, else null)
; 10 = User name
;
THIS(RMPRNM,RMPRSTN,RMPRSDT,RMPREDT,RMPRHCPC) ;
N RMPRERR,RMPRH,RMPR,RMPROLD,RMPREOF,RMPRE,RMPR11
N RMPROBAL,RMPRCBAL,RMPRSEQ,RMPRRX,RMPRFMDT,RMPR60,RMPR69
N VA,VADM,DFN
S RMPRERR=0
I $G(RMPRNM)="" S RMPRNM="RMPRPI03"
I $G(RMPRSTN)="" S RMPRERR=1 G THISX
I '$D(RMPRHCPC) S RMPRHCPC="*"
K ^TMP($J,RMPRNM)
S RMPRH=""
THIS1 S RMPRH=$O(RMPRHCPC(RMPRH))
I RMPRH="" G THISX
K RMPR
S RMPR("HCPCS")=RMPRH
THIS1A S RMPR("DATE&TIME")=RMPRSDT
S RMPRERR=$$SRCH^RMPRPIXA(.RMPR,"XHDS","DATE&TIME",1,,.RMPREOF)
I RMPRERR G THISX
I RMPREOF G THIS1
I $G(RMPRHCPC)'="*",RMPR("HCPCS")'=RMPRH G THIS1
THIS2 S RMPRERR=$$NEXT^RMPRPIXA(.RMPR,"XHDS","",1,.RMPROLD,.RMPREOF)
I RMPRERR G THISX
I RMPREOF G THISX
I RMPROLD("HCPCS")'=RMPR("HCPCS") G:$G(RMPRHCPC)'="*" THIS1 G THIS1A
I RMPR("DATE")>RMPREDT G:$G(RMPRHCPC)="*" THIS3 G THIS1
S RMPRFMDT=RMPR("DATE")
K RMPRE
M RMPRE=RMPR
S RMPRERR=$$GET^RMPRPIX6(.RMPRE)
I RMPRERR G THISX
S RMPRERR=$$STNIEN^RMPRPIX6(.RMPRE)
I RMPRERR G THISX
I RMPRE("STATION IEN")'=RMPRSTN G THIS2
K RMPR11
S RMPR11("STATION")=RMPRSTN
S RMPR11("HCPCS")=RMPR("HCPCS")
S RMPR11("ITEM")=RMPRE("ITEM")
S RMPRERR=$$GET^RMPRPIX1(.RMPR11)
I '$D(RMPR11("DESCRIPTION")) S RMPR11("DESCRIPTION")="NO DESCRIPTION"
S RMPRSEQ=$O(^TMP($J,RMPRNM,RMPR("HCPCS"),RMPR11("DESCRIPTION"),RMPRE("ITEM"),""),-1)
I RMPRSEQ'="" D
. S RMPROBAL=$P(^TMP($J,RMPRNM,RMPR("HCPCS"),RMPR11("DESCRIPTION"),RMPRE("ITEM"),RMPRSEQ),"^",4)
. Q
E D
. K RMPRRX
. S RMPRRX("STA")=RMPRSTN
. S RMPRRX("HCP")=RMPR("HCPCS")
. S RMPRRX("ITE")=RMPRE("ITEM")
. S RMPRRX("RDT")=RMPRSDT
. S RMPROBAL=$$SQTY^RMPRPIXJ(.RMPRRX)
. Q
S RMPRERR=$$TFLOW^RMPRPIX6(.RMPRE)
I RMPRE("TRAN FLOW")="+" D
. S RMPRCBAL=RMPROBAL+RMPRE("QUANTITY")
. Q
I RMPRE("TRAN FLOW")="-" D
. S RMPRCBAL=RMPROBAL-RMPRE("QUANTITY")
. Q
I RMPRE("TRAN FLOW")="=" D
. K RMPR69
. S RMPR69("TRANS IEN")=RMPRE("IEN")
. S RMPRERR=$$GET^RMPRPIXB(.RMPR69)
. I '$D(RMPR69("GAIN/LOSS")) S (RMPRE("QUANTITY"),RMPRE("VALUE"),RMPROBAL,RMPRCBAL)=0 Q
. S RMPRCBAL=RMPROBAL+RMPR69("GAIN/LOSS")
. S RMPRE("QUANTITY")=RMPR69("GAIN/LOSS")
. S RMPRE("VALUE")=RMPR69("GAIN/LOSS VALUE")
. Q
I RMPRE("TRAN FLOW")="" D
. S RMPRCBAL=RMPROBAL
. Q
S RMPRSTR=""
S $P(RMPRSTR,"^",1)=$E(RMPRFMDT,4,5)_"/"_$E(RMPRFMDT,6,7)_"/"_$E(RMPRFMDT,2,3)
S $P(RMPRSTR,"^",2)=RMPRE("TIME")
S $P(RMPRSTR,"^",3)=RMPROBAL
S $P(RMPRSTR,"^",4)=RMPRCBAL
S $P(RMPRSTR,"^",5)=RMPRE("QUANTITY")
S $P(RMPRSTR,"^",6)=RMPRE("VALUE")
S $P(RMPRSTR,"^",7)=RMPRE("TRAN TYPE")
S $P(RMPRSTR,"^",10)=RMPRE("USER")
K RMPR60
S RMPRERR=$$IEN60^RMPRPIX6(.RMPRE,.RMPR60)
I 'RMPRERR,$G(RMPR60("IEN"))'="" D
. S DFN=$P($G(^RMPR(660,RMPR60("IEN"),0)),"^",2)
. D DEM^VADPT
. S $P(RMPRSTR,"^",8)=$G(VADM(1))
. S $P(RMPRSTR,"^",9)=$P($G(VADM(2)),"^",2)
. Q
S ^TMP($J,RMPRNM,RMPR("HCPCS"),RMPR11("DESCRIPTION"),RMPRE("ITEM"),RMPRSEQ+1)=RMPRSTR
G THIS2
THIS3 S RMPRERR=$$NEXT^RMPRPIXA(.RMPR,"XHDS","HCPCS",1,.RMPROLD,.RMPREOF)
I RMPREOF G THISX
G THIS1A
THISX Q RMPRERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPI03 3899 printed Dec 13, 2024@02:35:57 Page 2
RMPRPI03 ;HINCIO/ODJ - PIP Report APIs ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ; THIS - returns a ^TMP array structured as follows:-
+5 ; ^TMP($J,N,H,I,S)=data (^ delimiter)
+6 ;
+7 ; where N = ^TMP array name (eg. RMPRPI03)
+8 ; H = HCPCS code (eg. L5000)
+9 ; A = Item name
+10 ; I = Item number (eg. 1)
+11 ; S = Sequence (1,2,etc)
+12 ;
+13 ; data pc 1 = Date
+14 ; 2 = Time
+15 ; 3 = Opening Balance
+16 ; 4 = Closing Balance
+17 ; 5 = Quantity
+18 ; 6 = Value
+19 ; 7 = Transaction Type desc.
+20 ; 8 = Patient Name (if patient issue, else null)
+21 ; 9 = Patient SSN (if patient issue, else null)
+22 ; 10 = User name
+23 ;
THIS(RMPRNM,RMPRSTN,RMPRSDT,RMPREDT,RMPRHCPC) ;
+1 NEW RMPRERR,RMPRH,RMPR,RMPROLD,RMPREOF,RMPRE,RMPR11
+2 NEW RMPROBAL,RMPRCBAL,RMPRSEQ,RMPRRX,RMPRFMDT,RMPR60,RMPR69
+3 NEW VA,VADM,DFN
+4 SET RMPRERR=0
+5 IF $GET(RMPRNM)=""
SET RMPRNM="RMPRPI03"
+6 IF $GET(RMPRSTN)=""
SET RMPRERR=1
GOTO THISX
+7 IF '$DATA(RMPRHCPC)
SET RMPRHCPC="*"
+8 KILL ^TMP($JOB,RMPRNM)
+9 SET RMPRH=""
THIS1 SET RMPRH=$ORDER(RMPRHCPC(RMPRH))
+1 IF RMPRH=""
GOTO THISX
+2 KILL RMPR
+3 SET RMPR("HCPCS")=RMPRH
THIS1A SET RMPR("DATE&TIME")=RMPRSDT
+1 SET RMPRERR=$$SRCH^RMPRPIXA(.RMPR,"XHDS","DATE&TIME",1,,.RMPREOF)
+2 IF RMPRERR
GOTO THISX
+3 IF RMPREOF
GOTO THIS1
+4 IF $GET(RMPRHCPC)'="*"
IF RMPR("HCPCS")'=RMPRH
GOTO THIS1
THIS2 SET RMPRERR=$$NEXT^RMPRPIXA(.RMPR,"XHDS","",1,.RMPROLD,.RMPREOF)
+1 IF RMPRERR
GOTO THISX
+2 IF RMPREOF
GOTO THISX
+3 IF RMPROLD("HCPCS")'=RMPR("HCPCS")
if $GET(RMPRHCPC)'="*"
GOTO THIS1
GOTO THIS1A
+4 IF RMPR("DATE")>RMPREDT
if $GET(RMPRHCPC)="*"
GOTO THIS3
GOTO THIS1
+5 SET RMPRFMDT=RMPR("DATE")
+6 KILL RMPRE
+7 MERGE RMPRE=RMPR
+8 SET RMPRERR=$$GET^RMPRPIX6(.RMPRE)
+9 IF RMPRERR
GOTO THISX
+10 SET RMPRERR=$$STNIEN^RMPRPIX6(.RMPRE)
+11 IF RMPRERR
GOTO THISX
+12 IF RMPRE("STATION IEN")'=RMPRSTN
GOTO THIS2
+13 KILL RMPR11
+14 SET RMPR11("STATION")=RMPRSTN
+15 SET RMPR11("HCPCS")=RMPR("HCPCS")
+16 SET RMPR11("ITEM")=RMPRE("ITEM")
+17 SET RMPRERR=$$GET^RMPRPIX1(.RMPR11)
+18 IF '$DATA(RMPR11("DESCRIPTION"))
SET RMPR11("DESCRIPTION")="NO DESCRIPTION"
+19 SET RMPRSEQ=$ORDER(^TMP($JOB,RMPRNM,RMPR("HCPCS"),RMPR11("DESCRIPTION"),RMPRE("ITEM"),""),-1)
+20 IF RMPRSEQ'=""
Begin DoDot:1
+21 SET RMPROBAL=$PIECE(^TMP($JOB,RMPRNM,RMPR("HCPCS"),RMPR11("DESCRIPTION"),RMPRE("ITEM"),RMPRSEQ),"^",4)
+22 QUIT
End DoDot:1
+23 IF '$TEST
Begin DoDot:1
+24 KILL RMPRRX
+25 SET RMPRRX("STA")=RMPRSTN
+26 SET RMPRRX("HCP")=RMPR("HCPCS")
+27 SET RMPRRX("ITE")=RMPRE("ITEM")
+28 SET RMPRRX("RDT")=RMPRSDT
+29 SET RMPROBAL=$$SQTY^RMPRPIXJ(.RMPRRX)
+30 QUIT
End DoDot:1
+31 SET RMPRERR=$$TFLOW^RMPRPIX6(.RMPRE)
+32 IF RMPRE("TRAN FLOW")="+"
Begin DoDot:1
+33 SET RMPRCBAL=RMPROBAL+RMPRE("QUANTITY")
+34 QUIT
End DoDot:1
+35 IF RMPRE("TRAN FLOW")="-"
Begin DoDot:1
+36 SET RMPRCBAL=RMPROBAL-RMPRE("QUANTITY")
+37 QUIT
End DoDot:1
+38 IF RMPRE("TRAN FLOW")="="
Begin DoDot:1
+39 KILL RMPR69
+40 SET RMPR69("TRANS IEN")=RMPRE("IEN")
+41 SET RMPRERR=$$GET^RMPRPIXB(.RMPR69)
+42 IF '$DATA(RMPR69("GAIN/LOSS"))
SET (RMPRE("QUANTITY"),RMPRE("VALUE"),RMPROBAL,RMPRCBAL)=0
QUIT
+43 SET RMPRCBAL=RMPROBAL+RMPR69("GAIN/LOSS")
+44 SET RMPRE("QUANTITY")=RMPR69("GAIN/LOSS")
+45 SET RMPRE("VALUE")=RMPR69("GAIN/LOSS VALUE")
+46 QUIT
End DoDot:1
+47 IF RMPRE("TRAN FLOW")=""
Begin DoDot:1
+48 SET RMPRCBAL=RMPROBAL
+49 QUIT
End DoDot:1
+50 SET RMPRSTR=""
+51 SET $PIECE(RMPRSTR,"^",1)=$EXTRACT(RMPRFMDT,4,5)_"/"_$EXTRACT(RMPRFMDT,6,7)_"/"_$EXTRACT(RMPRFMDT,2,3)
+52 SET $PIECE(RMPRSTR,"^",2)=RMPRE("TIME")
+53 SET $PIECE(RMPRSTR,"^",3)=RMPROBAL
+54 SET $PIECE(RMPRSTR,"^",4)=RMPRCBAL
+55 SET $PIECE(RMPRSTR,"^",5)=RMPRE("QUANTITY")
+56 SET $PIECE(RMPRSTR,"^",6)=RMPRE("VALUE")
+57 SET $PIECE(RMPRSTR,"^",7)=RMPRE("TRAN TYPE")
+58 SET $PIECE(RMPRSTR,"^",10)=RMPRE("USER")
+59 KILL RMPR60
+60 SET RMPRERR=$$IEN60^RMPRPIX6(.RMPRE,.RMPR60)
+61 IF 'RMPRERR
IF $GET(RMPR60("IEN"))'=""
Begin DoDot:1
+62 SET DFN=$PIECE($GET(^RMPR(660,RMPR60("IEN"),0)),"^",2)
+63 DO DEM^VADPT
+64 SET $PIECE(RMPRSTR,"^",8)=$GET(VADM(1))
+65 SET $PIECE(RMPRSTR,"^",9)=$PIECE($GET(VADM(2)),"^",2)
+66 QUIT
End DoDot:1
+67 SET ^TMP($JOB,RMPRNM,RMPR("HCPCS"),RMPR11("DESCRIPTION"),RMPRE("ITEM"),RMPRSEQ+1)=RMPRSTR
+68 GOTO THIS2
THIS3 SET RMPRERR=$$NEXT^RMPRPIXA(.RMPR,"XHDS","HCPCS",1,.RMPROLD,.RMPREOF)
+1 IF RMPREOF
GOTO THISX
+2 GOTO THIS1A
THISX QUIT RMPRERR
