| 1 | RMPOBIL4 ;NG/DUG-HOME OXYGEN BILLING TRANSACTIONS ;7/22/98 11:08
|
|---|
| 2 | ;;3.0;PROSTHETICS;**29**;Feb 09, 1996
|
|---|
| 3 | ACCEPT ;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
|
|---|
| 14 | PROS ;
|
|---|
| 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
|
|---|
| 35 | POST ;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
|
|---|
| 44 | POST1 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
|
|---|
| 49 | POST2 ;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
|
|---|
| 57 | EXPIRE ;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
|
|---|
| 84 | EXPAT(X,Y) ;Entry for RMPOPED
|
|---|
| 85 | N DA S DA=Y,DA(1)=X D EXPIRE
|
|---|
| 86 | Q X
|
|---|
