RMPOPST3 ;EDS/JAM,HinesIO/DDA - HOME OXYGEN BILLING TRANSACTIONS/ACCEPT FOR POST ;7/24/98
;;3.0;PROSTHETICS;**29,44,41,98,110**;Feb 09, 1996;Build 10
;This subroutine is part of the billing module. Check file 665.72
;for accepted transactions not yet posted.
Q
ACCEPT ; Check for accepted entries and post if user indicates
N DFNS
D FNDACC I $O(DFNS(""))="" Q
D PSTACC
Q ;ACCEPT
;
TEST ;set test data
N RMPOXITE,RMPOVDR,RMPODATE,DFNS
S RMPOXITE=1,RMPOVDR=10,RMPODATE=2981200,DFNS(47)=""
S RMPO("STA")=521
D FNDACC I $O(DFNS(""))="" Q
D PSTACC
Q ;TEST
;
FNDACC ;Check records to ensure all accepted transactions are posted.
N DFN,BILDT,SITE,FIL,VDR,I
S FIL=665.72,SITE=RMPOXITE,BILDT=RMPODATE,VDR=RMPOVDR
S DFN=0
F I=1:1 S DFN=$O(^RMPO(FIL,SITE,1,BILDT,1,VDR,"V",DFN)) Q:'DFN D
. ;check if patient transaction posted
. I $P(^RMPO(FIL,SITE,1,BILDT,1,VDR,"V",DFN,0),U,3)="Y" Q
. ;check if patient transaction accepted
. I $P(^RMPO(FIL,SITE,1,BILDT,1,VDR,"V",DFN,0),U,2)'="Y" Q
. I I=10 D
. . W !!,"Verifying all accepted transactions posted. Please be patient"
. S DFNS(DFN)=""
Q ;FNDACC
;
PSTACC ;Post accepted transactions if so indicated by user
N MES K DIR
S DIR(0)="Y",DIR("B")="NO"
S MES="There are patients whose billing transactions have been accepted"
S DIR("A",1)=MES,DIR("A",2)=" and not yet posted"
S DIR("A")="Would you like to post them now"
S DIR("?")="YES will Post accepted transaction and NO will not post"
D ^DIR
I 'Y!($D(DIRUT))!($D(DIROUT)) Q
;Call post module to post transactions
D POST^RMPOPST0
K DIR,DIRUT,DIROUT,Y
Q ;PSTACC
F660 ;Post to file ^RMPR(660 for form 2319
N ITM,ITMD,D665A,SUSDES,TRXDT,D660,D6I,D6X,RMPOG,ERR
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 ITM="" F S ITM=$O(^TMP($J,FCP,DFN,ITM)) Q:ITM="" D
. S ITMD=$G(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RMPOVDR,"V",DFN,1,ITM,0))
. 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 ;CPT MODIFIER
. S D660(660,D6X,5)=$P(ITMD,U,7)-$P(ITMD,U,17) ;quantity
. S D660(660,D6X,7)=RMPOVDR ;vendor
. S D660(660,D6X,8)=RMPO("STA") ;station
. S D660(660,D6X,10)=CURDT ;Delivery date
. D
. . I $P(PAYINF,U) D Q
. . . S D660(660,D6X,11)=9 ;form requested on(1358)
. . . ;IFCAP transaction number - from file 424
. . . I $G(IEN424)'="" S D660(660,D6X,23)=$P($G(^PRC(424,IEN424,0)),U)
. . S D660(660,D6X,11)=14 ;form requested on (visa)
. . 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 ;initiator
. 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"
. . Q
. ; RMPR*3*98
. ; CALL TO PROCESS PFSS CHARGE MESSAGE
. I '$D(ERR) D CHARGE^RMPOPF
. Q
K DIC,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOPST3 4870 printed Apr 09, 2024@21:34:59 Page 2
RMPOPST3 ;EDS/JAM,HinesIO/DDA - HOME OXYGEN BILLING TRANSACTIONS/ACCEPT FOR POST ;7/24/98
+1 ;;3.0;PROSTHETICS;**29,44,41,98,110**;Feb 09, 1996;Build 10
+2 ;This subroutine is part of the billing module. Check file 665.72
+3 ;for accepted transactions not yet posted.
+4 QUIT
ACCEPT ; Check for accepted entries and post if user indicates
+1 NEW DFNS
+2 DO FNDACC
IF $ORDER(DFNS(""))=""
QUIT
+3 DO PSTACC
+4 ;ACCEPT
QUIT
+5 ;
TEST ;set test data
+1 NEW RMPOXITE,RMPOVDR,RMPODATE,DFNS
+2 SET RMPOXITE=1
SET RMPOVDR=10
SET RMPODATE=2981200
SET DFNS(47)=""
+3 SET RMPO("STA")=521
+4 DO FNDACC
IF $ORDER(DFNS(""))=""
QUIT
+5 DO PSTACC
+6 ;TEST
QUIT
+7 ;
FNDACC ;Check records to ensure all accepted transactions are posted.
+1 NEW DFN,BILDT,SITE,FIL,VDR,I
+2 SET FIL=665.72
SET SITE=RMPOXITE
SET BILDT=RMPODATE
SET VDR=RMPOVDR
+3 SET DFN=0
+4 FOR I=1:1
SET DFN=$ORDER(^RMPO(FIL,SITE,1,BILDT,1,VDR,"V",DFN))
if 'DFN
QUIT
Begin DoDot:1
+5 ;check if patient transaction posted
+6 IF $PIECE(^RMPO(FIL,SITE,1,BILDT,1,VDR,"V",DFN,0),U,3)="Y"
QUIT
+7 ;check if patient transaction accepted
+8 IF $PIECE(^RMPO(FIL,SITE,1,BILDT,1,VDR,"V",DFN,0),U,2)'="Y"
QUIT
+9 IF I=10
Begin DoDot:2
+10 WRITE !!,"Verifying all accepted transactions posted. Please be patient"
End DoDot:2
+11 SET DFNS(DFN)=""
End DoDot:1
+12 ;FNDACC
QUIT
+13 ;
PSTACC ;Post accepted transactions if so indicated by user
+1 NEW MES
KILL DIR
+2 SET DIR(0)="Y"
SET DIR("B")="NO"
+3 SET MES="There are patients whose billing transactions have been accepted"
+4 SET DIR("A",1)=MES
SET DIR("A",2)=" and not yet posted"
+5 SET DIR("A")="Would you like to post them now"
+6 SET DIR("?")="YES will Post accepted transaction and NO will not post"
+7 DO ^DIR
+8 IF 'Y!($DATA(DIRUT))!($DATA(DIROUT))
QUIT
+9 ;Call post module to post transactions
+10 DO POST^RMPOPST0
+11 KILL DIR,DIRUT,DIROUT,Y
+12 ;PSTACC
QUIT
F660 ;Post to file ^RMPR(660 for form 2319
+1 NEW ITM,ITMD,D665A,SUSDES,TRXDT,D660,D6I,D6X,RMPOG,ERR
+2 SET D665A=$GET(^RMPR(665,DFN,"RMPOA"))
IF D665A=""
QUIT
+3 ;AMIS grouper number
Begin DoDot:1
+4 LOCK +^RMPR(669.9,RMPOXITE,0):9999
IF $TEST=0
SET RMPOG=DT_$PIECE(DT,2,3)
QUIT
+5 SET RMPOG=$PIECE(^RMPR(669.9,RMPOXITE,0),U,7)
SET RMPOG=RMPOG-1
+6 SET $PIECE(^RMPR(669.9,RMPOXITE,0),U,7)=RMPOG
+7 LOCK -^RMPR(669.9,RMPOXITE,0)
End DoDot:1
+8 SET TRXDT=$PIECE(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RMPOVDR,0),U,2)
+9 SET ITM=""
FOR
SET ITM=$ORDER(^TMP($JOB,FCP,DFN,ITM))
if ITM=""
QUIT
Begin DoDot:1
+10 SET ITMD=$GET(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RMPOVDR,"V",DFN,1,ITM,0))
+11 IF ITMD=""
QUIT
+12 ; I $P(ITMD,U,6)'>0 Q ;nothing posted to IFCAP
+13 SET RMCPHC=$PIECE(ITMD,U,2)
SET RMCPT=""
SET RMCPRENT=$PIECE(ITMD,U,18)
SET RMCPSO="C"
+14 SET RMCPTY=$PIECE(ITMD,U,14)
SET RMCPQH=$PIECE(ITMD,U,19)
+15 SET RMCPT1=$GET(^RMPR(661.1,RMCPHC,4))
+16 IF RMCPT1["RP"
IF ((RMCPTY="R")!(RMCPTY="X"))
SET RMCPT=RMCPT_"RP,"
+17 IF RMCPT1["QH"
IF ($GET(RMCPQH))
SET RMCPT=RMCPT_"QH,"
+18 IF (RMCPRENT=1)
IF (RMCPT1["RR")
SET RMCPT=RMCPT_"RR,"
+19 IF RMCPT1["NU"
IF (RMCPT'["RR")
SET RMCPT=RMCPT_"NU,"
+20 IF $LENGTH(RMCPT)>2
SET RMCLEN=$LENGTH(RMCPT)
SET RMCPT=$EXTRACT(RMCPT,1,RMCLEN-1)
+21 SET DIC="^RMPR(660,"
SET DIC(0)="L"
SET X=DT
+22 KILL DD,DO
DO FILE^DICN
IF +Y<0
QUIT
+23 SET D6I=+Y
SET D6X=D6I_","
+24 KILL DIE,DA,DR
SET DA(4)=RMPOXITE
SET DA(3)=RMPODATE
SET DA(2)=RMPOVDR
SET DA(1)=DFN
+25 SET DIE="^RMPO(665.72,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_",""V"","_DA(1)
+26 SET DIE=DIE_",1,"
SET DA=ITM
SET DR="15////^S X=D6I"
DO ^DIE
+27 ;Patient name pointer
SET D660(660,D6X,.02)=DFN
+28 ;Request date
SET D660(660,D6X,1)=TRXDT
+29 ;Type of transaction
SET D660(660,D6X,2)=$PIECE(ITMD,U,14)
+30 ;item
SET D660(660,D6X,4)=$PIECE(ITMD,U)
+31 ;HCPCS
SET D660(660,D6X,4.1)=$PIECE(^RMPR(661.1,$PIECE(ITMD,U,2),0),U,4)
+32 ;PSAS HCPCS
SET D660(660,D6X,4.5)=$PIECE(ITMD,U,2)
+33 ;CPT MODIFIER
SET D660(660,D6X,4.7)=RMCPT
+34 ;quantity
SET D660(660,D6X,5)=$PIECE(ITMD,U,7)-$PIECE(ITMD,U,17)
+35 ;vendor
SET D660(660,D6X,7)=RMPOVDR
+36 ;station
SET D660(660,D6X,8)=RMPO("STA")
+37 ;Delivery date
SET D660(660,D6X,10)=CURDT
+38 Begin DoDot:2
+39 IF $PIECE(PAYINF,U)
Begin DoDot:3
+40 ;form requested on(1358)
SET D660(660,D6X,11)=9
+41 ;IFCAP transaction number - from file 424
+42 IF $GET(IEN424)'=""
SET D660(660,D6X,23)=$PIECE($GET(^PRC(424,IEN424,0)),U)
End DoDot:3
QUIT
+43 ;form requested on (visa)
SET D660(660,D6X,11)=14
+44 ;IFCAP transaction number
SET D660(660,D6X,23)=SRVORD
End DoDot:2
+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 ;initiator
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"
+59 QUIT
End DoDot:2
+60 ; RMPR*3*98
+61 ; CALL TO PROCESS PFSS CHARGE MESSAGE
+62 IF '$DATA(ERR)
DO CHARGE^RMPOPF
+63 QUIT
End DoDot:1
+64 KILL DIC,X,Y
+65 QUIT
