Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPOBIL0

RMPOBIL0.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; ODJ - patch 50 - 7/25/00 fix DIR date call in PREBILL sub. so as to
  1. ; interpret 2 digit entry as month
  1. ; (FM interpets this as year)
  1. ;
  1. ;RMPR*3.0*179 Added check for Deceased Date less than billing month
  1. ; begin date, error -1 and skips patient billing due to
  1. ; change in release DI*22.2*5.
  1. ;
  1. ;RMPR*3.0*190 Insure %DT(0) is not set prior to date handling
  1. ;
  1. OLD ; Enter from top (OLD code)
  1. ;
  1. D MAIN ; D ^RMPOBIL1
  1. ;Q:'$D(RMPODATE)!'$D(RMPOVDR)!'$D(RMPOXITE)!QUIT
  1. I '$D(RMPODATE)!'$D(RMPOVDR)!'$D(RMPOXITE)!QUIT D EXIT Q
  1. K DIC,DIR,DIR,DD,DA,DR,DO ;CLEANUP FOR L/M
  1. D EN^RMPOLM ; -- List manager code
  1. D ACCEPT^RMPOPST3,EXIT
  1. Q
  1. MAIN ; Proper entry point
  1. D HOME^%ZIS
  1. S QUIT=0
  1. D HOSITE^RMPOUTL0 Q:('$D(RMPOXITE))!QUIT
  1. D CKSITE
  1. D MONTH("AEQLMZ") Q:$D(RMPODATE)=0!QUIT
  1. D VENDOR("AEQLMZ") Q:$D(RMPOVDR)=0!QUIT
  1. ;Generate Vendor/Month of transactions
  1. I $O(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,0))="V" Q
  1. D GEN1
  1. Q
  1. VENDOR(LAYGO) ;Select Vendor
  1. ;
  1. K DIC,DA,RMPOVDR
  1. S DA(2)=RMPOXITE,DA(1)=RMPORVDT
  1. S DIC="^RMPO(665.72,"_DA(2)_",1,"_DA(1)_",1,"
  1. S DIC("P")=$P(^DD(665.723,1,0),U,2)
  1. S DIC(0)=$G(LAYGO,"AEQMZ") D ^DIC Q:(Y<0)!$$QUIT
  1. S RMPOVDR=+Y
  1. ;S RMPOVDR=$P(Y,U,2) ; PER ANALYST
  1. I $P(Y,U,3)>0 D
  1. . K %DT(0) ;RMPR*3.0*190
  1. . S DIE=DIC,DA=+Y,DR="1///NOW" D ^DIE
  1. Q
  1. CKSITE ;Set up Site in Billing if it is not there
  1. I '$D(^RMPO(665.72,RMPOXITE,0)) D
  1. . K DIC,DD,DO,DA
  1. . S (DINUM,X)=RMPOXITE,DIC="^RMPO(665.72,",DIC(0)="L" D FILE^DICN
  1. Q
  1. MONTH(LAYGO) ;Determine Billing Month
  1. ;
  1. K DIC,DA,RMPODATE
  1. S DA(1)=RMPOXITE,DIC="^RMPO(665.72,"_DA(1)_",1,"
  1. S DIC("P")=$P(^DD(665.72,1,0),U,2)
  1. S DIC(0)=$G(LAYGO,"AEMQZ") D ^DIC Q:(Y<0)!$$QUIT
  1. S RMPODATE=+Y,RMPOMTH=Y(0,0)
  1. S RMPORVDT=RMPODATE
  1. Q
  1. QUIT() S QUIT=$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q QUIT
  1. ;
  1. BUILDM ; BUILD MONTH
  1. ; Set up Month
  1. Q:$D(^RMPO(665.72,RMPOXITE,1,RMPORVDT)) ; ALREADY DONE..
  1. K DIC,DA
  1. S X=RMPODATE,DINUM=RMPORVDT
  1. S DA(1)=RMPOXITE,DIC(0)="L"
  1. S DIC="^RMPO(665.72,"_DA(1)_",1,",DIC("P")=$P(^DD(665.72,1,0),U,2)
  1. D FILE^DICN
  1. Q
  1. GEN1 ; ALL PATIENTS FOR A GIVEN VENDOR
  1. W !,"Generating "_RMPOMTH_" billing transactions for "
  1. W $$VDRNM^RMPOPED(RMPOVDR),!!,"This may take a while..."
  1. ;
  1. ; D BUILDM
  1. ;Copy Patient Boiler-plates
  1. ;fix to get ALL patients from same activation date
  1. S (ACTIVDT,RMPODFN)=0
  1. F S ACTIVDT=$O(^RMPR(665,"AHO",ACTIVDT)) Q:ACTIVDT'>0 D
  1. . S RMPODFN=0
  1. . F S RMPODFN=$O(^RMPR(665,"AHO",ACTIVDT,RMPODFN)) Q:RMPODFN'>0 D:$$OK2BLD>0 GEN2
  1. K DIR S DIR(0)="E" D ^DIR Q:$$QUIT
  1. Q
  1. GEN2 ;INNER LOOP
  1. ;W !,RMPODFN
  1. S ZXITM=0
  1. F S ZXITM=$O(^RMPR(665,RMPODFN,"RMPOC",ZXITM)) Q:ZXITM'>0 D
  1. . S ZX1=$G(^RMPR(665,RMPODFN,"RMPOC",ZXITM,0))
  1. . Q:$P(ZX1,U,2)'=RMPOVDR
  1. . D BUILDP,BUILDI
  1. Q
  1. OK2BLD(VENDOR) ; Determine whether to include trx for RMPODFN
  1. ;
  1. ; Do NOT process if not at correct site.
  1. Q:$P($G(^RMPR(665,RMPODFN,"RMPOA")),U,7)'=RMPOXITE -1
  1. ;
  1. ; Do NOT process if no Boiler-plate
  1. Q:'$D(^RMPR(665,RMPODFN,"RMPOA")) -2
  1. ;
  1. ; Do NOT process if Inactivation date less the billing date.
  1. S RMPOINDT=$P($G(^RMPR(665,RMPODFN,"RMPOA")),U,3)
  1. I $G(RMPOINDT) Q:RMPOINDT<RMPODATE -3
  1. ;Q:$P($G(^RMPR(665,RMPODFN,"RMPOA")),U,3) -3
  1. ;
  1. ; 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
  1. S RMPOINDT=+$G(^DPT(RMPODFN,.35))
  1. I $G(RMPOINDT) Q:RMPOINDT<RMPODATE -9
  1. ;
  1. ; Do NOT process if no Rx
  1. Q:'$D(^RMPR(665,RMPODFN,"RMPOB",0)) -4
  1. ;
  1. ; 1st find correct Rx
  1. S RMPORX=$O(^RMPR(665,RMPODFN,"RMPOB","B"),-1)
  1. Q:'RMPORX -5
  1. ;
  1. ; Quit if the Rx Expiration Date is before the billing period
  1. ; Expiration date check removed with patch *147 6/24/2008
  1. ;Q:$P(^RMPR(665,RMPODFN,"RMPOB",RMPORX,0),U,3)<(RMPODATE) -6
  1. ;
  1. ; Quit if there are no items.
  1. Q:$O(^RMPR(665,RMPODFN,"RMPOC",0))'>0 -7
  1. ;
  1. I $G(VENDOR)>0 Q $$VDRSTAT(VENDOR)
  1. Q 1
  1. VDRSTAT(VDR) ;
  1. ;
  1. S ZXITM=0,FOUND=0
  1. F S ZXITM=$O(^RMPR(665,RMPODFN,"RMPOC",ZXITM)) Q:ZXITM'>0 D
  1. . I $P($G(^RMPR(665,RMPODFN,"RMPOC",ZXITM,0)),U,2)=VDR S FOUND=1
  1. Q $S(FOUND=1:1,1:-8)
  1. Q
  1. BUILDV ; Set up the VENDOR multiple
  1. Q:$D(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR)) ; ALREADY DONE...
  1. K DA,DIC,DD,DO
  1. S DA(2)=RMPOXITE,DA(1)=RMPORVDT,(DINUM,X)=RMPOVDR
  1. S DIC="^RMPO(665.72,"_DA(2)_",1,"_DA(1)_",1,"
  1. S DIC("P")=$P(^DD(665.723,1,0),U,2),DIC(0)="L"
  1. D FILE^DICN
  1. Q
  1. BUILDP ;Now the Patient level
  1. Q:$D(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN)) ; DONE
  1. K DA,DIC,DD,DO
  1. S DA(3)=RMPOXITE,DA(2)=RMPORVDT,DA(1)=RMPOVDR,(DINUM,X)=RMPODFN
  1. S DIC("P")=$P(^DD(665.7231,9,0),U,2),DIC(0)="L",ZV=",""V"","
  1. S DIC="^RMPO(665.72,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_ZV
  1. D FILE^DICN
  1. Q
  1. ;
  1. BUILDI ; BUILD ITEM (REQUIRES ZX1 = ENTIRE ITEM NODE FROM FILE #665)
  1. ;Finally, set up the item multiple
  1. K DA,DIC,DD,DO,DINUM,DIE,DR
  1. S DA(4)=RMPOXITE,DA(3)=RMPORVDT,DA(2)=RMPOVDR,DA(1)=RMPODFN
  1. S X=$P(ZX1,U),ZV=",""V"","
  1. S DIC="^RMPO(665.72,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_ZV_DA(1)_",1,"
  1. S DIC("P")=$P(^DD(665.72319,1,0),U,2),DIC(0)="L"
  1. D FILE^DICN
  1. S DIE=DIC,DA=+Y
  1. ;Do some calculations
  1. ;Multiply the unit cost by the number of units
  1. S RMPOTOT=$P(ZX1,U,3)*$P(ZX1,U,4)
  1. S RMREMARK=$P(ZX1,U,9)
  1. S DR="1////"_$P(ZX1,U,11) ; PRIMARY ITEM
  1. S DR=DR_";2////"_$P(ZX1,U,7) ; HCPCS CODE
  1. S DR=DR_";3////"_$P(ZX1,U,6) ; FUND CONTROL POINT
  1. S DR=DR_";4///^S X=RMREMARK" ; REMARKS
  1. S DR=DR_";5///"_$P(ZX1,U,4) ; UNIT COST
  1. S DR=DR_";6///"_$J($G(RMPOTOT),1,2) ; TOTAL (QTY X UNIT COST)
  1. S DR=DR_";7///"_$P(ZX1,U,3) ; QUANTITY
  1. S DR=DR_";9////"_$P(ZX1,U,8) ; ICD-9 CODE
  1. S DR=DR_";12////"_ZXITM ; IEN OF ITEM
  1. S DR=DR_";13////"_$P(ZX1,U,10) ; ITEM TYPE
  1. S DR=DR_";14////"_$P(ZX1,U,5) ; UNIT OF ISSUE
  1. D ^DIE
  1. Q
  1. PREBILL ; Proper entry point
  1. D HOME^%ZIS
  1. S (RMEND,RMPOPRT,QUIT)=0
  1. D HOSITE^RMPOUTL0 Q:('$D(RMPOXITE))!QUIT
  1. D Q:$D(RMPODATE)=0!QUIT
  1. . K DIR,RMPODATE
  1. . 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"
  1. . ;S DIR(0)="D"
  1. . S DIR("A")="ENTER BILLING MONTH"
  1. . D ^DIR Q:$$QUIT!(Y<1)
  1. . S RMPODATE=$E(Y,1,5)_"00"
  1. . I Y X ^DD("DD") W ?25,Y
  1. . Q
  1. S DIC="^RMPR(665,",L=0
  1. S BY="[RMPO-BILLING-PRESORT]"
  1. S FLDS="[RMPO-BILLING-PRESORT]"
  1. 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)"
  1. S DIOEND="I $G(Y)'[U S RMEND=1 S:IOST[""P-"" RMPOPRT=1"
  1. D EN1^DIP
  1. I RMPOPRT=0,$G(RMEND) K DIR S DIR(0)="E" D ^DIR
  1. D EXIT
  1. Q
  1. BLDSTAT(RMPODFN) ;STATUS OF PT FOR GIVEN BUILD
  1. ;
  1. S OK=$$OK2BLD($G(RMPOVDR))
  1. Q:OK=1 "OK"
  1. Q:OK=-1 "Different Home Oxygen Contract Location"
  1. Q:OK=-2 "No Home Oxygen Information"
  1. Q:OK=-3 "Deactivated"
  1. Q:OK=-4 "No RX on file"
  1. Q:OK=-5 "No RX on file"
  1. Q:OK=-6 "RX expires prior to billing period"
  1. Q:OK=-7 "No items on file"
  1. Q:OK=-8 "No items for vendor"
  1. Q:OK=-9 "Patient deceased, not inactivated" ;RMPR*3.0*179
  1. Q "Other Unknown Error"
  1. Q
  1. EXIT ;Kill variables before quitting
  1. N RMPR,RMPRSITE D KILL^XUSCLEAN
  1. Q