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