Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPOPS23

RMPOPS23.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;This routine will only post records already been posted in IFCAP.
  1. ;Patient records are sorted by fund control point (FCP), DFN and
  1. ;then post to 2319.
  1. Q
  1. ;
  1. POST ;main module to post billing transactions to 2319
  1. D HOME^%ZIS S QUIT=0
  1. D HOSITE^RMPOUTL0 Q:('$D(RMPOXITE))!QUIT
  1. D MONTH^RMPOBIL0() Q:$D(RMPODATE)=0!QUIT
  1. D VENDOR^RMPOBIL0() Q:$D(RMPOVDR)=0!QUIT
  1. S FIL=665.72,SITE=RMPOXITE,RVDT=RMPODATE,VDR=RMPOVDR,QUIT=0
  1. W !,"Processing..." D BUILD
  1. I $O(^TMP($J,""))="" W !,"Everything posted okay!!" G EXIT
  1. 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
  1. ;K DIR S DIR(0)="FO",DIR("A")="Press any Key to Continue" D ^DIR
  1. ;
  1. EXIT ;
  1. K ^TMP($J)
  1. ;K DFN,ITM,ITDT,ITNO,PATNAM,PATSSN,LNAM,PATFLG,ITSTR,FCP,LCK,ITOT
  1. N RMPRSITE,RMPR D KILL^XUSCLEAN
  1. Q
  1. ;
  1. BUILD ;Build array IFCAP with patient transactions to post
  1. ;Separate patient individual items by fund control point
  1. ;tMP($J) array
  1. ; ^TMP($J,FCP)=FCP total^Post flag^error message^purchase card total
  1. ; ^TMP($J,FCP,DFN)=patient tot^pat last name_" "_4 digit SSN^post flag^
  1. ; IFCAP error message^pat name
  1. ; ^TMP($J,FCP,DFN,ITEM)=item tot
  1. K ^TMP($J)
  1. S DFN=0 F S DFN=$O(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN)) Q:DFN'>0 D
  1. . S PATFLG=^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0)
  1. . ;check patient post flag
  1. . Q:$P(PATFLG,U,3)'="Y"
  1. . D DEM^VADPT S PATNAM=VADM(1),PATSSN=VA("BID") ;patient name & ssn
  1. . ;lock patient record
  1. . S LCK=$$PATLCK() I 'LCK W !,PATNAM," record locked by another user" Q
  1. . ;get items not posted for each patient
  1. . S ITM=0
  1. . F S ITM=$O(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,ITM)) Q:'ITM D
  1. . . S ITDT=^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,ITM,0)
  1. . . ;check if item posted
  1. . . Q:$P(ITDT,U,10)'="Y"
  1. . . Q:$P(ITDT,U,16)>0
  1. . . S ITNO=$P(ITDT,U),FCP=$P(ITDT,U,3),ITOT=$P(ITDT,U,6)
  1. . . I ITOT'>0 Q ;no amount to post
  1. . . I FCP="" Q ;no fund control point
  1. . . ;set ^TMP($J) array
  1. . . S ^TMP($J,FCP)=$S('$D(^TMP($J,FCP)):0.00,1:^TMP($J,FCP))+ITOT
  1. . . I $G(^TMP($J,FCP,DFN))="" D
  1. . . . S LNAM=$E($P(PATNAM,",")_" ",1,7)
  1. . . . S ^TMP($J,FCP,DFN)="^"_LNAM_" "_PATSSN_"^^^"_$E(PATNAM,1,18)
  1. . . S $P(^TMP($J,FCP,DFN),U)=+^TMP($J,FCP,DFN)+ITOT,^TMP($J,FCP,DFN,ITM)=ITOT
  1. . D UNLKPAT
  1. Q
  1. ;
  1. F660 ;Post to file ^RMPR(660 for form 2319
  1. S D665A=$G(^RMPR(665,DFN,"RMPOA")) I D665A="" Q
  1. D ;AMIS grouper number
  1. . L +^RMPR(669.9,RMPOXITE,0):9999 I $T=0 S RMPOG=DT_$P(DT,2,3) Q
  1. . S RMPOG=$P(^RMPR(669.9,RMPOXITE,0),U,7),RMPOG=RMPOG-1
  1. . S $P(^RMPR(669.9,RMPOXITE,0),U,7)=RMPOG
  1. . L -^RMPR(669.9,RMPOXITE,0)
  1. S TRXDT=$P(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RMPOVDR,0),U,2)
  1. S RFCPIEN=$O(^RMPO(665.72,1,1,RMPODATE,2,"B",FCP,0))
  1. S SRVORD=$P(^RMPO(665.72,RMPOXITE,1,RMPODATE,2,RFCPIEN,0),U,4)
  1. S PAYINF=$P(^RMPO(665.72,RMPOXITE,1,RMPODATE,2,RFCPIEN,0),U,2)
  1. S ITM=0 F S ITM=$O(^TMP($J,FCP,DFN,ITM)) Q:ITM'>0 D
  1. . S ITMD=$G(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RMPOVDR,"V",DFN,1,ITM,0))
  1. . S RMITEM=$P(ITMD,U,1)
  1. . I $G(RMITEM),$D(^RMPR(661,RMITEM,0)) S RITIEN=$P(^RMPR(661,RMITEM,0),U,1)
  1. . I ITMD="" Q
  1. . I $P(ITMD,U,6)'>0 Q ;nothing posted to IFCAP
  1. . S RMCPHC=$P(ITMD,U,2),RMCPT="",RMCPRENT=$P(ITMD,U,18),RMCPSO="C"
  1. . S RMCPTY=$P(ITMD,U,14),RMCPQH=$P(ITMD,U,19)
  1. . S RMCPT1=$G(^RMPR(661.1,RMCPHC,4))
  1. . I RMCPT1["RP",((RMCPTY="R")!(RMCPTY="X")) S RMCPT=RMCPT_"RP,"
  1. . I RMCPT1["QH",($G(RMCPQH)) S RMCPT=RMCPT_"QH,"
  1. . I (RMCPRENT=1),(RMCPT1["RR") S RMCPT=RMCPT_"RR,"
  1. . I RMCPT1["NU",(RMCPT'["RR") S RMCPT=RMCPT_"NU,"
  1. . I $L(RMCPT)>2 S RMCLEN=$L(RMCPT),RMCPT=$E(RMCPT,1,RMCLEN-1)
  1. . S DIC="^RMPR(660,",DIC(0)="L",X=DT
  1. . K DD,DO D FILE^DICN I +Y<0 Q
  1. . S D6I=+Y,D6X=D6I_","
  1. . K DIE,DA,DR S DA(4)=RMPOXITE,DA(3)=RMPODATE,DA(2)=RMPOVDR,DA(1)=DFN
  1. . S DIE="^RMPO(665.72,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_",""V"","_DA(1)
  1. . S DIE=DIE_",1,",DA=ITM,DR="15////^S X=D6I" D ^DIE
  1. . S D660(660,D6X,.02)=DFN ;Patient name pointer
  1. . S D660(660,D6X,1)=TRXDT ;Request date
  1. . S D660(660,D6X,2)=$P(ITMD,U,14) ;Type of transaction
  1. . S D660(660,D6X,4)=$P(ITMD,U) ;item
  1. . S D660(660,D6X,4.1)=$P(^RMPR(661.1,$P(ITMD,U,2),0),U,4) ;HCPCS
  1. . S D660(660,D6X,4.5)=$P(ITMD,U,2) ;PSAS HCPCS
  1. . S D660(660,D6X,4.7)=RMCPT ;RMCPT
  1. . S D660(660,D6X,5)=$P(ITMD,U,7) ;quantity
  1. . S D660(660,D6X,7)=RMPOVDR ;vendor
  1. . S D660(660,D6X,8)=RMPO("STA") ;station
  1. . S D660(660,D6X,10)=DT ;Delivery date
  1. . I $P(PAYINF,U) S D660(660,D6X,11)=9
  1. . I $P(PAYINF,U)="P" S D660(660,D6X,11)=14
  1. . S D660(660,D6X,23)=SRVORD ;IFCAP transaction number
  1. . S D660(660,D6X,12)="C" ;Source
  1. . S D660(660,D6X,14)=$P(ITMD,U,6) ;total cost
  1. . S D660(660,D6X,16)=$P(ITMD,U,4) ;remarks
  1. . S SUSDES=$S($P(ITMD,U,11)'="":"Suspended Amt "_$P(ITMD,U,11)_" ",1:"")
  1. . S D660(660,D6X,24)=SUSDES_$P(ITMD,U,12) ;description
  1. . S D660(660,D6X,27)=DUZ ;initator
  1. . S D660(660,D6X,62)=$P(D665A,U) ;patient category
  1. . S D660(660,D6X,63)=$P(D665A,U,5) ;special category
  1. . S D660(660,D6X,68)=RMPOG
  1. . S D660(660,D6X,78)=$P(ITMD,U,15) ;unit of issue
  1. . D FILE^DIE("K","D660","ERR")
  1. . I $D(ERR) D
  1. . . W !!,"Posting to 2319 for item ",ITM," patient ",DFN," failed."
  1. . . W "Posting will be done later"
  1. . I '$D(ERR),$D(^DPT(DFN,0)),$D(^PRC(441,RITIEN,0)) D
  1. . . W !,"Patient: ",$P(^DPT(DFN,0),U,1)," Item: ",ITM," posted to 2319."
  1. K DIC,X,Y
  1. Q
  1. ;
  1. PATLCK() ;Lock patient level in ^RMPO(665.72
  1. L +^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0):5
  1. Q $T
  1. ;
  1. UNLKPAT ;Unlock patient level in ^RMPO(665.72
  1. L -^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0)
  1. Q
  1. ;
  1. QUIT() S QUIT=$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q QUIT