RMPOPS23 ;HIN/RVD - HOME OXYGEN BILLING - POST TO 2319 ;5/18/99
;;3.0;PROSTHETICS;**29,44,41,110**;Feb 09, 1996;Build 10
;
;This routine will only post records already been posted in IFCAP.
;Patient records are sorted by fund control point (FCP), DFN and
;then post to 2319.
Q
;
POST ;main module to post billing transactions to 2319
D HOME^%ZIS S QUIT=0
D HOSITE^RMPOUTL0 Q:('$D(RMPOXITE))!QUIT
D MONTH^RMPOBIL0() Q:$D(RMPODATE)=0!QUIT
D VENDOR^RMPOBIL0() Q:$D(RMPOVDR)=0!QUIT
S FIL=665.72,SITE=RMPOXITE,RVDT=RMPODATE,VDR=RMPOVDR,QUIT=0
W !,"Processing..." D BUILD
I $O(^TMP($J,""))="" W !,"Everything posted okay!!" G EXIT
S FCP="" F S FCP=$O(^TMP($J,FCP)) Q:FCP="" F DFN=0:0 S DFN=$O(^TMP($J,FCP,DFN)) Q:DFN'>0 D F660
;K DIR S DIR(0)="FO",DIR("A")="Press any Key to Continue" D ^DIR
;
EXIT ;
K ^TMP($J)
;K DFN,ITM,ITDT,ITNO,PATNAM,PATSSN,LNAM,PATFLG,ITSTR,FCP,LCK,ITOT
N RMPRSITE,RMPR D KILL^XUSCLEAN
Q
;
BUILD ;Build array IFCAP with patient transactions to post
;Separate patient individual items by fund control point
;tMP($J) array
; ^TMP($J,FCP)=FCP total^Post flag^error message^purchase card total
; ^TMP($J,FCP,DFN)=patient tot^pat last name_" "_4 digit SSN^post flag^
; IFCAP error message^pat name
; ^TMP($J,FCP,DFN,ITEM)=item tot
K ^TMP($J)
S DFN=0 F S DFN=$O(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN)) Q:DFN'>0 D
. S PATFLG=^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0)
. ;check patient post flag
. Q:$P(PATFLG,U,3)'="Y"
. D DEM^VADPT S PATNAM=VADM(1),PATSSN=VA("BID") ;patient name & ssn
. ;lock patient record
. S LCK=$$PATLCK() I 'LCK W !,PATNAM," record locked by another user" Q
. ;get items not posted for each patient
. S ITM=0
. F S ITM=$O(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,ITM)) Q:'ITM D
. . S ITDT=^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,ITM,0)
. . ;check if item posted
. . Q:$P(ITDT,U,10)'="Y"
. . Q:$P(ITDT,U,16)>0
. . S ITNO=$P(ITDT,U),FCP=$P(ITDT,U,3),ITOT=$P(ITDT,U,6)
. . I ITOT'>0 Q ;no amount to post
. . I FCP="" Q ;no fund control point
. . ;set ^TMP($J) array
. . S ^TMP($J,FCP)=$S('$D(^TMP($J,FCP)):0.00,1:^TMP($J,FCP))+ITOT
. . I $G(^TMP($J,FCP,DFN))="" D
. . . S LNAM=$E($P(PATNAM,",")_" ",1,7)
. . . S ^TMP($J,FCP,DFN)="^"_LNAM_" "_PATSSN_"^^^"_$E(PATNAM,1,18)
. . S $P(^TMP($J,FCP,DFN),U)=+^TMP($J,FCP,DFN)+ITOT,^TMP($J,FCP,DFN,ITM)=ITOT
. D UNLKPAT
Q
;
F660 ;Post to file ^RMPR(660 for form 2319
S D665A=$G(^RMPR(665,DFN,"RMPOA")) I D665A="" Q
D ;AMIS grouper number
. L +^RMPR(669.9,RMPOXITE,0):9999 I $T=0 S RMPOG=DT_$P(DT,2,3) Q
. S RMPOG=$P(^RMPR(669.9,RMPOXITE,0),U,7),RMPOG=RMPOG-1
. S $P(^RMPR(669.9,RMPOXITE,0),U,7)=RMPOG
. L -^RMPR(669.9,RMPOXITE,0)
S TRXDT=$P(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RMPOVDR,0),U,2)
S RFCPIEN=$O(^RMPO(665.72,1,1,RMPODATE,2,"B",FCP,0))
S SRVORD=$P(^RMPO(665.72,RMPOXITE,1,RMPODATE,2,RFCPIEN,0),U,4)
S PAYINF=$P(^RMPO(665.72,RMPOXITE,1,RMPODATE,2,RFCPIEN,0),U,2)
S ITM=0 F S ITM=$O(^TMP($J,FCP,DFN,ITM)) Q:ITM'>0 D
. S ITMD=$G(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RMPOVDR,"V",DFN,1,ITM,0))
. S RMITEM=$P(ITMD,U,1)
. I $G(RMITEM),$D(^RMPR(661,RMITEM,0)) S RITIEN=$P(^RMPR(661,RMITEM,0),U,1)
. I ITMD="" Q
. I $P(ITMD,U,6)'>0 Q ;nothing posted to IFCAP
. S RMCPHC=$P(ITMD,U,2),RMCPT="",RMCPRENT=$P(ITMD,U,18),RMCPSO="C"
. S RMCPTY=$P(ITMD,U,14),RMCPQH=$P(ITMD,U,19)
. S RMCPT1=$G(^RMPR(661.1,RMCPHC,4))
. I RMCPT1["RP",((RMCPTY="R")!(RMCPTY="X")) S RMCPT=RMCPT_"RP,"
. I RMCPT1["QH",($G(RMCPQH)) S RMCPT=RMCPT_"QH,"
. I (RMCPRENT=1),(RMCPT1["RR") S RMCPT=RMCPT_"RR,"
. I RMCPT1["NU",(RMCPT'["RR") S RMCPT=RMCPT_"NU,"
. I $L(RMCPT)>2 S RMCLEN=$L(RMCPT),RMCPT=$E(RMCPT,1,RMCLEN-1)
. S DIC="^RMPR(660,",DIC(0)="L",X=DT
. K DD,DO D FILE^DICN I +Y<0 Q
. S D6I=+Y,D6X=D6I_","
. K DIE,DA,DR S DA(4)=RMPOXITE,DA(3)=RMPODATE,DA(2)=RMPOVDR,DA(1)=DFN
. S DIE="^RMPO(665.72,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_",""V"","_DA(1)
. S DIE=DIE_",1,",DA=ITM,DR="15////^S X=D6I" D ^DIE
. S D660(660,D6X,.02)=DFN ;Patient name pointer
. S D660(660,D6X,1)=TRXDT ;Request date
. S D660(660,D6X,2)=$P(ITMD,U,14) ;Type of transaction
. S D660(660,D6X,4)=$P(ITMD,U) ;item
. S D660(660,D6X,4.1)=$P(^RMPR(661.1,$P(ITMD,U,2),0),U,4) ;HCPCS
. S D660(660,D6X,4.5)=$P(ITMD,U,2) ;PSAS HCPCS
. S D660(660,D6X,4.7)=RMCPT ;RMCPT
. S D660(660,D6X,5)=$P(ITMD,U,7) ;quantity
. S D660(660,D6X,7)=RMPOVDR ;vendor
. S D660(660,D6X,8)=RMPO("STA") ;station
. S D660(660,D6X,10)=DT ;Delivery date
. I $P(PAYINF,U) S D660(660,D6X,11)=9
. I $P(PAYINF,U)="P" S D660(660,D6X,11)=14
. S D660(660,D6X,23)=SRVORD ;IFCAP transaction number
. S D660(660,D6X,12)="C" ;Source
. S D660(660,D6X,14)=$P(ITMD,U,6) ;total cost
. S D660(660,D6X,16)=$P(ITMD,U,4) ;remarks
. S SUSDES=$S($P(ITMD,U,11)'="":"Suspended Amt "_$P(ITMD,U,11)_" ",1:"")
. S D660(660,D6X,24)=SUSDES_$P(ITMD,U,12) ;description
. S D660(660,D6X,27)=DUZ ;initator
. S D660(660,D6X,62)=$P(D665A,U) ;patient category
. S D660(660,D6X,63)=$P(D665A,U,5) ;special category
. S D660(660,D6X,68)=RMPOG
. S D660(660,D6X,78)=$P(ITMD,U,15) ;unit of issue
. D FILE^DIE("K","D660","ERR")
. I $D(ERR) D
. . W !!,"Posting to 2319 for item ",ITM," patient ",DFN," failed."
. . W "Posting will be done later"
. I '$D(ERR),$D(^DPT(DFN,0)),$D(^PRC(441,RITIEN,0)) D
. . W !,"Patient: ",$P(^DPT(DFN,0),U,1)," Item: ",ITM," posted to 2319."
K DIC,X,Y
Q
;
PATLCK() ;Lock patient level in ^RMPO(665.72
L +^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0):5
Q $T
;
UNLKPAT ;Unlock patient level in ^RMPO(665.72
L -^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0)
Q
;
QUIT() S QUIT=$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOPS23 5957 printed Dec 13, 2024@02:31:22 Page 2
RMPOPS23 ;HIN/RVD - HOME OXYGEN BILLING - POST TO 2319 ;5/18/99
+1 ;;3.0;PROSTHETICS;**29,44,41,110**;Feb 09, 1996;Build 10
+2 ;
+3 ;This routine will only post records already been posted in IFCAP.
+4 ;Patient records are sorted by fund control point (FCP), DFN and
+5 ;then post to 2319.
+6 QUIT
+7 ;
POST ;main module to post billing transactions to 2319
+1 DO HOME^%ZIS
SET QUIT=0
+2 DO HOSITE^RMPOUTL0
if ('$DATA(RMPOXITE))!QUIT
QUIT
+3 DO MONTH^RMPOBIL0()
if $DATA(RMPODATE)=0!QUIT
QUIT
+4 DO VENDOR^RMPOBIL0()
if $DATA(RMPOVDR)=0!QUIT
QUIT
+5 SET FIL=665.72
SET SITE=RMPOXITE
SET RVDT=RMPODATE
SET VDR=RMPOVDR
SET QUIT=0
+6 WRITE !,"Processing..."
DO BUILD
+7 IF $ORDER(^TMP($JOB,""))=""
WRITE !,"Everything posted okay!!"
GOTO EXIT
+8 SET FCP=""
FOR
SET FCP=$ORDER(^TMP($JOB,FCP))
if FCP=""
QUIT
FOR DFN=0:0
SET DFN=$ORDER(^TMP($JOB,FCP,DFN))
if DFN'>0
QUIT
DO F660
+9 ;K DIR S DIR(0)="FO",DIR("A")="Press any Key to Continue" D ^DIR
+10 ;
EXIT ;
+1 KILL ^TMP($JOB)
+2 ;K DFN,ITM,ITDT,ITNO,PATNAM,PATSSN,LNAM,PATFLG,ITSTR,FCP,LCK,ITOT
+3 NEW RMPRSITE,RMPR
DO KILL^XUSCLEAN
+4 QUIT
+5 ;
BUILD ;Build array IFCAP with patient transactions to post
+1 ;Separate patient individual items by fund control point
+2 ;tMP($J) array
+3 ; ^TMP($J,FCP)=FCP total^Post flag^error message^purchase card total
+4 ; ^TMP($J,FCP,DFN)=patient tot^pat last name_" "_4 digit SSN^post flag^
+5 ; IFCAP error message^pat name
+6 ; ^TMP($J,FCP,DFN,ITEM)=item tot
+7 KILL ^TMP($JOB)
+8 SET DFN=0
FOR
SET DFN=$ORDER(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN))
if DFN'>0
QUIT
Begin DoDot:1
+9 SET PATFLG=^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0)
+10 ;check patient post flag
+11 if $PIECE(PATFLG,U,3)'="Y"
QUIT
+12 ;patient name & ssn
DO DEM^VADPT
SET PATNAM=VADM(1)
SET PATSSN=VA("BID")
+13 ;lock patient record
+14 SET LCK=$$PATLCK()
IF 'LCK
WRITE !,PATNAM," record locked by another user"
QUIT
+15 ;get items not posted for each patient
+16 SET ITM=0
+17 FOR
SET ITM=$ORDER(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,ITM))
if 'ITM
QUIT
Begin DoDot:2
+18 SET ITDT=^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,ITM,0)
+19 ;check if item posted
+20 if $PIECE(ITDT,U,10)'="Y"
QUIT
+21 if $PIECE(ITDT,U,16)>0
QUIT
+22 SET ITNO=$PIECE(ITDT,U)
SET FCP=$PIECE(ITDT,U,3)
SET ITOT=$PIECE(ITDT,U,6)
+23 ;no amount to post
IF ITOT'>0
QUIT
+24 ;no fund control point
IF FCP=""
QUIT
+25 ;set ^TMP($J) array
+26 SET ^TMP($JOB,FCP)=$SELECT('$DATA(^TMP($JOB,FCP)):0.00,1:^TMP($JOB,FCP))+ITOT
+27 IF $GET(^TMP($JOB,FCP,DFN))=""
Begin DoDot:3
+28 SET LNAM=$EXTRACT($PIECE(PATNAM,",")_" ",1,7)
+29 SET ^TMP($JOB,FCP,DFN)="^"_LNAM_" "_PATSSN_"^^^"_$EXTRACT(PATNAM,1,18)
End DoDot:3
+30 SET $PIECE(^TMP($JOB,FCP,DFN),U)=+^TMP($JOB,FCP,DFN)+ITOT
SET ^TMP($JOB,FCP,DFN,ITM)=ITOT
End DoDot:2
+31 DO UNLKPAT
End DoDot:1
+32 QUIT
+33 ;
F660 ;Post to file ^RMPR(660 for form 2319
+1 SET D665A=$GET(^RMPR(665,DFN,"RMPOA"))
IF D665A=""
QUIT
+2 ;AMIS grouper number
Begin DoDot:1
+3 LOCK +^RMPR(669.9,RMPOXITE,0):9999
IF $TEST=0
SET RMPOG=DT_$PIECE(DT,2,3)
QUIT
+4 SET RMPOG=$PIECE(^RMPR(669.9,RMPOXITE,0),U,7)
SET RMPOG=RMPOG-1
+5 SET $PIECE(^RMPR(669.9,RMPOXITE,0),U,7)=RMPOG
+6 LOCK -^RMPR(669.9,RMPOXITE,0)
End DoDot:1
+7 SET TRXDT=$PIECE(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RMPOVDR,0),U,2)
+8 SET RFCPIEN=$ORDER(^RMPO(665.72,1,1,RMPODATE,2,"B",FCP,0))
+9 SET SRVORD=$PIECE(^RMPO(665.72,RMPOXITE,1,RMPODATE,2,RFCPIEN,0),U,4)
+10 SET PAYINF=$PIECE(^RMPO(665.72,RMPOXITE,1,RMPODATE,2,RFCPIEN,0),U,2)
+11 SET ITM=0
FOR
SET ITM=$ORDER(^TMP($JOB,FCP,DFN,ITM))
if ITM'>0
QUIT
Begin DoDot:1
+12 SET ITMD=$GET(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RMPOVDR,"V",DFN,1,ITM,0))
+13 SET RMITEM=$PIECE(ITMD,U,1)
+14 IF $GET(RMITEM)
IF $DATA(^RMPR(661,RMITEM,0))
SET RITIEN=$PIECE(^RMPR(661,RMITEM,0),U,1)
+15 IF ITMD=""
QUIT
+16 ;nothing posted to IFCAP
IF $PIECE(ITMD,U,6)'>0
QUIT
+17 SET RMCPHC=$PIECE(ITMD,U,2)
SET RMCPT=""
SET RMCPRENT=$PIECE(ITMD,U,18)
SET RMCPSO="C"
+18 SET RMCPTY=$PIECE(ITMD,U,14)
SET RMCPQH=$PIECE(ITMD,U,19)
+19 SET RMCPT1=$GET(^RMPR(661.1,RMCPHC,4))
+20 IF RMCPT1["RP"
IF ((RMCPTY="R")!(RMCPTY="X"))
SET RMCPT=RMCPT_"RP,"
+21 IF RMCPT1["QH"
IF ($GET(RMCPQH))
SET RMCPT=RMCPT_"QH,"
+22 IF (RMCPRENT=1)
IF (RMCPT1["RR")
SET RMCPT=RMCPT_"RR,"
+23 IF RMCPT1["NU"
IF (RMCPT'["RR")
SET RMCPT=RMCPT_"NU,"
+24 IF $LENGTH(RMCPT)>2
SET RMCLEN=$LENGTH(RMCPT)
SET RMCPT=$EXTRACT(RMCPT,1,RMCLEN-1)
+25 SET DIC="^RMPR(660,"
SET DIC(0)="L"
SET X=DT
+26 KILL DD,DO
DO FILE^DICN
IF +Y<0
QUIT
+27 SET D6I=+Y
SET D6X=D6I_","
+28 KILL DIE,DA,DR
SET DA(4)=RMPOXITE
SET DA(3)=RMPODATE
SET DA(2)=RMPOVDR
SET DA(1)=DFN
+29 SET DIE="^RMPO(665.72,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_",""V"","_DA(1)
+30 SET DIE=DIE_",1,"
SET DA=ITM
SET DR="15////^S X=D6I"
DO ^DIE
+31 ;Patient name pointer
SET D660(660,D6X,.02)=DFN
+32 ;Request date
SET D660(660,D6X,1)=TRXDT
+33 ;Type of transaction
SET D660(660,D6X,2)=$PIECE(ITMD,U,14)
+34 ;item
SET D660(660,D6X,4)=$PIECE(ITMD,U)
+35 ;HCPCS
SET D660(660,D6X,4.1)=$PIECE(^RMPR(661.1,$PIECE(ITMD,U,2),0),U,4)
+36 ;PSAS HCPCS
SET D660(660,D6X,4.5)=$PIECE(ITMD,U,2)
+37 ;RMCPT
SET D660(660,D6X,4.7)=RMCPT
+38 ;quantity
SET D660(660,D6X,5)=$PIECE(ITMD,U,7)
+39 ;vendor
SET D660(660,D6X,7)=RMPOVDR
+40 ;station
SET D660(660,D6X,8)=RMPO("STA")
+41 ;Delivery date
SET D660(660,D6X,10)=DT
+42 IF $PIECE(PAYINF,U)
SET D660(660,D6X,11)=9
+43 IF $PIECE(PAYINF,U)="P"
SET D660(660,D6X,11)=14
+44 ;IFCAP transaction number
SET D660(660,D6X,23)=SRVORD
+45 ;Source
SET D660(660,D6X,12)="C"
+46 ;total cost
SET D660(660,D6X,14)=$PIECE(ITMD,U,6)
+47 ;remarks
SET D660(660,D6X,16)=$PIECE(ITMD,U,4)
+48 SET SUSDES=$SELECT($PIECE(ITMD,U,11)'="":"Suspended Amt "_$PIECE(ITMD,U,11)_" ",1:"")
+49 ;description
SET D660(660,D6X,24)=SUSDES_$PIECE(ITMD,U,12)
+50 ;initator
SET D660(660,D6X,27)=DUZ
+51 ;patient category
SET D660(660,D6X,62)=$PIECE(D665A,U)
+52 ;special category
SET D660(660,D6X,63)=$PIECE(D665A,U,5)
+53 SET D660(660,D6X,68)=RMPOG
+54 ;unit of issue
SET D660(660,D6X,78)=$PIECE(ITMD,U,15)
+55 DO FILE^DIE("K","D660","ERR")
+56 IF $DATA(ERR)
Begin DoDot:2
+57 WRITE !!,"Posting to 2319 for item ",ITM," patient ",DFN," failed."
+58 WRITE "Posting will be done later"
End DoDot:2
+59 IF '$DATA(ERR)
IF $DATA(^DPT(DFN,0))
IF $DATA(^PRC(441,RITIEN,0))
Begin DoDot:2
+60 WRITE !,"Patient: ",$PIECE(^DPT(DFN,0),U,1)," Item: ",ITM," posted to 2319."
End DoDot:2
End DoDot:1
+61 KILL DIC,X,Y
+62 QUIT
+63 ;
PATLCK() ;Lock patient level in ^RMPO(665.72
+1 LOCK +^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0):5
+2 QUIT $TEST
+3 ;
UNLKPAT ;Unlock patient level in ^RMPO(665.72
+1 LOCK -^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0)
+2 QUIT
+3 ;
QUIT() SET QUIT=$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT QUIT
