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

RMPOPST1.m

Go to the documentation of this file.
  1. RMPOPST1 ;EDS/JAM,RVD - HOME OXYGEN BILLING TRANSACTIONS/POSTING,Part 2 ;7/24/98
  1. ;;3.0;PROSTHETICS;**29,44,55,154,166**;Feb 09, 1996;Build 2
  1. ; RVD #55 - corrected the typo (missing '^' on TMP global).
  1. ;
  1. ;Processing of 1358 and Purchase Cards to IFCAP
  1. Q
  1. IFCAP ;process payment type - Purchase Card or 1358
  1. D @$S($P(PAYINF,U)="P":"PRHCARD",1:"1358")
  1. I $P(^TMP($J,FCP),U,2) D
  1. . W !!,FCP," ...Posted" D FCPUPD ;update global ^RMPO(665.72
  1. K A
  1. Q ;IFCAP
  1. ;
  1. PRHCARD ;Processing IFCAP Purchase Card
  1. N DFN,PRCA,PRCB,PRCC,INDVITM,ITMSTR,RMPOA,X,CNT,CURDT,CNTR,TOTD
  1. S PRCA=PCTOT+FCPTOT,PRCB=IEN442,PRCC="RMPOA"
  1. ;Store individual patient in array RMPOA for posting
  1. S DFN="",TOTD=0,CNTR=0 F CNT=1:1 S DFN=$O(^TMP($J,FCP,DFN)) Q:DFN="" D
  1. . S ITMSTR=^TMP($J,FCP,DFN),TOTD=TOTD+$P(ITMSTR,U),CNTR=CNTR+1
  1. I CNTR>0 S RMPOA(1)=$J(TOTD,10,2)_" TOTAL PATIENTS= "_CNTR
  1. D EDITIC^PRCH7D(PRCA,PRCB,PRCC)
  1. I X="^" D Q ;PRHCARD
  1. . S $P(^TMP($J,FCP),U,2)=0,$P(^TMP($J,FCP),U,3)="Posting of PC aborted"
  1. . ;W " ",$P(^TMP($J,FCP),U,3)
  1. S $P(^TMP($J,FCP),U,2)=1,$P(^TMP($J,FCP),U,4)=PRCA
  1. D NOW^%DTC S CURDT=%
  1. ;Update file 660 and ^RMPO(665.72
  1. S DFN="" F S DFN=$O(^TMP($J,FCP,DFN)) Q:DFN="" D
  1. . S $P(^TMP($J,FCP,DFN),U,3)=1
  1. . D GBLUPD
  1. Q ;PRHCARD
  1. ;
  1. 1358 ;processing IFCAP 1358
  1. N DFN,IEN424,BAL,CURDT,Y,PATOT,PATINF,PSTFLG,PRCSX,PATINFW
  1. ;Check balance on 1358
  1. S BAL=$$BAL(IEN442) I BAL<FCPTOT D Q
  1. . S $P(^TMP($J,FCP),U,2)=0,$P(^TMP($J,FCP),U,3)="Insufficient balance"
  1. . ;W " ",$P(^TMP($J,FCP),U,3)
  1. S PSTFLG=0,DFN=""
  1. F I=1:1 S DFN=$O(^TMP($J,FCP,DFN)) Q:DFN="" D
  1. . ;RMPR166 change identifier from PAT ID to PID to reduce num of chars ticket 786903
  1. . S PATOT=+^TMP($J,FCP,DFN),PATINF="PID "_DFN,PATINFW=$P(^TMP($J,FCP,DFN),U,2)
  1. . ;authorize amount to be posted
  1. . D NOW^%DTC S CURDT=%
  1. . S X=SRVORD_"^"_CURDT_"^"_PATOT_"^^"_PATINF,Y=$$AUTH(X)
  1. . I '+Y D Q
  1. . . S $P(^TMP($J,FCP,DFN),U,3)=0,$P(^TMP($J,FCP,DFN),U,4)=$P(Y,U)_$P(Y,U,2)
  1. . . W !!,"Authorization failed for: ",PATINFW,!
  1. . . W "IFCAP reason: ",$S($P(Y,U,2)'="":$P(Y,U,2),1:$P(Y,U))
  1. . S IEN424=$P(Y,U,2)
  1. . ;post patient total to authorized IEN 424 and closeout posting
  1. . S PRCSX=IEN424_U_CURDT_U_PATOT_U_"HOME OXYGEN COMPLETED"
  1. . S Y=$$COMPST(PRCSX)
  1. . I '+Y D Q
  1. . . S $P(^TMP($J,FCP,DFN),U,3)=0,$P(^TMP($J,FCP,DFN),U,4)=$P(Y,U,2)
  1. . . W !!,"Post Completion failed for: "_PATINFW,!
  1. . . W "IFCAP reason: "_$P(Y,U,2)
  1. . . W "Patient IEN(424): ",IEN424
  1. . S $P(^TMP($J,FCP,DFN),U,3)=1,PSTFLG=1
  1. . ;update file 660 for form 2319 and file ^RMPO(665.72
  1. . D GBLUPD
  1. S $P(^TMP($J,FCP),U,2)=PSTFLG
  1. Q ;1358
  1. ;
  1. BAL(A) ;check balance on 1358 Service Order before posting
  1. N TOT442
  1. S TOT442=$$BAL^PRCH58(A)
  1. Q +TOT442-$P(TOT442,U,3) ;BAL
  1. ;
  1. AUTH(X) ;create one authorization per patient to be posted
  1. ;return IEN of 424 if successful in Y
  1. N PRCS
  1. S PRCS("TYPE")="COUNTER"
  1. D EN2^PRCS58
  1. Q Y ;AUTH
  1. ;
  1. COMPST(PRCSX) ;Post patient transactions as complete to IEN of file 424
  1. D ^PRCS58CC
  1. Q Y ;COMPST
  1. ;
  1. GBLUPD ;Update file ^RMPO(665.72 and 660
  1. ;update file 660 for form 2319
  1. D F660^RMPOPST3
  1. ;update ^RMPO(665.72 with post flag
  1. D ITMUPD
  1. Q
  1. ;
  1. ITMUPD ;Update global ^RMPO(665.72 with post flag for individual item
  1. N ITM,DASTR
  1. ;check if FCP was posted for patient
  1. I '$P(^TMP($J,FCP,DFN),U,3) Q
  1. K DIE,DA,DR
  1. S DA(2)=VDR,DA(3)=RVDT,DA(4)=SITE
  1. S DASTR=DA(4)_",1,"_DA(3)_",1,"_DA(2)_",""V"","
  1. S ITM="" F S ITM=$O(^TMP($J,FCP,DFN,ITM)) Q:ITM="" D
  1. . S DA(1)=DFN,DIE="^RMPO(665.72,"_DASTR_DA(1)_",1,",DR="8///Y",DA=ITM
  1. . D ^DIE
  1. D PATUPD
  1. Q ;ITMUPD
  1. ;
  1. PATUPD ;Update global ^RMPO(665.72 with post flag for patient
  1. N FLG,IT,X,PFLG,ISTR,DASTR
  1. K DIE,DA,DR
  1. S DA(1)=DFN,DA(2)=VDR,DA(3)=RVDT,DA(4)=SITE
  1. S IT=0,X=0,FLG="Y"
  1. F S IT=$O(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,IT)) Q:'IT D I X Q
  1. . S PFLG=$P(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,IT,0),U,10)
  1. . S RP660=$P(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,IT,0),U,16)
  1. . I '$G(RP660) S FLG=""
  1. . I PFLG=""!(PFLG="N") D Q
  1. . . I PFLG="" D
  1. . . . S DASTR=DA(4)_",1,"_DA(3)_",1,"_DA(2)_",""V"","_DA(1)_",1,"
  1. . . . S DIE="^RMPO(665.72,"_DASTR,DR="8///N",DA=IT D ^DIE
  1. . . S X=1,FLG="P"
  1. K DIE,DA,DR
  1. S DA(1)=VDR,DA(2)=RVDT,DA(3)=SITE,DA=DFN,DR="3///"_FLG
  1. S DIE="^RMPO(665.72,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",""V"","
  1. D ^DIE
  1. Q ;PATUPD
  1. ;
  1. FCPUPD ;Update global ^RMPO(665.72 with totals for Purchase Card
  1. K DIE,DA,DR
  1. S DA=IENFCP,DA(1)=RVDT,DA(2)=SITE
  1. S DIE="^RMPO(665.72,"_DA(2)_",1,"_DA(1)_",2,"
  1. S DR=$S($P(PAYINF,U)="P":"6///"_(FCPTOT+PCTOT)_";",1:"")
  1. S DR=DR_"4////"_DUZ_";"_"5///"_VDR
  1. D ^DIE
  1. Q ;FCPUPD
  1. ;