source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPOPST1.m@ 1335

Last change on this file since 1335 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1RMPOPST1 ;EDS/JAM,RVD - HOME OXYGEN BILLING TRANSACTIONS/POSTING,Part 2 ;7/24/98
2 ;;3.0;PROSTHETICS;**29,44,55**;Feb 09, 1996
3 ; RVD #55 - corrected the typo (missing '^' on TMP global).
4 ;
5 ;Processing of 1358 and Purchase Cards to IFCAP
6 Q
7IFCAP ;process payment type - Purchase Card or 1358
8 D @$S($P(PAYINF,U)="P":"PRHCARD",1:"1358")
9 I $P(^TMP($J,FCP),U,2) D
10 . W !!,FCP," ...Posted" D FCPUPD ;update global ^RMPO(665.72
11 K A
12 Q ;IFCAP
13 ;
14PRHCARD ;Processing IFCAP Purchase Card
15 N DFN,PRCA,PRCB,PRCC,INDVITM,ITMSTR,RMPOA,X,CNT,CURDT
16 S PRCA=PCTOT+FCPTOT,PRCB=IEN442,PRCC="RMPOA"
17 ;Store individual patient in array RMPOA for posting
18 S DFN="" F CNT=1:1 S DFN=$O(^TMP($J,FCP,DFN)) Q:DFN="" D
19 . S ITMSTR=^TMP($J,FCP,DFN)
20 . S RMPOA(CNT)=$TR($P(ITMSTR,U,5),","," ")_" "_$P(ITMSTR,U) ;pat name & total
21 D EDITIC^PRCH7D(PRCA,PRCB,PRCC)
22 I X="^" D Q ;PRHCARD
23 . S $P(^TMP($J,FCP),U,2)=0,$P(^TMP($J,FCP),U,3)="Posting of PC aborted"
24 . ;W " ",$P(^TMP($J,FCP),U,3)
25 S $P(^TMP($J,FCP),U,2)=1,$P(^TMP($J,FCP),U,4)=PRCA
26 D NOW^%DTC S CURDT=%
27 ;Update file 660 and ^RMPO(665.72
28 S DFN="" F S DFN=$O(^TMP($J,FCP,DFN)) Q:DFN="" D
29 . S $P(^TMP($J,FCP,DFN),U,3)=1
30 . D GBLUPD
31 Q ;PRHCARD
32 ;
331358 ;processing IFCAP 1358
34 N DFN,IEN424,BAL,CURDT,Y,PATOT,PATINF,PSTFLG,PRCSX
35 ;Check balance on 1358
36 S BAL=$$BAL(IEN442) I BAL<FCPTOT D Q
37 . S $P(^TMP($J,FCP),U,2)=0,$P(^TMP($J,FCP),U,3)="Insufficient balance"
38 . ;W " ",$P(^TMP($J,FCP),U,3)
39 S PSTFLG=0,DFN=""
40 F S DFN=$O(^TMP($J,FCP,DFN)) Q:DFN="" D
41 . S PATOT=+^TMP($J,FCP,DFN),PATINF=$P(^TMP($J,FCP,DFN),U,2)
42 . ;authorize amount to be posted
43 . D NOW^%DTC S CURDT=%
44 . S X=SRVORD_"^"_CURDT_"^"_PATOT_"^^"_PATINF,Y=$$AUTH(X)
45 . I '+Y D Q
46 . . S $P(^TMP($J,FCP,DFN),U,3)=0,$P(^TMP($J,FCP,DFN),U,4)=$P(Y,U)_$P(Y,U,2)
47 . . W !!,"Authorization failed for: ",PATINF,!
48 . . W "IFCAP reason: ",$S($P(Y,U,2)'="":$P(Y,U,2),1:$P(Y,U))
49 . S IEN424=$P(Y,U,2)
50 . ;post patient total to authorized IEN 424 and closeout posting
51 . S PRCSX=IEN424_U_CURDT_U_PATOT_U_"HOME OXYGEN COMPLETED"
52 . S Y=$$COMPST(PRCSX)
53 . I '+Y D Q
54 . . S $P(^TMP($J,FCP,DFN),U,3)=0,$P(^TMP($J,FCP,DFN),U,4)=$P(Y,U,2)
55 . . W !!,"Post Completion failed for: "_PATINF,!
56 . . W "IFCAP reason: "_$P(Y,U,2)
57 . . W "Patient IEN(424): ",IEN424
58 . S $P(^TMP($J,FCP,DFN),U,3)=1,PSTFLG=1
59 . ;update file 660 for form 2319 and file ^RMPO(665.72
60 . D GBLUPD
61 S $P(^TMP($J,FCP),U,2)=PSTFLG
62 Q ;1358
63 ;
64BAL(A) ;check balance on 1358 Service Order before posting
65 N TOT442
66 S TOT442=$$BAL^PRCH58(A)
67 Q +TOT442-$P(TOT442,U,3) ;BAL
68 ;
69AUTH(X) ;create one authorization per patient to be posted
70 ;return IEN of 424 if successful in Y
71 N PRCS
72 S PRCS("TYPE")="COUNTER"
73 D EN2^PRCS58
74 Q Y ;AUTH
75 ;
76COMPST(PRCSX) ;Post patient transactions as complete to IEN of file 424
77 D ^PRCS58CC
78 Q Y ;COMPST
79 ;
80GBLUPD ;Update file ^RMPO(665.72 and 660
81 ;update file 660 for form 2319
82 D F660^RMPOPST3
83 ;update ^RMPO(665.72 with post flag
84 D ITMUPD
85 Q
86 ;
87ITMUPD ;Update global ^RMPO(665.72 with post flag for individual item
88 N ITM,DASTR
89 ;check if FCP was posted for patient
90 I '$P(^TMP($J,FCP,DFN),U,3) Q
91 K DIE,DA,DR
92 S DA(2)=VDR,DA(3)=RVDT,DA(4)=SITE
93 S DASTR=DA(4)_",1,"_DA(3)_",1,"_DA(2)_",""V"","
94 S ITM="" F S ITM=$O(^TMP($J,FCP,DFN,ITM)) Q:ITM="" D
95 . S DA(1)=DFN,DIE="^RMPO(665.72,"_DASTR_DA(1)_",1,",DR="8///Y",DA=ITM
96 . D ^DIE
97 D PATUPD
98 Q ;ITMUPD
99 ;
100PATUPD ;Update global ^RMPO(665.72 with post flag for patient
101 N FLG,IT,X,PFLG,ISTR,DASTR
102 K DIE,DA,DR
103 S DA(1)=DFN,DA(2)=VDR,DA(3)=RVDT,DA(4)=SITE
104 S IT=0,X=0,FLG="Y"
105 F S IT=$O(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,IT)) Q:'IT D I X Q
106 . S PFLG=$P(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,IT,0),U,10)
107 . S RP660=$P(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,IT,0),U,16)
108 . I '$G(RP660) S FLG=""
109 . I PFLG=""!(PFLG="N") D Q
110 . . I PFLG="" D
111 . . . S DASTR=DA(4)_",1,"_DA(3)_",1,"_DA(2)_",""V"","_DA(1)_",1,"
112 . . . S DIE="^RMPO(665.72,"_DASTR,DR="8///N",DA=IT D ^DIE
113 . . S X=1,FLG="P"
114 K DIE,DA,DR
115 S DA(1)=VDR,DA(2)=RVDT,DA(3)=SITE,DA=DFN,DR="3///"_FLG
116 S DIE="^RMPO(665.72,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",""V"","
117 D ^DIE
118 Q ;PATUPD
119 ;
120FCPUPD ;Update global ^RMPO(665.72 with totals for Purchase Card
121 K DIE,DA,DR
122 S DA=IENFCP,DA(1)=RVDT,DA(2)=SITE
123 S DIE="^RMPO(665.72,"_DA(2)_",1,"_DA(1)_",2,"
124 S DR=$S($P(PAYINF,U)="P":"6///"_(FCPTOT+PCTOT)_";",1:"")
125 S DR=DR_"4////"_DUZ_";"_"5///"_VDR
126 D ^DIE
127 Q ;FCPUPD
128 ;
Note: See TracBrowser for help on using the repository browser.