RMPOBILA ;HIN/RVD - BILLING TRANSACTIONS (ADD/DEL PATIENT) ;3/18/99
;;3.0;PROSTHETICS;**29,46,41**;Feb 09, 1996
;
ADD K DIC,RMPODFN
S DIC("S")="I '$D(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,""V"",+Y))"
S DIC="^RMPR(665,",DIC(0)="QEAMZ" D ^DIC I Y<0!$$QUIT G EXIT
S RMPODFN=+Y I $$VEN(RMPOVDR)<1 W !,"** Error: ",$$STAT(RMPODFN),! G EXIT
I $D(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN)) G EXIT
GETPAT ;get patient information
S ZXITM=0
F S ZXITM=$O(^RMPR(665,RMPODFN,"RMPOC",ZXITM)) Q:ZXITM'>0 D
. S ZX1=$G(^RMPR(665,RMPODFN,"RMPOC",ZXITM,0))
. Q:$P(ZX1,U,2)'=RMPOVDR D BUILDP,BUILDI W !,"Item ",$P(ZX1,U,1)," was added to Billing Transaction....",!
Q
;
VEN(RVEN) ; Determine whether to include trx for RMPODFN
;
; Do NOT process if not at correct site.
Q:$P($G(^RMPR(665,RMPODFN,"RMPOA")),U,7)'=RMPOXITE -1
;
; Do NOT process if no Boiler-plate
Q:'$D(^RMPR(665,RMPODFN,"RMPOA")) -2
;
; Do NOT process if Inactivation date less the billing date.
S RMPOINDT=$P($G(^RMPR(665,RMPODFN,"RMPOA")),U,3)
I $G(RMPOINDT) Q:RMPOINDT<RMPORVDT -3
;
; Do NOT process if no Rx
Q:'$D(^RMPR(665,RMPODFN,"RMPOB",0)) -4
;
; 1st find correct Rx
S RMPORX=$O(^RMPR(665,RMPODFN,"RMPOB","B"),-1)
Q:'RMPORX -5
;
; Quit if the Rx Expiration Date is before the billing period
Q:$P(^RMPR(665,RMPODFN,"RMPOB",RMPORX,0),U,3)<(RMPORVDT) -6
;
; Quit if there are no items.
Q:$O(^RMPR(665,RMPODFN,"RMPOC",0))'>0 -7
;
I $G(RVEN)>0 Q $$VDRSTAT(RVEN)
Q 1
;
VDRSTAT(VDR) ;
S ZXITM=0,FOUND=0
F S ZXITM=$O(^RMPR(665,RMPODFN,"RMPOC",ZXITM)) Q:ZXITM'>0 D
. I $P($G(^RMPR(665,RMPODFN,"RMPOC",ZXITM,0)),U,2)=VDR S FOUND=1
Q $S(FOUND=1:1,1:-8)
Q
;
BUILDP ;Now the Patient level
Q:$D(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN)) ; DONE
K DA,DIC,DD,DO
S DA(3)=RMPOXITE,DA(2)=RMPORVDT,DA(1)=RMPOVDR,(DINUM,X)=RMPODFN
S DIC("P")=$P(^DD(665.7231,9,0),U,2),DIC(0)="L",ZV=",""V"","
S DIC="^RMPO(665.72,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_ZV
D FILE^DICN
Q
;
BUILDI ; BUILD ITEM (REQUIRES ZX1 = ENTIRE ITEM NODE FROM FILE #665)
;Finally, set up the item multiple
K DA,DIC,DD,DO,DINUM,DIE,DR
S DA(4)=RMPOXITE,DA(3)=RMPORVDT,DA(2)=RMPOVDR,DA(1)=RMPODFN
S X=$P(ZX1,U),ZV=",""V"","
S DIC="^RMPO(665.72,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_ZV_DA(1)_",1,"
S DIC("P")=$P(^DD(665.72319,1,0),U,2),DIC(0)="L"
D FILE^DICN
S DIE=DIC,DA=+Y
;Do some calculations
;Multiply the unit cost by the number of units
S RMPOTOT=$P(ZX1,U,3)*$P(ZX1,U,4)
S RMREMARK=$P(ZX1,U,9)
S DR="1////"_$P(ZX1,U,11) ; PRIMARY ITEM
S DR=DR_";2////"_$P(ZX1,U,7) ; HCPCS CODE
S DR=DR_";3////"_$P(ZX1,U,6) ; FUND CONTROL POINT
S DR=DR_";4///^S X=RMREMARK" ; REMARKS
S DR=DR_";5///"_$P(ZX1,U,4) ; UNIT COST
S DR=DR_";6///"_$J($G(RMPOTOT),1,2) ; TOTAL (QTY X UNIT COST)
S DR=DR_";7///"_$P(ZX1,U,3) ; QUANTITY
S DR=DR_";8////"_$P(ZX1,U,8) ; ICD-9 CODE
S DR=DR_";12////"_ZXITM ; IEN OF ITEM
S DR=DR_";13////"_$P(ZX1,U,10) ; ITEM TYPE
S DR=DR_";14////"_$P(ZX1,U,5) ; UNIT OF ISSUE
S DR=DR_";17////"_$P(ZX1,U,12) ; RENTAL FLAG
S DR=DR_";18////"_$P(ZX1,U,13) ; OXYGEN CONSERVING FLAG
D ^DIE
Q
STAT(RMPODFN) ;STATUS OF PT FOR GIVEN BUILD
S OK=$$VEN($G(RMPOVDR))
Q:OK=1 "OK"
Q:OK=-1 "Different Home Oxygen Contract Location"
Q:OK=-2 "No Home Oxygen Information"
Q:OK=-3 "Deactivated"
Q:OK=-4 "No RX on file"
Q:OK=-5 "No RX on file"
Q:OK=-6 "RX expires prior to billing period"
Q:OK=-7 "No items on file"
Q:OK=-8 "No items for vendor"
Q "Other Unknown Error"
Q
QUIT() S QUIT=$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q QUIT
;
EXIT ;Kill variables before quitting
K DIC,RMPODFN,DA,DIR,Y,X,ZXITM
Q
;
DEL I '$$OK2EDIT D Q
. W !,$C(7)_"Cannot DELETE a Posted or Partially Posted Transactions. "
. 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
K DIR S DIR("A")="Are you sure you want to delete patient from this month's billing " S DIR("B")="N",DIR(0)="Y"
D ^DIR I Y=0!$D(DTOUT)!$D(DUOUT) Q
S DA(3)=RMPOXITE,DA(2)=RMPORVDT,DA(1)=RMPOVDR,DA=RMPODFN
S DIK="^RMPO(665.72,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_","_"""V"""_","
D ^DIK
W:'$D(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,0)) !!,"Patient deleted from billing..."
Q
OK2EDIT() ;
;
Q $P(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,0),U,3)'="Y"&($P(^(0),U,3)'="P")
Q
LOCKED() ;
;
L +^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,0):2
Q '$T
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOBILA 4632 printed Apr 09, 2024@21:39:44 Page 2
RMPOBILA ;HIN/RVD - BILLING TRANSACTIONS (ADD/DEL PATIENT) ;3/18/99
+1 ;;3.0;PROSTHETICS;**29,46,41**;Feb 09, 1996
+2 ;
ADD KILL DIC,RMPODFN
+1 SET DIC("S")="I '$D(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,""V"",+Y))"
+2 SET DIC="^RMPR(665,"
SET DIC(0)="QEAMZ"
DO ^DIC
IF Y<0!$$QUIT
GOTO EXIT
+3 SET RMPODFN=+Y
IF $$VEN(RMPOVDR)<1
WRITE !,"** Error: ",$$STAT(RMPODFN),!
GOTO EXIT
+4 IF $DATA(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN))
GOTO EXIT
GETPAT ;get patient information
+1 SET ZXITM=0
+2 FOR
SET ZXITM=$ORDER(^RMPR(665,RMPODFN,"RMPOC",ZXITM))
if ZXITM'>0
QUIT
Begin DoDot:1
+3 SET ZX1=$GET(^RMPR(665,RMPODFN,"RMPOC",ZXITM,0))
+4 if $PIECE(ZX1,U,2)'=RMPOVDR
QUIT
DO BUILDP
DO BUILDI
WRITE !,"Item ",$PIECE(ZX1,U,1)," was added to Billing Transaction....",!
End DoDot:1
+5 QUIT
+6 ;
VEN(RVEN) ; Determine whether to include trx for RMPODFN
+1 ;
+2 ; Do NOT process if not at correct site.
+3 if $PIECE($GET(^RMPR(665,RMPODFN,"RMPOA")),U,7)'=RMPOXITE
QUIT -1
+4 ;
+5 ; Do NOT process if no Boiler-plate
+6 if '$DATA(^RMPR(665,RMPODFN,"RMPOA"))
QUIT -2
+7 ;
+8 ; Do NOT process if Inactivation date less the billing date.
+9 SET RMPOINDT=$PIECE($GET(^RMPR(665,RMPODFN,"RMPOA")),U,3)
+10 IF $GET(RMPOINDT)
if RMPOINDT<RMPORVDT
QUIT -3
+11 ;
+12 ; Do NOT process if no Rx
+13 if '$DATA(^RMPR(665,RMPODFN,"RMPOB",0))
QUIT -4
+14 ;
+15 ; 1st find correct Rx
+16 SET RMPORX=$ORDER(^RMPR(665,RMPODFN,"RMPOB","B"),-1)
+17 if 'RMPORX
QUIT -5
+18 ;
+19 ; Quit if the Rx Expiration Date is before the billing period
+20 if $PIECE(^RMPR(665,RMPODFN,"RMPOB",RMPORX,0),U,3)<(RMPORVDT)
QUIT -6
+21 ;
+22 ; Quit if there are no items.
+23 if $ORDER(^RMPR(665,RMPODFN,"RMPOC",0))'>0
QUIT -7
+24 ;
+25 IF $GET(RVEN)>0
QUIT $$VDRSTAT(RVEN)
+26 QUIT 1
+27 ;
VDRSTAT(VDR) ;
+1 SET ZXITM=0
SET FOUND=0
+2 FOR
SET ZXITM=$ORDER(^RMPR(665,RMPODFN,"RMPOC",ZXITM))
if ZXITM'>0
QUIT
Begin DoDot:1
+3 IF $PIECE($GET(^RMPR(665,RMPODFN,"RMPOC",ZXITM,0)),U,2)=VDR
SET FOUND=1
End DoDot:1
+4 QUIT $SELECT(FOUND=1:1,1:-8)
+5 QUIT
+6 ;
BUILDP ;Now the Patient level
+1 ; DONE
if $DATA(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN))
QUIT
+2 KILL DA,DIC,DD,DO
+3 SET DA(3)=RMPOXITE
SET DA(2)=RMPORVDT
SET DA(1)=RMPOVDR
SET (DINUM,X)=RMPODFN
+4 SET DIC("P")=$PIECE(^DD(665.7231,9,0),U,2)
SET DIC(0)="L"
SET ZV=",""V"","
+5 SET DIC="^RMPO(665.72,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_ZV
+6 DO FILE^DICN
+7 QUIT
+8 ;
BUILDI ; BUILD ITEM (REQUIRES ZX1 = ENTIRE ITEM NODE FROM FILE #665)
+1 ;Finally, set up the item multiple
+2 KILL DA,DIC,DD,DO,DINUM,DIE,DR
+3 SET DA(4)=RMPOXITE
SET DA(3)=RMPORVDT
SET DA(2)=RMPOVDR
SET DA(1)=RMPODFN
+4 SET X=$PIECE(ZX1,U)
SET ZV=",""V"","
+5 SET DIC="^RMPO(665.72,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_ZV_DA(1)_",1,"
+6 SET DIC("P")=$PIECE(^DD(665.72319,1,0),U,2)
SET DIC(0)="L"
+7 DO FILE^DICN
+8 SET DIE=DIC
SET DA=+Y
+9 ;Do some calculations
+10 ;Multiply the unit cost by the number of units
+11 SET RMPOTOT=$PIECE(ZX1,U,3)*$PIECE(ZX1,U,4)
+12 SET RMREMARK=$PIECE(ZX1,U,9)
+13 ; PRIMARY ITEM
SET DR="1////"_$PIECE(ZX1,U,11)
+14 ; HCPCS CODE
SET DR=DR_";2////"_$PIECE(ZX1,U,7)
+15 ; FUND CONTROL POINT
SET DR=DR_";3////"_$PIECE(ZX1,U,6)
+16 ; REMARKS
SET DR=DR_";4///^S X=RMREMARK"
+17 ; UNIT COST
SET DR=DR_";5///"_$PIECE(ZX1,U,4)
+18 ; TOTAL (QTY X UNIT COST)
SET DR=DR_";6///"_$JUSTIFY($GET(RMPOTOT),1,2)
+19 ; QUANTITY
SET DR=DR_";7///"_$PIECE(ZX1,U,3)
+20 ; ICD-9 CODE
SET DR=DR_";8////"_$PIECE(ZX1,U,8)
+21 ; IEN OF ITEM
SET DR=DR_";12////"_ZXITM
+22 ; ITEM TYPE
SET DR=DR_";13////"_$PIECE(ZX1,U,10)
+23 ; UNIT OF ISSUE
SET DR=DR_";14////"_$PIECE(ZX1,U,5)
+24 ; RENTAL FLAG
SET DR=DR_";17////"_$PIECE(ZX1,U,12)
+25 ; OXYGEN CONSERVING FLAG
SET DR=DR_";18////"_$PIECE(ZX1,U,13)
+26 DO ^DIE
+27 QUIT
STAT(RMPODFN) ;STATUS OF PT FOR GIVEN BUILD
+1 SET OK=$$VEN($GET(RMPOVDR))
+2 if OK=1
QUIT "OK"
+3 if OK=-1
QUIT "Different Home Oxygen Contract Location"
+4 if OK=-2
QUIT "No Home Oxygen Information"
+5 if OK=-3
QUIT "Deactivated"
+6 if OK=-4
QUIT "No RX on file"
+7 if OK=-5
QUIT "No RX on file"
+8 if OK=-6
QUIT "RX expires prior to billing period"
+9 if OK=-7
QUIT "No items on file"
+10 if OK=-8
QUIT "No items for vendor"
+11 QUIT "Other Unknown Error"
+12 QUIT
QUIT() SET QUIT=$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT QUIT
+1 ;
EXIT ;Kill variables before quitting
+1 KILL DIC,RMPODFN,DA,DIR,Y,X,ZXITM
+2 QUIT
+3 ;
DEL IF '$$OK2EDIT
Begin DoDot:1
+1 WRITE !,$CHAR(7)_"Cannot DELETE a Posted or Partially Posted Transactions. "
+2 KILL DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+3 IF $$LOCKED
Begin DoDot:1
+4 WRITE !,$CHAR(7)_"Record is locked. "
KILL DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+5 KILL DIR
SET DIR("A")="Are you sure you want to delete patient from this month's billing "
SET DIR("B")="N"
SET DIR(0)="Y"
+6 DO ^DIR
IF Y=0!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
+7 SET DA(3)=RMPOXITE
SET DA(2)=RMPORVDT
SET DA(1)=RMPOVDR
SET DA=RMPODFN
+8 SET DIK="^RMPO(665.72,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_","_"""V"""_","
+9 DO ^DIK
+10 if '$DATA(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,0))
WRITE !!,"Patient deleted from billing..."
+11 QUIT
OK2EDIT() ;
+1 ;
+2 QUIT $PIECE(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,0),U,3)'="Y"&($PIECE(^(0),U,3)'="P")
+3 QUIT
LOCKED() ;
+1 ;
+2 LOCK +^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,0):2
+3 QUIT '$TEST
