RMPOBIL0 ;EDS/MDB/HINES CIOFO/HNC - HOME OXYGEN BILLING TRANSACTIONS ;7/24/98 07:34
;;3.0;PROSTHETICS;**29,46,50,147,179,190**;Feb 09, 1996;Build 5
;
; ODJ - patch 50 - 7/25/00 fix DIR date call in PREBILL sub. so as to
; interpret 2 digit entry as month
; (FM interpets this as year)
;
;RMPR*3.0*179 Added check for Deceased Date less than billing month
; begin date, error -1 and skips patient billing due to
; change in release DI*22.2*5.
;
;RMPR*3.0*190 Insure %DT(0) is not set prior to date handling
;
OLD ; Enter from top (OLD code)
;
D MAIN ; D ^RMPOBIL1
;Q:'$D(RMPODATE)!'$D(RMPOVDR)!'$D(RMPOXITE)!QUIT
I '$D(RMPODATE)!'$D(RMPOVDR)!'$D(RMPOXITE)!QUIT D EXIT Q
K DIC,DIR,DIR,DD,DA,DR,DO ;CLEANUP FOR L/M
D EN^RMPOLM ; -- List manager code
D ACCEPT^RMPOPST3,EXIT
Q
MAIN ; Proper entry point
D HOME^%ZIS
S QUIT=0
D HOSITE^RMPOUTL0 Q:('$D(RMPOXITE))!QUIT
D CKSITE
D MONTH("AEQLMZ") Q:$D(RMPODATE)=0!QUIT
D VENDOR("AEQLMZ") Q:$D(RMPOVDR)=0!QUIT
;Generate Vendor/Month of transactions
I $O(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,0))="V" Q
D GEN1
Q
VENDOR(LAYGO) ;Select Vendor
;
K DIC,DA,RMPOVDR
S DA(2)=RMPOXITE,DA(1)=RMPORVDT
S DIC="^RMPO(665.72,"_DA(2)_",1,"_DA(1)_",1,"
S DIC("P")=$P(^DD(665.723,1,0),U,2)
S DIC(0)=$G(LAYGO,"AEQMZ") D ^DIC Q:(Y<0)!$$QUIT
S RMPOVDR=+Y
;S RMPOVDR=$P(Y,U,2) ; PER ANALYST
I $P(Y,U,3)>0 D
. K %DT(0) ;RMPR*3.0*190
. S DIE=DIC,DA=+Y,DR="1///NOW" D ^DIE
Q
CKSITE ;Set up Site in Billing if it is not there
I '$D(^RMPO(665.72,RMPOXITE,0)) D
. K DIC,DD,DO,DA
. S (DINUM,X)=RMPOXITE,DIC="^RMPO(665.72,",DIC(0)="L" D FILE^DICN
Q
MONTH(LAYGO) ;Determine Billing Month
;
K DIC,DA,RMPODATE
S DA(1)=RMPOXITE,DIC="^RMPO(665.72,"_DA(1)_",1,"
S DIC("P")=$P(^DD(665.72,1,0),U,2)
S DIC(0)=$G(LAYGO,"AEMQZ") D ^DIC Q:(Y<0)!$$QUIT
S RMPODATE=+Y,RMPOMTH=Y(0,0)
S RMPORVDT=RMPODATE
Q
QUIT() S QUIT=$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q QUIT
;
BUILDM ; BUILD MONTH
; Set up Month
Q:$D(^RMPO(665.72,RMPOXITE,1,RMPORVDT)) ; ALREADY DONE..
K DIC,DA
S X=RMPODATE,DINUM=RMPORVDT
S DA(1)=RMPOXITE,DIC(0)="L"
S DIC="^RMPO(665.72,"_DA(1)_",1,",DIC("P")=$P(^DD(665.72,1,0),U,2)
D FILE^DICN
Q
GEN1 ; ALL PATIENTS FOR A GIVEN VENDOR
W !,"Generating "_RMPOMTH_" billing transactions for "
W $$VDRNM^RMPOPED(RMPOVDR),!!,"This may take a while..."
;
; D BUILDM
;Copy Patient Boiler-plates
;fix to get ALL patients from same activation date
S (ACTIVDT,RMPODFN)=0
F S ACTIVDT=$O(^RMPR(665,"AHO",ACTIVDT)) Q:ACTIVDT'>0 D
. S RMPODFN=0
. F S RMPODFN=$O(^RMPR(665,"AHO",ACTIVDT,RMPODFN)) Q:RMPODFN'>0 D:$$OK2BLD>0 GEN2
K DIR S DIR(0)="E" D ^DIR Q:$$QUIT
Q
GEN2 ;INNER LOOP
;W !,RMPODFN
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
Q
OK2BLD(VENDOR) ; 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<RMPODATE -3
;Q:$P($G(^RMPR(665,RMPODFN,"RMPOA")),U,3) -3
;
; Do NOT process if Deceased date less the billing date. ;RMPR*3.0*179 Skip a deceased patient. ^DPT(D0,.35) direct read supported by ICR #10035
S RMPOINDT=+$G(^DPT(RMPODFN,.35))
I $G(RMPOINDT) Q:RMPOINDT<RMPODATE -9
;
; 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
; Expiration date check removed with patch *147 6/24/2008
;Q:$P(^RMPR(665,RMPODFN,"RMPOB",RMPORX,0),U,3)<(RMPODATE) -6
;
; Quit if there are no items.
Q:$O(^RMPR(665,RMPODFN,"RMPOC",0))'>0 -7
;
I $G(VENDOR)>0 Q $$VDRSTAT(VENDOR)
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
BUILDV ; Set up the VENDOR multiple
Q:$D(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR)) ; ALREADY DONE...
K DA,DIC,DD,DO
S DA(2)=RMPOXITE,DA(1)=RMPORVDT,(DINUM,X)=RMPOVDR
S DIC="^RMPO(665.72,"_DA(2)_",1,"_DA(1)_",1,"
S DIC("P")=$P(^DD(665.723,1,0),U,2),DIC(0)="L"
D FILE^DICN
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_";9////"_$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
D ^DIE
Q
PREBILL ; Proper entry point
D HOME^%ZIS
S (RMEND,RMPOPRT,QUIT)=0
D HOSITE^RMPOUTL0 Q:('$D(RMPOXITE))!QUIT
D Q:$D(RMPODATE)=0!QUIT
. K DIR,RMPODATE
. S DIR(0)="D^^I +X>0,+X'>12 S X=$E(100+X,2,3)_$E(DT,2,3) K Y,%DT D ^%DT"
. ;S DIR(0)="D"
. S DIR("A")="ENTER BILLING MONTH"
. D ^DIR Q:$$QUIT!(Y<1)
. S RMPODATE=$E(Y,1,5)_"00"
. I Y X ^DD("DD") W ?25,Y
. Q
S DIC="^RMPR(665,",L=0
S BY="[RMPO-BILLING-PRESORT]"
S FLDS="[RMPO-BILLING-PRESORT]"
S DIS(0)="S RMPODFN=D0,Z=$$OK2BLD^RMPOBIL0 I $D(^RMPR(665,RMPODFN,""RMPOA"")) I (Z'=1)&(Z'=-3)&($P(^RMPR(665,RMPODFN,""RMPOA""),U,7)=RMPOXITE)"
S DIOEND="I $G(Y)'[U S RMEND=1 S:IOST[""P-"" RMPOPRT=1"
D EN1^DIP
I RMPOPRT=0,$G(RMEND) K DIR S DIR(0)="E" D ^DIR
D EXIT
Q
BLDSTAT(RMPODFN) ;STATUS OF PT FOR GIVEN BUILD
;
S OK=$$OK2BLD($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:OK=-9 "Patient deceased, not inactivated" ;RMPR*3.0*179
Q "Other Unknown Error"
Q
EXIT ;Kill variables before quitting
N RMPR,RMPRSITE D KILL^XUSCLEAN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOBIL0 7411 printed Dec 13, 2024@02:30:45 Page 2
RMPOBIL0 ;EDS/MDB/HINES CIOFO/HNC - HOME OXYGEN BILLING TRANSACTIONS ;7/24/98 07:34
+1 ;;3.0;PROSTHETICS;**29,46,50,147,179,190**;Feb 09, 1996;Build 5
+2 ;
+3 ; ODJ - patch 50 - 7/25/00 fix DIR date call in PREBILL sub. so as to
+4 ; interpret 2 digit entry as month
+5 ; (FM interpets this as year)
+6 ;
+7 ;RMPR*3.0*179 Added check for Deceased Date less than billing month
+8 ; begin date, error -1 and skips patient billing due to
+9 ; change in release DI*22.2*5.
+10 ;
+11 ;RMPR*3.0*190 Insure %DT(0) is not set prior to date handling
+12 ;
OLD ; Enter from top (OLD code)
+1 ;
+2 ; D ^RMPOBIL1
DO MAIN
+3 ;Q:'$D(RMPODATE)!'$D(RMPOVDR)!'$D(RMPOXITE)!QUIT
+4 IF '$DATA(RMPODATE)!'$DATA(RMPOVDR)!'$DATA(RMPOXITE)!QUIT
DO EXIT
QUIT
+5 ;CLEANUP FOR L/M
KILL DIC,DIR,DIR,DD,DA,DR,DO
+6 ; -- List manager code
DO EN^RMPOLM
+7 DO ACCEPT^RMPOPST3
DO EXIT
+8 QUIT
MAIN ; Proper entry point
+1 DO HOME^%ZIS
+2 SET QUIT=0
+3 DO HOSITE^RMPOUTL0
if ('$DATA(RMPOXITE))!QUIT
QUIT
+4 DO CKSITE
+5 DO MONTH("AEQLMZ")
if $DATA(RMPODATE)=0!QUIT
QUIT
+6 DO VENDOR("AEQLMZ")
if $DATA(RMPOVDR)=0!QUIT
QUIT
+7 ;Generate Vendor/Month of transactions
+8 IF $ORDER(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,0))="V"
QUIT
+9 DO GEN1
+10 QUIT
VENDOR(LAYGO) ;Select Vendor
+1 ;
+2 KILL DIC,DA,RMPOVDR
+3 SET DA(2)=RMPOXITE
SET DA(1)=RMPORVDT
+4 SET DIC="^RMPO(665.72,"_DA(2)_",1,"_DA(1)_",1,"
+5 SET DIC("P")=$PIECE(^DD(665.723,1,0),U,2)
+6 SET DIC(0)=$GET(LAYGO,"AEQMZ")
DO ^DIC
if (Y<0)!$$QUIT
QUIT
+7 SET RMPOVDR=+Y
+8 ;S RMPOVDR=$P(Y,U,2) ; PER ANALYST
+9 IF $PIECE(Y,U,3)>0
Begin DoDot:1
+10 ;RMPR*3.0*190
KILL %DT(0)
+11 SET DIE=DIC
SET DA=+Y
SET DR="1///NOW"
DO ^DIE
End DoDot:1
+12 QUIT
CKSITE ;Set up Site in Billing if it is not there
+1 IF '$DATA(^RMPO(665.72,RMPOXITE,0))
Begin DoDot:1
+2 KILL DIC,DD,DO,DA
+3 SET (DINUM,X)=RMPOXITE
SET DIC="^RMPO(665.72,"
SET DIC(0)="L"
DO FILE^DICN
End DoDot:1
+4 QUIT
MONTH(LAYGO) ;Determine Billing Month
+1 ;
+2 KILL DIC,DA,RMPODATE
+3 SET DA(1)=RMPOXITE
SET DIC="^RMPO(665.72,"_DA(1)_",1,"
+4 SET DIC("P")=$PIECE(^DD(665.72,1,0),U,2)
+5 SET DIC(0)=$GET(LAYGO,"AEMQZ")
DO ^DIC
if (Y<0)!$$QUIT
QUIT
+6 SET RMPODATE=+Y
SET RMPOMTH=Y(0,0)
+7 SET RMPORVDT=RMPODATE
+8 QUIT
QUIT() SET QUIT=$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT QUIT
+1 ;
BUILDM ; BUILD MONTH
+1 ; Set up Month
+2 ; ALREADY DONE..
if $DATA(^RMPO(665.72,RMPOXITE,1,RMPORVDT))
QUIT
+3 KILL DIC,DA
+4 SET X=RMPODATE
SET DINUM=RMPORVDT
+5 SET DA(1)=RMPOXITE
SET DIC(0)="L"
+6 SET DIC="^RMPO(665.72,"_DA(1)_",1,"
SET DIC("P")=$PIECE(^DD(665.72,1,0),U,2)
+7 DO FILE^DICN
+8 QUIT
GEN1 ; ALL PATIENTS FOR A GIVEN VENDOR
+1 WRITE !,"Generating "_RMPOMTH_" billing transactions for "
+2 WRITE $$VDRNM^RMPOPED(RMPOVDR),!!,"This may take a while..."
+3 ;
+4 ; D BUILDM
+5 ;Copy Patient Boiler-plates
+6 ;fix to get ALL patients from same activation date
+7 SET (ACTIVDT,RMPODFN)=0
+8 FOR
SET ACTIVDT=$ORDER(^RMPR(665,"AHO",ACTIVDT))
if ACTIVDT'>0
QUIT
Begin DoDot:1
+9 SET RMPODFN=0
+10 FOR
SET RMPODFN=$ORDER(^RMPR(665,"AHO",ACTIVDT,RMPODFN))
if RMPODFN'>0
QUIT
if $$OK2BLD>0
DO GEN2
End DoDot:1
+11 KILL DIR
SET DIR(0)="E"
DO ^DIR
if $$QUIT
QUIT
+12 QUIT
GEN2 ;INNER LOOP
+1 ;W !,RMPODFN
+2 SET ZXITM=0
+3 FOR
SET ZXITM=$ORDER(^RMPR(665,RMPODFN,"RMPOC",ZXITM))
if ZXITM'>0
QUIT
Begin DoDot:1
+4 SET ZX1=$GET(^RMPR(665,RMPODFN,"RMPOC",ZXITM,0))
+5 if $PIECE(ZX1,U,2)'=RMPOVDR
QUIT
+6 DO BUILDP
DO BUILDI
End DoDot:1
+7 QUIT
OK2BLD(VENDOR) ; 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<RMPODATE
QUIT -3
+11 ;Q:$P($G(^RMPR(665,RMPODFN,"RMPOA")),U,3) -3
+12 ;
+13 ; Do NOT process if Deceased date less the billing date. ;RMPR*3.0*179 Skip a deceased patient. ^DPT(D0,.35) direct read supported by ICR #10035
+14 SET RMPOINDT=+$GET(^DPT(RMPODFN,.35))
+15 IF $GET(RMPOINDT)
if RMPOINDT<RMPODATE
QUIT -9
+16 ;
+17 ; Do NOT process if no Rx
+18 if '$DATA(^RMPR(665,RMPODFN,"RMPOB",0))
QUIT -4
+19 ;
+20 ; 1st find correct Rx
+21 SET RMPORX=$ORDER(^RMPR(665,RMPODFN,"RMPOB","B"),-1)
+22 if 'RMPORX
QUIT -5
+23 ;
+24 ; Quit if the Rx Expiration Date is before the billing period
+25 ; Expiration date check removed with patch *147 6/24/2008
+26 ;Q:$P(^RMPR(665,RMPODFN,"RMPOB",RMPORX,0),U,3)<(RMPODATE) -6
+27 ;
+28 ; Quit if there are no items.
+29 if $ORDER(^RMPR(665,RMPODFN,"RMPOC",0))'>0
QUIT -7
+30 ;
+31 IF $GET(VENDOR)>0
QUIT $$VDRSTAT(VENDOR)
+32 QUIT 1
VDRSTAT(VDR) ;
+1 ;
+2 SET ZXITM=0
SET FOUND=0
+3 FOR
SET ZXITM=$ORDER(^RMPR(665,RMPODFN,"RMPOC",ZXITM))
if ZXITM'>0
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^RMPR(665,RMPODFN,"RMPOC",ZXITM,0)),U,2)=VDR
SET FOUND=1
End DoDot:1
+5 QUIT $SELECT(FOUND=1:1,1:-8)
+6 QUIT
BUILDV ; Set up the VENDOR multiple
+1 ; ALREADY DONE...
if $DATA(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR))
QUIT
+2 KILL DA,DIC,DD,DO
+3 SET DA(2)=RMPOXITE
SET DA(1)=RMPORVDT
SET (DINUM,X)=RMPOVDR
+4 SET DIC="^RMPO(665.72,"_DA(2)_",1,"_DA(1)_",1,"
+5 SET DIC("P")=$PIECE(^DD(665.723,1,0),U,2)
SET DIC(0)="L"
+6 DO FILE^DICN
+7 QUIT
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_";9////"_$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 DO ^DIE
+25 QUIT
PREBILL ; Proper entry point
+1 DO HOME^%ZIS
+2 SET (RMEND,RMPOPRT,QUIT)=0
+3 DO HOSITE^RMPOUTL0
if ('$DATA(RMPOXITE))!QUIT
QUIT
+4 Begin DoDot:1
+5 KILL DIR,RMPODATE
+6 SET DIR(0)="D^^I +X>0,+X'>12 S X=$E(100+X,2,3)_$E(DT,2,3) K Y,%DT D ^%DT"
+7 ;S DIR(0)="D"
+8 SET DIR("A")="ENTER BILLING MONTH"
+9 DO ^DIR
if $$QUIT!(Y<1)
QUIT
+10 SET RMPODATE=$EXTRACT(Y,1,5)_"00"
+11 IF Y
XECUTE ^DD("DD")
WRITE ?25,Y
+12 QUIT
End DoDot:1
if $DATA(RMPODATE)=0!QUIT
QUIT
+13 SET DIC="^RMPR(665,"
SET L=0
+14 SET BY="[RMPO-BILLING-PRESORT]"
+15 SET FLDS="[RMPO-BILLING-PRESORT]"
+16 SET DIS(0)="S RMPODFN=D0,Z=$$OK2BLD^RMPOBIL0 I $D(^RMPR(665,RMPODFN,""RMPOA"")) I (Z'=1)&(Z'=-3)&($P(^RMPR(665,RMPODFN,""RMPOA""),U,7)=RMPOXITE)"
+17 SET DIOEND="I $G(Y)'[U S RMEND=1 S:IOST[""P-"" RMPOPRT=1"
+18 DO EN1^DIP
+19 IF RMPOPRT=0
IF $GET(RMEND)
KILL DIR
SET DIR(0)="E"
DO ^DIR
+20 DO EXIT
+21 QUIT
BLDSTAT(RMPODFN) ;STATUS OF PT FOR GIVEN BUILD
+1 ;
+2 SET OK=$$OK2BLD($GET(RMPOVDR))
+3 if OK=1
QUIT "OK"
+4 if OK=-1
QUIT "Different Home Oxygen Contract Location"
+5 if OK=-2
QUIT "No Home Oxygen Information"
+6 if OK=-3
QUIT "Deactivated"
+7 if OK=-4
QUIT "No RX on file"
+8 if OK=-5
QUIT "No RX on file"
+9 if OK=-6
QUIT "RX expires prior to billing period"
+10 if OK=-7
QUIT "No items on file"
+11 if OK=-8
QUIT "No items for vendor"
+12 ;RMPR*3.0*179
if OK=-9
QUIT "Patient deceased, not inactivated"
+13 QUIT "Other Unknown Error"
+14 QUIT
EXIT ;Kill variables before quitting
+1 NEW RMPR,RMPRSITE
DO KILL^XUSCLEAN
+2 QUIT
