108 lines
3.6 KiB
Mathematica
108 lines
3.6 KiB
Mathematica
RMPOLM ;EDS/MDB-HINES CIOFO/HNC,RVD - HOME OXYGEN LISTMAN CODE ;7/24/98
|
|
;;3.0;PROSTHETICS;**29,46,49,50**;Feb 09, 1996
|
|
;ODJ - Fix FCP problem - patch 49
|
|
; (all PSAS FCPs should go into '910' col. else 'Other' col.)
|
|
; also fix problem where you can get null FCP
|
|
;ODJ - Fix looping problem in INIT - patch 50
|
|
;
|
|
Q
|
|
EN ; -- main entry point for RMPO BILLING TRANSACTION
|
|
D EN^VALM("RMPO BILLING TRANSACTION")
|
|
Q
|
|
;
|
|
HDR ; -- header code
|
|
S VALMHDR(1)="Billing Transactions for "_$P(^PRC(440,RMPOVDR,0),U)
|
|
S Y=RMPODATE X ^DD("DD")
|
|
S VALMHDR(2)="for "_Y
|
|
Q
|
|
;
|
|
INIT ; -- init variables and list array
|
|
;
|
|
S DFLAG=$G(DFLAG,"B") ; DISPLAY FLAG A=ACCEPTED, U=UNACCEPTED, B=BOTH
|
|
S LINE=0,DFN=0,VDR=RMPOVDR,SITE=RMPOXITE,RVDT=RMPORVDT,FN=665.72
|
|
S RMPRPT=0
|
|
F S RMPRPT=$O(^RMPO(FN,"AB",RMPRPT)) Q:RMPRPT="" D
|
|
. S DFN=""
|
|
. F S DFN=$O(^RMPO(FN,"AB",RMPRPT,SITE,RVDT,VDR,DFN)) Q:DFN="" D
|
|
.. I '$D(^RMPO(FN,SITE,1,RVDT,1,VDR,"V",DFN,0)) K ^RMPO(FN,"AB",RMPRPT,SITE,RVDT,VDR,DFN) Q
|
|
.. ; Quit if Posted
|
|
.. S PSTFLG=$P(^RMPO(FN,SITE,1,RVDT,1,VDR,"V",DFN,0),U,3)
|
|
.. Q:PSTFLG="Y"
|
|
.. S PITM=$P($$PIEN^RMPOPED(DFN),U,2)
|
|
.. I '$G(PITM) W !!,$C(7),"Patient: ",$P($G(^DPT(DFN,0)),U)," has no primary ITEM, please ENTER a PRIMARY item before posting..." H 3
|
|
.. Q:'$G(PITM)
|
|
.. S PSTFLG=$S(PSTFLG="P":"p",1:"")
|
|
.. D DEM^VADPT S NAME=$E(VADM(1),0,11),SSN=VA("BID")
|
|
.. S ELIG=$P(^RMPR(665,DFN,"RMPOA"),U)
|
|
.. S ACCFLG=$P(^RMPO(FN,SITE,1,RVDT,1,VDR,"V",DFN,0),U,2)
|
|
.. S ACCFLG=$S(ACCFLG="Y":"a",1:"")
|
|
.. I DFLAG="U" Q:ACCFLG]""
|
|
.. I DFLAG="A" Q:ACCFLG=""
|
|
.. S ITM=0,T910=0,OTH=0,TOTAL=0,SUSP=0,PST910=" ",PSTOTH=" "
|
|
.. F S ITM=$O(^RMPO(FN,SITE,1,RVDT,1,VDR,"V",DFN,1,ITM)) Q:ITM'>0 D
|
|
... S NODE=^RMPO(FN,SITE,1,RVDT,1,VDR,"V",DFN,1,ITM,0)
|
|
... S AMT=$P(NODE,U,6),SUSPI=$P(NODE,U,11)
|
|
... S SUSP=SUSP+SUSPI
|
|
... I $$PSASFCP(SITE,$P(NODE,U,3)) D
|
|
.... S T910=T910+AMT+SUSPI
|
|
.... I $P(NODE,U,10)="Y" S PST910="*"
|
|
.... Q
|
|
... E D
|
|
.... S OTH=OTH+AMT+SUSPI
|
|
.... I $P(NODE,U,10)="Y" S PSTOTH="*"
|
|
.... Q
|
|
... ; S TOTAL=TOTAL+AMT-SUSPI
|
|
... S TOTAL=TOTAL+AMT
|
|
... Q
|
|
.. S ITEMNM=$P($$ITEMNM^RMPOPED(PITM),U)
|
|
.. S LINE=LINE+1
|
|
.. S X=$$SETFLD^VALM1($J(LINE,2)_".","","NUMBER")
|
|
.. S X=$$SETFLD^VALM1(ELIG,X,"ELIG")
|
|
.. S X=$$SETFLD^VALM1(SSN,X,"SSN")
|
|
.. S X=$$SETFLD^VALM1(NAME,X,"NAME")
|
|
.. S X=$$SETFLD^VALM1(ITEMNM,X,"PRIMARY ITEM")
|
|
.. S X=$$SETFLD^VALM1($$RJ(T910,"T910",PST910="*")_PST910,X,"T910")
|
|
.. S X=$$SETFLD^VALM1($$RJ(OTH,"OTHER",PSTOTH="*")_PSTOTH,X,"OTHER")
|
|
.. S X=$$SETFLD^VALM1($$RJ(TOTAL,"TOTAL"),X,"TOTAL")
|
|
.. S X=$$SETFLD^VALM1($$RJ(SUSP,"SUSP"),X,"SUSP")
|
|
.. S X=$$SETFLD^VALM1(ACCFLG,X,"ACCFLG")
|
|
.. S X=$$SETFLD^VALM1(PSTFLG,X,"PSTFLG")
|
|
.. D SET^VALM10(LINE,X,DFN)
|
|
.. Q
|
|
. Q
|
|
S VALMCNT=LINE
|
|
Q
|
|
;
|
|
RJ(FLDVAL,FLDNAM,OFFSET) ; RIGHT-JUSTIFY FIELD
|
|
;
|
|
Q $J(FLDVAL,$P(VALMDDF(FLDNAM),U,3)-$G(OFFSET),2)
|
|
Q
|
|
HELP ; -- help code
|
|
S X="?" D DISP^XQORM1 W !!
|
|
Q
|
|
;
|
|
EXIT ; -- exit code
|
|
K DFLAG,DIC,DIE,DIR,DO,DD,DA,DIROUT,DTOUT,DUOUT,FLDVAL,FLDNAM,OFFSET
|
|
K LINE,DFN,VDR,SITE,RVDT,FN,PSTFLG,PITM,NAME,SSN,ELIG,ACCFLG,ITM,T910
|
|
K OTH,SUSP,PST910,PSTOTH,NODE,AMT,SUSPI,TOTAL,ITEMNM,VALMCNT,VALMHDR,X,Y
|
|
K VALMAR,VALMBCK,VALMBG,VALMLST,VALMDDF,VADM,RMPRPT
|
|
Q
|
|
;
|
|
EXPND ; -- expand code
|
|
Q
|
|
;
|
|
; (p49) Function returns 1 if an FCP is a PSAS site, 0 if not.
|
|
; Anything other than a Y in the field is assumed non PSAS
|
|
; Inputs are Site (subsc 2 in RMPR(669.9
|
|
; FCP (subsc 5 in RMPR(669.9,Site,"RMPOFCP","B"
|
|
PSASFCP(RMPOXITE,RFCPI) ;
|
|
N RFCPIEN,REC,RET
|
|
S RET=0
|
|
I RMPOXITE=""!(RFCPI="") G PSASFCPX
|
|
S RFCPIEN=$O(^RMPR(669.9,RMPOXITE,"RMPOFCP","B",RFCPI,0))
|
|
I RFCPIEN="" G PSASFCPX
|
|
S REC=$G(^RMPR(669.9,RMPOXITE,"RMPOFCP",RFCPIEN,0))
|
|
I $P(REC,U,2)="Y" S RET=1
|
|
PSASFCPX ;
|
|
Q RET
|