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