RMPOBIL2 ;EDS/MDB - HOME OXYGEN BILLING TRANSACTIONS ;7/28/98
;;3.0;PROSTHETICS;**29,44,46,50,110,165**;Feb 09, 1996;Build 4
; ODJ patch 50 - Fix crashes reported in NOIS LIT-0600-70930
Q
2319 ; SHOW PAGE 8 OF 2319
;S:$D(RMPRDFN)&('$D(RMPODFN)) RMPODFN=RMPRDFN
S RMPODFN=RMPRDFN
D BPI,DPI
K DIR S DIR(0)="E" D ^DIR I $$QUIT G ASK1^RMPRPAT
D ^RMPOBIL5
K PTI,I,RX,Y,DT1,DT2,TRX,IENS,DFN
Q
QUIT() S QUIT=$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q QUIT
EQUIT() S QUIT=$D(DTOUT)!$D(Y) Q QUIT
LJ(S,W,C) ; Left justify S in a field W wide padding with char C
;
S C=$G(C," ") ; Default pad char is space
I $L(S)'=W S $P(S,C,W-$L(S)+$L(S,C))=""
Q $E(S,1,W)
EDIT ;NEW billing transaction edit module
;This module edits a single billing transaction (trx)
;a single trx is identified by 4 values
; site, billing month, vendor, and patient
; these four values represent an entry in file 665.72
;
Q:'($D(RMPOXITE)&$D(RMPORVDT)&$D(RMPOVDR)&$D(RMPODFN))
Q:'$D(^RMPO(665.72,+RMPOXITE,1,+RMPORVDT,1,+RMPOVDR,"V",+RMPODFN))
; previous two lines for development only - shouldn't be needed
;
D ITEM
EXIT L -^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,0)
K ITM,IEN,IENS,ITMACT,PTI,TMP,ZX1,TOT,T910,OTH,A,RX,TRX,DT1,DT2
K DIC,DIE,DA,DR,DO,DD,DIR,DIK,DIROUT,DUOUT
K TIEN,FCP,DFN,I,ITEM,NEW,QUIT,TOTAL,VADM,X,Y,Z,Z1,Z2,ZV,Z3
K PSTFLG,PITM,BACKPTR,POSTED,SUSP,DFCP,C,W,S,CIEN,RMIT,RMDIC
Q
QUIK ; QUICK ITEM EDIT
;
I '$$OK2EDIT D Q
. W !,$C(7)_"Cannot edit Accepted Transactions. "
. W "Please 'Unaccept' first." K DIR S DIR(0)="E" D ^DIR
I $$LOCKED D Q
. W !,$C(7)_"Record is locked. " K DIR S DIR(0)="E" D ^DIR
D ITEMD
F I=1:1:IEN D Q:QUIT
. W !,ITM(I)
.K DR D SDICE
.S DA=IEN(I),DR="7" D ^DIE Q:$$EQUIT
.S Z=^RMPO(665.72,DA(4),1,DA(3),1,DA(2),"V",DA(1),1,DA,0)
.S Z1=$P(Z,U,7),Z2=$P(Z,U,5),Z3=$P(Z,U,11)
.S DR="6///"_((Z1*Z2)-Z3) D ^DIE Q:$$EQUIT
D BII,DII
K DIR S DIR(0)="E" D ^DIR Q:$$QUIT
G EXIT
Q
ITEM ; Main edit loop
;
I '$$OK2EDIT D Q
. W !,$C(7)_"Cannot edit Accepted Transactions. "
. W "Please 'Unaccept' first." K DIR S DIR(0)="E" D ^DIR
I $$LOCKED D Q
. W !,$C(7)_"Record is locked. " K DIR S DIR(0)="E" D ^DIR
;
ITEMLOOP ;
;
S QUIT=0
D ITEMD
; ask for ACTION, quit if <return>, timeout, etc
S ITMACT=$$ITEMO Q:$$QUIT!(ITMACT="")
; if they entered 'A', do ADD ITEM, then edit it
I ITMACT="A" D ITEMA Q:QUIT!(ITEM="") D ITEME Q:QUIT G ITEMLOOP
; if they entered 'D', select an item, then delete it
I ITMACT="D" D ITEMS Q:QUIT!(ITEM="") D ITEMK G ITEMLOOP
; if they entered 'E', select an item, then edit it
I ITMACT="E" D ITEMS Q:QUIT!(ITEM="") D ITEME Q:QUIT G ITEMLOOP
; if they entered 'Z', select an item, then zero it
I ITMACT="Z" D ITEMS Q:QUIT!(ITEM="") D ITEMZ Q:QUIT G ITEMLOOP
G ITEMLOOP
Q
OK2EDIT() ;
;
Q $P(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,0),U,2)'="Y"
Q
LOCKED() ;
;
L +^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,0):2
Q '$T
Q
ITEMD ; Display items
;
D BPI,DPI,BII,DII
Q
BPI ; Build pt info hdr
K PTI
; Name,SSN
S DFN=RMPODFN D DEM^VADPT
S PTI(1)=VADM(1)_" "_$P(VADM(2),U,2)
; Current Rx (IEN on ACT DATE)
S RX=$O(^RMPR(665,RMPODFN,"RMPOB"," "),-1)
Q:'RX
S Y=$P(^RMPR(665,RMPODFN,"RMPOB",RX,0),U) X ^DD("DD") S DT1=Y
S Y=$P(^RMPR(665,RMPODFN,"RMPOB",RX,0),U,3) X ^DD("DD") S DT2=Y
S PTI(2)="Current Prescription (#"_RX_")"
S PTI(3)=" Active Date: "_DT1_" Expiration Date: "_DT2
; Rx Remarks
K TRX
S IENS=RX_","_RMPODFN_","
D GETS^DIQ(665.193,IENS,3,,"TRX")
S I=0 F S I=$O(TRX(665.193,IENS,3,I)) Q:I="" D
. S PTI(3+I)=" "_TRX(665.193,IENS,3,I)
Q
DPI ; Display pt info hdr
S I=0 F S I=$O(PTI(I)) Q:I="" W !,PTI(I)
Q
BII ; Build item info array
K TRX,ITM,TOT,SUSP,POSTED,PITM,IEN,CIEN
S SUSP=0,CIEN=1
S IENS=RMPODFN_","_RMPOVDR_","_RMPORVDT_","_RMPOXITE
D GETS^DIQ(665.72319,IENS,"**","IE","TRX")
S ZX1=""
F IEN=0:1 S ZX1=$O(TRX(665.723191,ZX1)) Q:ZX1="" D
. K TMP M TMP=TRX(665.723191,ZX1)
. F Z=5,6,10 S TMP(Z,"E")=$J($G(TMP(Z,"E")),0,2)
. S TIEN=+ZX1 D BIIL
K TMP
S TMP(2,"E")="HCPCS"
S TMP(.01,"E")="Description"
S TMP(3,"E")="FCP"
S TMP(7,"E")="Qty"
S TMP(5,"E")="Cost"
S TMP(6,"E")="Total"
S TMP(8,"I")=" "
S TMP(10,"E")="Susp."
S (CIEN,TIEN)=0 D BIIL
Q
BIIL ;Build detail line
;
S:TIEN IEN(CIEN)=TIEN ;S:TIEN IEN(TIEN)=TIEN
S ITM(CIEN)=" "
;S:TIEN ITM(TIEN)=$J(TIEN,2)_"." ; ITEM #
S:TIEN ITM(CIEN)=$J(CIEN,2)_"." ; ITEM #
S PSTFLG=$S($G(TMP(8,"I"))="Y":"p",1:" ")
S BACKPTR=$G(TMP(12,"I"))
S TMP(.01,"E")=$G(TMP(.01,"E"))_" "
S ITM(CIEN)=ITM(CIEN)_$$LJ(PSTFLG,2) ; POSTED
S ITM(CIEN)=ITM(CIEN)_$$LJ($G(TMP(2,"E")),7) ; HCPCS
S ITM(CIEN)=ITM(CIEN)_$$LJ($G(TMP(.01,"E")),30) ; ITEM DESCR
S ITM(CIEN)=ITM(CIEN)_" "_$$LJ($P($G(TMP(3,"E"))," "),5) ; FCP
S ITM(CIEN)=ITM(CIEN)_$J($G(TMP(7,"E")),5) ; QTY
S ITM(CIEN)=ITM(CIEN)_$J($G(TMP(5,"E")),8) ; UNIT COST
S ITM(CIEN)=ITM(CIEN)_$J($G(TMP(10,"E")),8) ; SUSP
S ITM(CIEN)=ITM(CIEN)_$J($G(TMP(6,"E")),8) ; QTY * CST
; Quit if we're doing the header
Q:TIEN=0
I $G(TMP(8,"I"))="Y" S POSTED(TIEN)=""
; Do totals while we're here
S FCP=+TMP(3,"E"),TOTAL=TMP(6,"E")
S TOT(FCP)=$G(TOT(FCP))+TOTAL
S TOT=$G(TOT)+TOTAL
S SUSP=SUSP+$G(TMP(10,"E")),CIEN=CIEN+1
Q
DII ; Display item info array
; Patch RMPR*3.0*165 removes 910 total line and replaces with FCP breakout for those FCPs now associated with HO billing.
Q:'$G(IEN)
N RMPOFCP,RMPOSITE S RMPOFCP=0,RMPOSITE=$P($G(^RMPR(669.9,RMPOXITE,0)),U,2)
W ! F I=0:1:IEN W !,ITM(I)
W !!,"TOTAL COST",?72,$J(TOT,6,2),!
F S RMPOFCP=$O(TOT(RMPOFCP)) Q:RMPOFCP="" D
. W !,"Total ",$P($G(^PRC(420,RMPOSITE,1,RMPOFCP,0)),U)," Charges:",?72,$J(+$G(TOT(RMPOFCP)),6,2)
W !
Q
ITEMO() ; Select action (A/E/D/Z)
K DIR
S DIR(0)="SBO^A:Add;D:Delete;E:Edit;Z:Zero"
S DIR("A")="Select ACTION" D ^DIR
Q Y
Q
ITEMA ; Add an item
S ITEM=""
K DIC S DIC="^RMPR(661,",DIC(0)="AEQMZ" D ^DIC Q:Y<0!$$QUIT
S NEW=+Y
K DD,DO D SDICE S DIC(0)="LN" S X=NEW
D FILE^DICN Q:Y<0!$$QUIT
S DA=+Y,DR="2;9" D ^DIE I $$EQUIT S DIK=DIE D WAK Q
;S FCP=$$GETFCP^RMPOBILU I $$QUIT!(FCP<0) S DIK=DIE D WAK Q
;S DR="3///"_$P(FCP,U,2) D ^DIE I $$EQUIT S DIK=DIE D WAK Q
;S ITEM=DA,IEN=$G(IEN)+1,IEN(IEN)=ITEM
S IEN=$G(IEN)+1,IEN(IEN)=DA,ITEM=IEN
Q
SDICE ; Set DIC,DIE,DA for adding Trx items
K DIC,DIE,DA
S ZV=",""V"","
S DA(1)=RMPODFN,DA(2)=RMPOVDR,DA(3)=RMPORVDT,DA(4)=RMPOXITE
S DIC="^RMPO(665.72,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_ZV_DA(1)_",1,"
S DIE=DIC
Q
ITEMS ; Select an item
I IEN=1 S ITEM=1 Q
K DIR
S ITEM=""
S DIR(0)="NO^1:"_IEN,DIR("A")="Select an ITEM"
S DIR("?")="Note: You cannot select POSTED items"
M DIR("?")=ITM
D ^DIR Q:Y'>0!$$QUIT
I $D(POSTED(+Y)) D G ITEMS
. W !,$C(7)_"Item "_(+Y)_" has been POSTED!"
S ITEM=+Y I $P($G(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,1,ITEM,0)),U,8)="Y" S PITM=ITEM
S BACKPTR=$P($G(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,1,ITEM,0)),U,13)
I $G(BACKPTR),$D(^RMPR(665,RMPODFN,"RMPOC",BACKPTR,0)),$P(^RMPR(665,RMPODFN,"RMPOC",BACKPTR,0),U,11)="Y" S PITM=ITEM
Q
ITEME ; Edit an item
K DR D SDICE
S DIE("NO^")="BACK"
S DA=IEN(ITEM),DR="1;7;S Z1=X;5;S Z2=X;4" D ^DIE Q:$$EQUIT
SACK S DR="10;S Z3=X" D ^DIE Q:$$EQUIT
I Z3>(Z1*Z2) D G SACK
. W !,"SUSPENDED AMT SHOULD NOT BE GREATER THAN TOTAL AMOUNT!"
S DR="11"_$S(+X=0:"///@",1:"") D ^DIE Q:$$EQUIT
S DR="6///"_((Z1*Z2)-Z3) D ^DIE Q:$$EQUIT
S DFCP=$P(^RMPO(665.72,DA(4),1,DA(3),1,DA(2),"V",DA(1),1,DA,0),U,3)
F D Q:(FCP>0)!QUIT
. S FCP=$P($$GETFCP^RMPOBILU(DFCP),U,2) Q:$$QUIT
. I FCP<0!(FCP="") W $C(7)_"REQUIRED FIELD!"
I FCP>0 S DR="3R///"_FCP_";13R;14" D ^DIE Q:$$EQUIT
Q
ITEMZ ; Zero an item
K DR D SDICE
S DA=IEN(ITEM),DR="5///0;6///0;10///0;11///@" D ^DIE Q:$$EQUIT
Q
ITEMK ; Delete an item
D SDICE
S RMDIC=DIC_IEN(ITEM)_",0)",RMIT=$G(@RMDIC),PITM=$P(RMIT,U,8)
I PITM="Y" D Q
. W !,"Can't delete PRIMARY ITEM!"
K DIR S DIR(0)="Y",DIR("A")="Are you SURE you want to delete this item"
S DIR("B")="NO" D ^DIR Q:Y'>0
K DIK,DA D SDICE S DIK=DIC,DA=IEN(ITEM)
WAK D ^DIK W " ...deleted!"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOBIL2 8463 printed Dec 13, 2024@02:30:46 Page 2
RMPOBIL2 ;EDS/MDB - HOME OXYGEN BILLING TRANSACTIONS ;7/28/98
+1 ;;3.0;PROSTHETICS;**29,44,46,50,110,165**;Feb 09, 1996;Build 4
+2 ; ODJ patch 50 - Fix crashes reported in NOIS LIT-0600-70930
+3 QUIT
2319 ; SHOW PAGE 8 OF 2319
+1 ;S:$D(RMPRDFN)&('$D(RMPODFN)) RMPODFN=RMPRDFN
+2 SET RMPODFN=RMPRDFN
+3 DO BPI
DO DPI
+4 KILL DIR
SET DIR(0)="E"
DO ^DIR
IF $$QUIT
GOTO ASK1^RMPRPAT
+5 DO ^RMPOBIL5
+6 KILL PTI,I,RX,Y,DT1,DT2,TRX,IENS,DFN
+7 QUIT
QUIT() SET QUIT=$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT QUIT
EQUIT() SET QUIT=$DATA(DTOUT)!$DATA(Y)
QUIT QUIT
LJ(S,W,C) ; Left justify S in a field W wide padding with char C
+1 ;
+2 ; Default pad char is space
SET C=$GET(C," ")
+3 IF $LENGTH(S)'=W
SET $PIECE(S,C,W-$LENGTH(S)+$LENGTH(S,C))=""
+4 QUIT $EXTRACT(S,1,W)
EDIT ;NEW billing transaction edit module
+1 ;This module edits a single billing transaction (trx)
+2 ;a single trx is identified by 4 values
+3 ; site, billing month, vendor, and patient
+4 ; these four values represent an entry in file 665.72
+5 ;
+6 if '($DATA(RMPOXITE)&$DATA(RMPORVDT)&$DATA(RMPOVDR)&$DATA(RMPODFN))
QUIT
+7 if '$DATA(^RMPO(665.72,+RMPOXITE,1,+RMPORVDT,1,+RMPOVDR,"V",+RMPODFN))
QUIT
+8 ; previous two lines for development only - shouldn't be needed
+9 ;
+10 DO ITEM
EXIT LOCK -^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,0)
+1 KILL ITM,IEN,IENS,ITMACT,PTI,TMP,ZX1,TOT,T910,OTH,A,RX,TRX,DT1,DT2
+2 KILL DIC,DIE,DA,DR,DO,DD,DIR,DIK,DIROUT,DUOUT
+3 KILL TIEN,FCP,DFN,I,ITEM,NEW,QUIT,TOTAL,VADM,X,Y,Z,Z1,Z2,ZV,Z3
+4 KILL PSTFLG,PITM,BACKPTR,POSTED,SUSP,DFCP,C,W,S,CIEN,RMIT,RMDIC
+5 QUIT
QUIK ; QUICK ITEM EDIT
+1 ;
+2 IF '$$OK2EDIT
Begin DoDot:1
+3 WRITE !,$CHAR(7)_"Cannot edit Accepted Transactions. "
+4 WRITE "Please 'Unaccept' first."
KILL DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+5 IF $$LOCKED
Begin DoDot:1
+6 WRITE !,$CHAR(7)_"Record is locked. "
KILL DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+7 DO ITEMD
+8 FOR I=1:1:IEN
Begin DoDot:1
+9 WRITE !,ITM(I)
+10 KILL DR
DO SDICE
+11 SET DA=IEN(I)
SET DR="7"
DO ^DIE
if $$EQUIT
QUIT
+12 SET Z=^RMPO(665.72,DA(4),1,DA(3),1,DA(2),"V",DA(1),1,DA,0)
+13 SET Z1=$PIECE(Z,U,7)
SET Z2=$PIECE(Z,U,5)
SET Z3=$PIECE(Z,U,11)
+14 SET DR="6///"_((Z1*Z2)-Z3)
DO ^DIE
if $$EQUIT
QUIT
End DoDot:1
if QUIT
QUIT
+15 DO BII
DO DII
+16 KILL DIR
SET DIR(0)="E"
DO ^DIR
if $$QUIT
QUIT
+17 GOTO EXIT
+18 QUIT
ITEM ; Main edit loop
+1 ;
+2 IF '$$OK2EDIT
Begin DoDot:1
+3 WRITE !,$CHAR(7)_"Cannot edit Accepted Transactions. "
+4 WRITE "Please 'Unaccept' first."
KILL DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+5 IF $$LOCKED
Begin DoDot:1
+6 WRITE !,$CHAR(7)_"Record is locked. "
KILL DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+7 ;
ITEMLOOP ;
+1 ;
+2 SET QUIT=0
+3 DO ITEMD
+4 ; ask for ACTION, quit if <return>, timeout, etc
+5 SET ITMACT=$$ITEMO
if $$QUIT!(ITMACT="")
QUIT
+6 ; if they entered 'A', do ADD ITEM, then edit it
+7 IF ITMACT="A"
DO ITEMA
if QUIT!(ITEM="")
QUIT
DO ITEME
if QUIT
QUIT
GOTO ITEMLOOP
+8 ; if they entered 'D', select an item, then delete it
+9 IF ITMACT="D"
DO ITEMS
if QUIT!(ITEM="")
QUIT
DO ITEMK
GOTO ITEMLOOP
+10 ; if they entered 'E', select an item, then edit it
+11 IF ITMACT="E"
DO ITEMS
if QUIT!(ITEM="")
QUIT
DO ITEME
if QUIT
QUIT
GOTO ITEMLOOP
+12 ; if they entered 'Z', select an item, then zero it
+13 IF ITMACT="Z"
DO ITEMS
if QUIT!(ITEM="")
QUIT
DO ITEMZ
if QUIT
QUIT
GOTO ITEMLOOP
+14 GOTO ITEMLOOP
+15 QUIT
OK2EDIT() ;
+1 ;
+2 QUIT $PIECE(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,0),U,2)'="Y"
+3 QUIT
LOCKED() ;
+1 ;
+2 LOCK +^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,0):2
+3 QUIT '$TEST
+4 QUIT
ITEMD ; Display items
+1 ;
+2 DO BPI
DO DPI
DO BII
DO DII
+3 QUIT
BPI ; Build pt info hdr
+1 KILL PTI
+2 ; Name,SSN
+3 SET DFN=RMPODFN
DO DEM^VADPT
+4 SET PTI(1)=VADM(1)_" "_$PIECE(VADM(2),U,2)
+5 ; Current Rx (IEN on ACT DATE)
+6 SET RX=$ORDER(^RMPR(665,RMPODFN,"RMPOB"," "),-1)
+7 if 'RX
QUIT
+8 SET Y=$PIECE(^RMPR(665,RMPODFN,"RMPOB",RX,0),U)
XECUTE ^DD("DD")
SET DT1=Y
+9 SET Y=$PIECE(^RMPR(665,RMPODFN,"RMPOB",RX,0),U,3)
XECUTE ^DD("DD")
SET DT2=Y
+10 SET PTI(2)="Current Prescription (#"_RX_")"
+11 SET PTI(3)=" Active Date: "_DT1_" Expiration Date: "_DT2
+12 ; Rx Remarks
+13 KILL TRX
+14 SET IENS=RX_","_RMPODFN_","
+15 DO GETS^DIQ(665.193,IENS,3,,"TRX")
+16 SET I=0
FOR
SET I=$ORDER(TRX(665.193,IENS,3,I))
if I=""
QUIT
Begin DoDot:1
+17 SET PTI(3+I)=" "_TRX(665.193,IENS,3,I)
End DoDot:1
+18 QUIT
DPI ; Display pt info hdr
+1 SET I=0
FOR
SET I=$ORDER(PTI(I))
if I=""
QUIT
WRITE !,PTI(I)
+2 QUIT
BII ; Build item info array
+1 KILL TRX,ITM,TOT,SUSP,POSTED,PITM,IEN,CIEN
+2 SET SUSP=0
SET CIEN=1
+3 SET IENS=RMPODFN_","_RMPOVDR_","_RMPORVDT_","_RMPOXITE
+4 DO GETS^DIQ(665.72319,IENS,"**","IE","TRX")
+5 SET ZX1=""
+6 FOR IEN=0:1
SET ZX1=$ORDER(TRX(665.723191,ZX1))
if ZX1=""
QUIT
Begin DoDot:1
+7 KILL TMP
MERGE TMP=TRX(665.723191,ZX1)
+8 FOR Z=5,6,10
SET TMP(Z,"E")=$JUSTIFY($GET(TMP(Z,"E")),0,2)
+9 SET TIEN=+ZX1
DO BIIL
End DoDot:1
+10 KILL TMP
+11 SET TMP(2,"E")="HCPCS"
+12 SET TMP(.01,"E")="Description"
+13 SET TMP(3,"E")="FCP"
+14 SET TMP(7,"E")="Qty"
+15 SET TMP(5,"E")="Cost"
+16 SET TMP(6,"E")="Total"
+17 SET TMP(8,"I")=" "
+18 SET TMP(10,"E")="Susp."
+19 SET (CIEN,TIEN)=0
DO BIIL
+20 QUIT
BIIL ;Build detail line
+1 ;
+2 ;S:TIEN IEN(TIEN)=TIEN
if TIEN
SET IEN(CIEN)=TIEN
+3 SET ITM(CIEN)=" "
+4 ;S:TIEN ITM(TIEN)=$J(TIEN,2)_"." ; ITEM #
+5 ; ITEM #
if TIEN
SET ITM(CIEN)=$JUSTIFY(CIEN,2)_"."
+6 SET PSTFLG=$SELECT($GET(TMP(8,"I"))="Y":"p",1:" ")
+7 SET BACKPTR=$GET(TMP(12,"I"))
+8 SET TMP(.01,"E")=$GET(TMP(.01,"E"))_" "
+9 ; POSTED
SET ITM(CIEN)=ITM(CIEN)_$$LJ(PSTFLG,2)
+10 ; HCPCS
SET ITM(CIEN)=ITM(CIEN)_$$LJ($GET(TMP(2,"E")),7)
+11 ; ITEM DESCR
SET ITM(CIEN)=ITM(CIEN)_$$LJ($GET(TMP(.01,"E")),30)
+12 ; FCP
SET ITM(CIEN)=ITM(CIEN)_" "_$$LJ($PIECE($GET(TMP(3,"E"))," "),5)
+13 ; QTY
SET ITM(CIEN)=ITM(CIEN)_$JUSTIFY($GET(TMP(7,"E")),5)
+14 ; UNIT COST
SET ITM(CIEN)=ITM(CIEN)_$JUSTIFY($GET(TMP(5,"E")),8)
+15 ; SUSP
SET ITM(CIEN)=ITM(CIEN)_$JUSTIFY($GET(TMP(10,"E")),8)
+16 ; QTY * CST
SET ITM(CIEN)=ITM(CIEN)_$JUSTIFY($GET(TMP(6,"E")),8)
+17 ; Quit if we're doing the header
+18 if TIEN=0
QUIT
+19 IF $GET(TMP(8,"I"))="Y"
SET POSTED(TIEN)=""
+20 ; Do totals while we're here
+21 SET FCP=+TMP(3,"E")
SET TOTAL=TMP(6,"E")
+22 SET TOT(FCP)=$GET(TOT(FCP))+TOTAL
+23 SET TOT=$GET(TOT)+TOTAL
+24 SET SUSP=SUSP+$GET(TMP(10,"E"))
SET CIEN=CIEN+1
+25 QUIT
DII ; Display item info array
+1 ; Patch RMPR*3.0*165 removes 910 total line and replaces with FCP breakout for those FCPs now associated with HO billing.
+2 if '$GET(IEN)
QUIT
+3 NEW RMPOFCP,RMPOSITE
SET RMPOFCP=0
SET RMPOSITE=$PIECE($GET(^RMPR(669.9,RMPOXITE,0)),U,2)
+4 WRITE !
FOR I=0:1:IEN
WRITE !,ITM(I)
+5 WRITE !!,"TOTAL COST",?72,$JUSTIFY(TOT,6,2),!
+6 FOR
SET RMPOFCP=$ORDER(TOT(RMPOFCP))
if RMPOFCP=""
QUIT
Begin DoDot:1
+7 WRITE !,"Total ",$PIECE($GET(^PRC(420,RMPOSITE,1,RMPOFCP,0)),U)," Charges:",?72,$JUSTIFY(+$GET(TOT(RMPOFCP)),6,2)
End DoDot:1
+8 WRITE !
+9 QUIT
ITEMO() ; Select action (A/E/D/Z)
+1 KILL DIR
+2 SET DIR(0)="SBO^A:Add;D:Delete;E:Edit;Z:Zero"
+3 SET DIR("A")="Select ACTION"
DO ^DIR
+4 QUIT Y
+5 QUIT
ITEMA ; Add an item
+1 SET ITEM=""
+2 KILL DIC
SET DIC="^RMPR(661,"
SET DIC(0)="AEQMZ"
DO ^DIC
if Y<0!$$QUIT
QUIT
+3 SET NEW=+Y
+4 KILL DD,DO
DO SDICE
SET DIC(0)="LN"
SET X=NEW
+5 DO FILE^DICN
if Y<0!$$QUIT
QUIT
+6 SET DA=+Y
SET DR="2;9"
DO ^DIE
IF $$EQUIT
SET DIK=DIE
DO WAK
QUIT
+7 ;S FCP=$$GETFCP^RMPOBILU I $$QUIT!(FCP<0) S DIK=DIE D WAK Q
+8 ;S DR="3///"_$P(FCP,U,2) D ^DIE I $$EQUIT S DIK=DIE D WAK Q
+9 ;S ITEM=DA,IEN=$G(IEN)+1,IEN(IEN)=ITEM
+10 SET IEN=$GET(IEN)+1
SET IEN(IEN)=DA
SET ITEM=IEN
+11 QUIT
SDICE ; Set DIC,DIE,DA for adding Trx items
+1 KILL DIC,DIE,DA
+2 SET ZV=",""V"","
+3 SET DA(1)=RMPODFN
SET DA(2)=RMPOVDR
SET DA(3)=RMPORVDT
SET DA(4)=RMPOXITE
+4 SET DIC="^RMPO(665.72,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_ZV_DA(1)_",1,"
+5 SET DIE=DIC
+6 QUIT
ITEMS ; Select an item
+1 IF IEN=1
SET ITEM=1
QUIT
+2 KILL DIR
+3 SET ITEM=""
+4 SET DIR(0)="NO^1:"_IEN
SET DIR("A")="Select an ITEM"
+5 SET DIR("?")="Note: You cannot select POSTED items"
+6 MERGE DIR("?")=ITM
+7 DO ^DIR
if Y'>0!$$QUIT
QUIT
+8 IF $DATA(POSTED(+Y))
Begin DoDot:1
+9 WRITE !,$CHAR(7)_"Item "_(+Y)_" has been POSTED!"
End DoDot:1
GOTO ITEMS
+10 SET ITEM=+Y
IF $PIECE($GET(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,1,ITEM,0)),U,8)="Y"
SET PITM=ITEM
+11 SET BACKPTR=$PIECE($GET(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,1,ITEM,0)),U,13)
+12 IF $GET(BACKPTR)
IF $DATA(^RMPR(665,RMPODFN,"RMPOC",BACKPTR,0))
IF $PIECE(^RMPR(665,RMPODFN,"RMPOC",BACKPTR,0),U,11)="Y"
SET PITM=ITEM
+13 QUIT
ITEME ; Edit an item
+1 KILL DR
DO SDICE
+2 SET DIE("NO^")="BACK"
+3 SET DA=IEN(ITEM)
SET DR="1;7;S Z1=X;5;S Z2=X;4"
DO ^DIE
if $$EQUIT
QUIT
SACK SET DR="10;S Z3=X"
DO ^DIE
if $$EQUIT
QUIT
+1 IF Z3>(Z1*Z2)
Begin DoDot:1
+2 WRITE !,"SUSPENDED AMT SHOULD NOT BE GREATER THAN TOTAL AMOUNT!"
End DoDot:1
GOTO SACK
+3 SET DR="11"_$SELECT(+X=0:"///@",1:"")
DO ^DIE
if $$EQUIT
QUIT
+4 SET DR="6///"_((Z1*Z2)-Z3)
DO ^DIE
if $$EQUIT
QUIT
+5 SET DFCP=$PIECE(^RMPO(665.72,DA(4),1,DA(3),1,DA(2),"V",DA(1),1,DA,0),U,3)
+6 FOR
Begin DoDot:1
+7 SET FCP=$PIECE($$GETFCP^RMPOBILU(DFCP),U,2)
if $$QUIT
QUIT
+8 IF FCP<0!(FCP="")
WRITE $CHAR(7)_"REQUIRED FIELD!"
End DoDot:1
if (FCP>0)!QUIT
QUIT
+9 IF FCP>0
SET DR="3R///"_FCP_";13R;14"
DO ^DIE
if $$EQUIT
QUIT
+10 QUIT
ITEMZ ; Zero an item
+1 KILL DR
DO SDICE
+2 SET DA=IEN(ITEM)
SET DR="5///0;6///0;10///0;11///@"
DO ^DIE
if $$EQUIT
QUIT
+3 QUIT
ITEMK ; Delete an item
+1 DO SDICE
+2 SET RMDIC=DIC_IEN(ITEM)_",0)"
SET RMIT=$GET(@RMDIC)
SET PITM=$PIECE(RMIT,U,8)
+3 IF PITM="Y"
Begin DoDot:1
+4 WRITE !,"Can't delete PRIMARY ITEM!"
End DoDot:1
QUIT
+5 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Are you SURE you want to delete this item"
+6 SET DIR("B")="NO"
DO ^DIR
if Y'>0
QUIT
+7 KILL DIK,DA
DO SDICE
SET DIK=DIC
SET DA=IEN(ITEM)
WAK DO ^DIK
WRITE " ...deleted!"
+1 QUIT
