- 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 Feb 18, 2025@23:57:14 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