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

RMPOPF1.m

Go to the documentation of this file.
  1. RMPOPF1 ;HINES-FO/DDA - (CONT.)MAIN INTERFACE ROUTINE FOR PFSS AND HOME OXYGEN ;8/18/05
  1. ;;3.0;PROSTHETICS;**98**;Feb 09, 1996
  1. Q
  1. CHARGE ; Called from RMPOPST3 via CHARGE^RMPOPF
  1. ;IMPORTANT VARIBLES PASSED IN FROM RMPOPST3
  1. ; D6I= FILE 660 IEN
  1. ; RMPOXITE= FILE 665.72 SITE (IEN)
  1. ; RMPODATE= FILE 665.72 BILLING MONTH mult IEN
  1. ; RMPOVDR= FILE 665.72 VENDOR mult IEN (DINUM to 440)
  1. ; DFN= FILE 665.72 PATIENT mult IEN (DINUM to 2)
  1. ; ITM= FILE 665.72 ITEM mult IEN
  1. ; TRXDT= Date TRX Built
  1. ; ITMD= Item multiple zero node
  1. ;
  1. ;Set variables
  1. S RMPRDFN=DFN
  1. S RMPRITEM=0
  1. S RMPRITEM=$O(^RMPR(665,DFN,"RMPOC","B",$P(ITMD,"^"),RMPRITEM))
  1. S RMPRPAR=$P($G(^RMPR(665,RMPRDFN,"RMPOC",RMPRITEM,"PFSS")),"^",2)
  1. S RMPRTYPE="CG"
  1. S RMPRFT1(4)=TRXDT
  1. S RMPRFT1(10)=$P(ITMD,"^",7)
  1. S RMPRFT1(13)=423
  1. S RMPRSTA=RMPOXITE
  1. D GETSITE^RMPRPF1
  1. S RMPRFT1(16)=RMPRHLOC
  1. S RMPRIEN=DFN D VALIDRX^RMPOPF K RMPRIEN
  1. S RMPRFT1(21)=$P($G(^RMPR(665,DFN,"RMPOB",RMPRRXI,"PFSS")),"^",2)
  1. S RMPRFT1(22)=$P(ITMD,"^",5)
  1. S RMPRHCPC=$P(ITMD,"^",2)
  1. S RMPRHCDT=TRXDT
  1. ; INSURE HCPCS IS CODE SET VERSIONED
  1. D PSASHCPC^RMPOPF
  1. S RMPRPR1(3)=RMPRVHC
  1. S RMPRPR1(4)=RMPRTHC
  1. S RMPRPR1(6)="O"
  1. ; INSURE ICD9 IS CODE SET VERSIONED
  1. S RMPRDRG=$P(ITMD,"^",9)
  1. S:RMPRDRG'="" RMPRDRG=$$STATCHK^ICDAPIU($P($G(^ICD9(RMPRDRG,0)),"^"),TRXDT)
  1. S:$P(RMPRDRG,"^")=1 RMPRDG1(1,3)=$P(RMPRDRG,"^",2),RMPRDG1(1,6)="F"
  1. S RMPRZCL=""
  1. S RMPRPROS(1)=RMPOVDR
  1. S RMPRUCID=$P($G(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RMPOVDR,"V",DFN,1,ITM,"PFSS")),"^",2)
  1. S:RMPRUCID'>0 RMPRUCID=$$GETCHGID^IBBAPI()
  1. S RMPRFLAG=$$CHARGE^IBBAPI(RMPRDFN,RMPRPAR,RMPRTYPE,RMPRUCID,.RMPRFT1,.RMPRPR1,.RMPRDG1,.RMPRZCL,"","",.RMPRPROS)
  1. Q:RMPRFLAG=0
  1. ;STORE RETURN INFO INTO 665.72
  1. S DA=ITM,DA(1)=DFN,DA(2)=RMPOVDR,DA(3)=RMPODATE,DA(4)=RMPOXITE
  1. S DIE="^RMPO(665.72,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_",""V"","_DA(1)_",1,"
  1. S DR="100///"_RMPRPAR_";101///"_RMPRUCID_";102///"_RMPRFT1(21)
  1. D ^DIE
  1. K DA,DIE,DR
  1. ;STORE RETURN INFO INTO 660
  1. S DA=D6I
  1. S DIE="^RMPR(660,"
  1. S DR="100///"_RMPRPAR_";101///"_RMPRUCID_";102///"_$P($G(^RMPR(660,D6I,1)),"^",4)_";103///"_$P($G(^RMPR(660,D6I,0)),"^",7)_";104///"_$P($G(^RMPR(660,D6I,0)),"^",16)_";106///@;107///@"
  1. D ^DIE
  1. K DA,DIE,DR
  1. ;
  1. K RMPRDFN,RMPRDG1,RMPRDRG,RMPRFLAG,RMPRFT1,RMPRHCPC,RMPRHLOC,RMPRITEM,RMPRPAR,RMPRPR1,RMPRPROS,RMPRRXDT,RMPRRXI,RMPRSTA,RMPRSTAT,RMPRTYPE,RMPRUCID
  1. Q
  1. CHRGCRED ; Called when an previously charged item is deleted from 665.72
  1. ; Variables passed in via TaskMan
  1. ; RMPRSITE = 665.72 IEN - SITE
  1. ; RMPRBLDT = 665.723;1 - BILLING MONTH IEN
  1. ; RMPRVDR = 665.7231;1 - VENDOR IEN (DINUM 440)
  1. ; RMPRDFN = 665.72319;9 - PATIENT IEN (DINUM 200)
  1. ; RMPRITEM = 665.723191 - ITEM IEN
  1. ; RMPRPFSS = DATA FROM THE ITEM'S "PFSS" NODE
  1. ;
  1. ;Quit if item data still exists
  1. Q:$D(^RMPO(665.72,RMPRSITE,1,RMPRBLDT,1,RMPRVDR,"V",RMPRDFN,1,RMPRITEM,0))
  1. S RMPRFLAG=$$CHARGE^IBBAPI(RMPRDFN,$P(RMPRPFSS,"^",1),"CD",$P(RMPRPFSS,"^",2))
  1. K RMPRBLDT,RMPRDFN,RMPRFLAG,RMPRITEM,RMPRPFSS,RMPRSITE,RMPRVDR
  1. Q