RMPRPI03.m

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 ---RMPRPI03   3899     printed  Feb 19, 2025@00:02:25                                                                                                                                                                                                    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