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