source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPOBIL4.m@ 1268

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1RMPOBIL4 ;NG/DUG-HOME OXYGEN BILLING TRANSACTIONS ;7/22/98 11:08
2 ;;3.0;PROSTHETICS;**29**;Feb 09, 1996
3ACCEPT ;the vaiable RMPOTYPE is available. If '1',1358. If '2',purchase card.
4 ;variable RMPOA is an Entry Action set in [RMPO ACCEPT BILL] to allow
5 ; seperate option to accept transactions
6 ;variable RMPOACN set in RMPOBIL1 means there is at least one patient
7 ; transaction that has not been accepted.
8 S DIR(0)="S^1:ACCEPT;2:UNACCEPT",DIR("?")="Enter '1' to accept transactions, '2' to unaccept.",DIR("A")="ACCEPT or UNACCEPT Billing Transaction(s)" D ^DIR K DIR Q:$D(DIRUT) S:Y(0)="UNACCEPT" RMPOUA=1 D PROS K RMPOUA Q
9 I '$D(RMPOACPN) W !!,"All transactions have been accepted.",!,"Press <RETURN> to continue." R RET:DTIME Q
10 I $D(RMPOA) R !!,"Accept ? Y// ",ANS1:DTIME Q:'$T!("yY"'[ANS1) D PROS Q
11 W !!,"Are you sure you want to ACCEPT these transactions (",ANS,") ? No // "
12 R ANS1:DTIME Q:'$T!("^Nn"[ANS1)
13 I "Yy"'[ANS1 W !,"Type 'Y' to accept the billing transactions for ",!,"the patients you selected. Press return to leave." G ACCEPT
14PROS ;
15 F M=1:1:CNT I $D(ANS(M)),$D(CNT(M)),$D(^RMPO(665.72,RMPOREC,1,RMPOREC1)) D
16 . S RMPOREC2=$O(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,"B",CNT(M),0))
17 . I $G(RMPOREC2)]"",$D(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,RMPOREC2,0)) S:'$D(RMPOUA) $P(^(0),U,2)=1 S:$D(RMPOUA) $P(^(0),U,2)=""
18 . S RMPOX=""
19 . F S RMPOX=$O(^TMP($J,RMPOX)) Q:RMPOX="" D
20 . . I $P(RMPOX,U,2)=RMPOPATN D
21 . . . S:'$D(RMPOUA) $P(^TMP($J,RMPOX),U)="a"
22 . . . S:$D(RMPOUA) $P(^TMP($J,RMPOX),U)="" W "."
23 . . . Q
24 . . ;
25 . . ;$D(RMPOUA)="ACCEPTED
26 . . ;Otherwise it is UNACCEPTED
27 . . ;H 2
28 . . ;
29 . . ;RMPOA is set if running ACCEPT option
30 . . ;Q:$D(RMPOA)!($D(RMPOVA)) ; quit unnecessary, quits anyway.
31 . . Q
32 . ;D ^RMPOBIL1 K RMPOX
33 . Q
34 Q
35POST ;locates item records for the "Post" option using CNT1(CNT1) array
36 K RMPOCAP S RMPOPATN=$TR(RMPOPATN,"`","") Q:$G(RMPOPATN)<1
37 S RMPOREC1=$O(^RMPO(665.72,RMPOREC,1,"B",RMPODATE,0)),RMPOREC2=$O(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,"B",RMPOPATN,0)) I RMPOREC2="" W !,"No items listed for this patient. Record is incomplete." H 3 Q
38 Q:$P(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,RMPOREC2,0),U,3)'=""
39 S RMPOVEN=0,RMPOVEN=$O(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,RMPOREC2,"V",RMPOVEN)) Q:RMPOVEN=""
40 Q:$P($G(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,RMPOREC2,"V",RMPOVEN,"I",0)),U,3)="" S CNT1=1,RMPOREC3=0 F S RMPOREC3=$O(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,RMPOREC2,"V",RMPOVEN,"I",RMPOREC3)) Q:RMPOREC3<1 D
41 .S RMPOITEM=$G(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,RMPOREC2,"V",RMPOVEN,"I",RMPOREC3,0))_RMPOREC3,CNT1(CNT1)=RMPOITEM_U_$P(RMPOITEM,U)_U_RMPOPATN
42 .S RMPOIT=$P(RMPOITEM,U),RMPOIT=$P(^RMPR(661,RMPOIT,0),U),RMPOIT=$P(^PRC(441,RMPOIT,0),U,2),$P(CNT1(CNT1),U)=RMPOIT,CNT1=CNT1+1
43 ;D FCP^RMPOBIL6,POST2 Q
44POST1 Q:"^"[$G(ANS1)
45 W !!,"Warning, transactions cannot be editted once they are posted."
46 R "Post ? No// ",ANS1:DTIME Q:'$T!("Nn"[ANS1)
47 ;I "Yy"[ANS1 D FCP^RMPOBIL6
48 Q ;ADDED TO SKIP FOLOWING MESSAGE - UNSUCCESSFUL POSTING
49POST2 ;requires variable RMPOCAP which verifies successful posting
50 ;from ^RMPOBIL.
51 Q ;ADDED TO SKIP FOLLOWING MESSAGE
52 I '$D(RMPOCAP) W !!,"UNSUCCESSFUL POSTING!" H 3 K RMPOPO Q
53 S RMPOX="" F S RMPOX=$O(^TMP($J,RMPOX)) Q:RMPOX="" I $P(RMPOX,U,2)=RMPOPATN K ^TMP($J,RMPOX) D
54 .S RMPOREC2=$O(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,"B",RMPOPATN,0)),$P(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,RMPOREC2,0),U,3)=1
55 W !!,"." H 3
56 K RMPOPO Q
57EXPIRE ;this subroutine is used to calculate the Rx expiration date for
58 ;file 665. It calculates the order of the prescription that it has been
59 ;asked to calculate the expiration date for and uses the appropriate
60 ;"Default Days to Exparation" from the Prescription Sequence Number
61 ;multiple.
62 ;
63 ;X is Return Value (for call from input template)
64 ;
65 ;If there is a value on file, use it.
66 N RMPODATA,RMPODAXD
67 S RMPODATA=$G(^RMPR(665,DA(1),"RMPOB",DA,0))
68 S X=$P(RMPODATA,"^",3) Q:X
69 ;
70 ;Calculate Sequence Number for Prescription - Default=1
71 S RMPODAXD=0,X=0
72 F S X=$O(^RMPR(665,DA(1),"RMPOB","B",X)) S RMPODAXD=RMPODAXD+1 Q:$S(X-RMPODATA=0:1,'X:1,1:0)
73 ;
74 ;Calculate value based on Prescription Data + Site Parameter
75 ;
76 N RMPOSITE,X1,X2,Y
77 S RMPOSITE=$P($G(^RMPR(665,DA(1),"RMPOA")),U,7)
78 Q:RMPOSITE="" D
79 . S X2=$P($G(^RMPR(669.9,RMPOSITE,"RMPORXN",RMPODAXD,0)),U,2)
80 . Q:'X2 S X=""
81 . S X1=$P(RMPODATA,U) D C^%DTC
82 . Q
83 Q
84EXPAT(X,Y) ;Entry for RMPOPED
85 N DA S DA=Y,DA(1)=X D EXPIRE
86 Q X
Note: See TracBrowser for help on using the repository browser.