RMPOBIL4 ;NG/DUG-HOME OXYGEN BILLING TRANSACTIONS ;7/22/98 11:08
;;3.0;PROSTHETICS;**29**;Feb 09, 1996
ACCEPT ;the vaiable RMPOTYPE is available. If '1',1358. If '2',purchase card.
;variable RMPOA is an Entry Action set in [RMPO ACCEPT BILL] to allow
; seperate option to accept transactions
;variable RMPOACN set in RMPOBIL1 means there is at least one patient
; transaction that has not been accepted.
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
I '$D(RMPOACPN) W !!,"All transactions have been accepted.",!,"Press <RETURN> to continue." R RET:DTIME Q
I $D(RMPOA) R !!,"Accept ? Y// ",ANS1:DTIME Q:'$T!("yY"'[ANS1) D PROS Q
W !!,"Are you sure you want to ACCEPT these transactions (",ANS,") ? No // "
R ANS1:DTIME Q:'$T!("^Nn"[ANS1)
I "Yy"'[ANS1 W !,"Type 'Y' to accept the billing transactions for ",!,"the patients you selected. Press return to leave." G ACCEPT
PROS ;
F M=1:1:CNT I $D(ANS(M)),$D(CNT(M)),$D(^RMPO(665.72,RMPOREC,1,RMPOREC1)) D
. S RMPOREC2=$O(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,"B",CNT(M),0))
. 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)=""
. S RMPOX=""
. F S RMPOX=$O(^TMP($J,RMPOX)) Q:RMPOX="" D
. . I $P(RMPOX,U,2)=RMPOPATN D
. . . S:'$D(RMPOUA) $P(^TMP($J,RMPOX),U)="a"
. . . S:$D(RMPOUA) $P(^TMP($J,RMPOX),U)="" W "."
. . . Q
. . ;
. . ;$D(RMPOUA)="ACCEPTED
. . ;Otherwise it is UNACCEPTED
. . ;H 2
. . ;
. . ;RMPOA is set if running ACCEPT option
. . ;Q:$D(RMPOA)!($D(RMPOVA)) ; quit unnecessary, quits anyway.
. . Q
. ;D ^RMPOBIL1 K RMPOX
. Q
Q
POST ;locates item records for the "Post" option using CNT1(CNT1) array
K RMPOCAP S RMPOPATN=$TR(RMPOPATN,"`","") Q:$G(RMPOPATN)<1
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
Q:$P(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,RMPOREC2,0),U,3)'=""
S RMPOVEN=0,RMPOVEN=$O(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,RMPOREC2,"V",RMPOVEN)) Q:RMPOVEN=""
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
.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
.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
;D FCP^RMPOBIL6,POST2 Q
POST1 Q:"^"[$G(ANS1)
W !!,"Warning, transactions cannot be editted once they are posted."
R "Post ? No// ",ANS1:DTIME Q:'$T!("Nn"[ANS1)
;I "Yy"[ANS1 D FCP^RMPOBIL6
Q ;ADDED TO SKIP FOLOWING MESSAGE - UNSUCCESSFUL POSTING
POST2 ;requires variable RMPOCAP which verifies successful posting
;from ^RMPOBIL.
Q ;ADDED TO SKIP FOLLOWING MESSAGE
I '$D(RMPOCAP) W !!,"UNSUCCESSFUL POSTING!" H 3 K RMPOPO Q
S RMPOX="" F S RMPOX=$O(^TMP($J,RMPOX)) Q:RMPOX="" I $P(RMPOX,U,2)=RMPOPATN K ^TMP($J,RMPOX) D
.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
W !!,"." H 3
K RMPOPO Q
EXPIRE ;this subroutine is used to calculate the Rx expiration date for
;file 665. It calculates the order of the prescription that it has been
;asked to calculate the expiration date for and uses the appropriate
;"Default Days to Exparation" from the Prescription Sequence Number
;multiple.
;
;X is Return Value (for call from input template)
;
;If there is a value on file, use it.
N RMPODATA,RMPODAXD
S RMPODATA=$G(^RMPR(665,DA(1),"RMPOB",DA,0))
S X=$P(RMPODATA,"^",3) Q:X
;
;Calculate Sequence Number for Prescription - Default=1
S RMPODAXD=0,X=0
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)
;
;Calculate value based on Prescription Data + Site Parameter
;
N RMPOSITE,X1,X2,Y
S RMPOSITE=$P($G(^RMPR(665,DA(1),"RMPOA")),U,7)
Q:RMPOSITE="" D
. S X2=$P($G(^RMPR(669.9,RMPOSITE,"RMPORXN",RMPODAXD,0)),U,2)
. Q:'X2 S X=""
. S X1=$P(RMPODATA,U) D C^%DTC
. Q
Q
EXPAT(X,Y) ;Entry for RMPOPED
N DA S DA=Y,DA(1)=X D EXPIRE
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOBIL4 4576 printed Sep 23, 2025@20:06:56 Page 2
RMPOBIL4 ;NG/DUG-HOME OXYGEN BILLING TRANSACTIONS ;7/22/98 11:08
+1 ;;3.0;PROSTHETICS;**29**;Feb 09, 1996
ACCEPT ;the vaiable RMPOTYPE is available. If '1',1358. If '2',purchase card.
+1 ;variable RMPOA is an Entry Action set in [RMPO ACCEPT BILL] to allow
+2 ; seperate option to accept transactions
+3 ;variable RMPOACN set in RMPOBIL1 means there is at least one patient
+4 ; transaction that has not been accepted.
+5 SET DIR(0)="S^1:ACCEPT;2:UNACCEPT"
SET DIR("?")="Enter '1' to accept transactions, '2' to unaccept."
SET DIR("A")="ACCEPT or UNACCEPT Billing Transaction(s)"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
if Y(0)="UNACCEPT"
SET RMPOUA=1
DO PROS
KILL RMPOUA
QUIT
+6 IF '$DATA(RMPOACPN)
WRITE !!,"All transactions have been accepted.",!,"Press <RETURN> to continue."
READ RET:DTIME
QUIT
+7 IF $DATA(RMPOA)
READ !!,"Accept ? Y// ",ANS1:DTIME
if '$TEST!("yY"'[ANS1)
QUIT
DO PROS
QUIT
+8 WRITE !!,"Are you sure you want to ACCEPT these transactions (",ANS,") ? No // "
+9 READ ANS1:DTIME
if '$TEST!("^Nn"[ANS1)
QUIT
+10 IF "Yy"'[ANS1
WRITE !,"Type 'Y' to accept the billing transactions for ",!,"the patients you selected. Press return to leave."
GOTO ACCEPT
PROS ;
+1 FOR M=1:1:CNT
IF $DATA(ANS(M))
IF $DATA(CNT(M))
IF $DATA(^RMPO(665.72,RMPOREC,1,RMPOREC1))
Begin DoDot:1
+2 SET RMPOREC2=$ORDER(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,"B",CNT(M),0))
+3 IF $GET(RMPOREC2)]""
IF $DATA(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,RMPOREC2,0))
if '$DATA(RMPOUA)
SET $PIECE(^(0),U,2)=1
if $DATA(RMPOUA)
SET $PIECE(^(0),U,2)=""
+4 SET RMPOX=""
+5 FOR
SET RMPOX=$ORDER(^TMP($JOB,RMPOX))
if RMPOX=""
QUIT
Begin DoDot:2
+6 IF $PIECE(RMPOX,U,2)=RMPOPATN
Begin DoDot:3
+7 if '$DATA(RMPOUA)
SET $PIECE(^TMP($JOB,RMPOX),U)="a"
+8 if $DATA(RMPOUA)
SET $PIECE(^TMP($JOB,RMPOX),U)=""
WRITE "."
+9 QUIT
End DoDot:3
+10 ;
+11 ;$D(RMPOUA)="ACCEPTED
+12 ;Otherwise it is UNACCEPTED
+13 ;H 2
+14 ;
+15 ;RMPOA is set if running ACCEPT option
+16 ;Q:$D(RMPOA)!($D(RMPOVA)) ; quit unnecessary, quits anyway.
+17 QUIT
End DoDot:2
+18 ;D ^RMPOBIL1 K RMPOX
+19 QUIT
End DoDot:1
+20 QUIT
POST ;locates item records for the "Post" option using CNT1(CNT1) array
+1 KILL RMPOCAP
SET RMPOPATN=$TRANSLATE(RMPOPATN,"`","")
if $GET(RMPOPATN)<1
QUIT
+2 SET RMPOREC1=$ORDER(^RMPO(665.72,RMPOREC,1,"B",RMPODATE,0))
SET RMPOREC2=$ORDER(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,"B",RMPOPATN,0))
IF RMPOREC2=""
WRITE !,"No items listed for this patient. Record is incomplete."
HANG 3
QUIT
+3 if $PIECE(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,RMPOREC2,0),U,3)'=""
QUIT
+4 SET RMPOVEN=0
SET RMPOVEN=$ORDER(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,RMPOREC2,"V",RMPOVEN))
if RMPOVEN=""
QUIT
+5 if $PIECE($GET(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,RMPOREC2,"V",RMPOVEN,"I",0)),U,3)=""
QUIT
SET CNT1=1
SET RMPOREC3=0
FOR
SET RMPOREC3=$ORDER(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,RMPOREC2,"V",RMPOVEN,"I",RMPOREC3))
if RMPOREC3<1
QUIT
Begin DoDot:1
+6 SET RMPOITEM=$GET(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,RMPOREC2,"V",RMPOVEN,"I",RMPOREC3,0))_RMPOREC3
SET CNT1(CNT1)=RMPOITEM_U_$PIECE(RMPOITEM,U)_U_RMPOPATN
+7 SET RMPOIT=$PIECE(RMPOITEM,U)
SET RMPOIT=$PIECE(^RMPR(661,RMPOIT,0),U)
SET RMPOIT=$PIECE(^PRC(441,RMPOIT,0),U,2)
SET $PIECE(CNT1(CNT1),U)=RMPOIT
SET CNT1=CNT1+1
End DoDot:1
+8 ;D FCP^RMPOBIL6,POST2 Q
POST1 if "^"[$GET(ANS1)
QUIT
+1 WRITE !!,"Warning, transactions cannot be editted once they are posted."
+2 READ "Post ? No// ",ANS1:DTIME
if '$TEST!("Nn"[ANS1)
QUIT
+3 ;I "Yy"[ANS1 D FCP^RMPOBIL6
+4 ;ADDED TO SKIP FOLOWING MESSAGE - UNSUCCESSFUL POSTING
QUIT
POST2 ;requires variable RMPOCAP which verifies successful posting
+1 ;from ^RMPOBIL.
+2 ;ADDED TO SKIP FOLLOWING MESSAGE
QUIT
+3 IF '$DATA(RMPOCAP)
WRITE !!,"UNSUCCESSFUL POSTING!"
HANG 3
KILL RMPOPO
QUIT
+4 SET RMPOX=""
FOR
SET RMPOX=$ORDER(^TMP($JOB,RMPOX))
if RMPOX=""
QUIT
IF $PIECE(RMPOX,U,2)=RMPOPATN
KILL ^TMP($JOB,RMPOX)
Begin DoDot:1
+5 SET RMPOREC2=$ORDER(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,"B",RMPOPATN,0))
SET $PIECE(^RMPO(665.72,RMPOREC,1,RMPOREC1,1,RMPOREC2,0),U,3)=1
End DoDot:1
+6 WRITE !!,"."
HANG 3
+7 KILL RMPOPO
QUIT
EXPIRE ;this subroutine is used to calculate the Rx expiration date for
+1 ;file 665. It calculates the order of the prescription that it has been
+2 ;asked to calculate the expiration date for and uses the appropriate
+3 ;"Default Days to Exparation" from the Prescription Sequence Number
+4 ;multiple.
+5 ;
+6 ;X is Return Value (for call from input template)
+7 ;
+8 ;If there is a value on file, use it.
+9 NEW RMPODATA,RMPODAXD
+10 SET RMPODATA=$GET(^RMPR(665,DA(1),"RMPOB",DA,0))
+11 SET X=$PIECE(RMPODATA,"^",3)
if X
QUIT
+12 ;
+13 ;Calculate Sequence Number for Prescription - Default=1
+14 SET RMPODAXD=0
SET X=0
+15 FOR
SET X=$ORDER(^RMPR(665,DA(1),"RMPOB","B",X))
SET RMPODAXD=RMPODAXD+1
if $SELECT(X-RMPODATA=0
QUIT
+16 ;
+17 ;Calculate value based on Prescription Data + Site Parameter
+18 ;
+19 NEW RMPOSITE,X1,X2,Y
+20 SET RMPOSITE=$PIECE($GET(^RMPR(665,DA(1),"RMPOA")),U,7)
+21 if RMPOSITE=""
QUIT
Begin DoDot:1
+22 SET X2=$PIECE($GET(^RMPR(669.9,RMPOSITE,"RMPORXN",RMPODAXD,0)),U,2)
+23 if 'X2
QUIT
SET X=""
+24 SET X1=$PIECE(RMPODATA,U)
DO C^%DTC
+25 QUIT
End DoDot:1
+26 QUIT
EXPAT(X,Y) ;Entry for RMPOPED
+1 NEW DA
SET DA=Y
SET DA(1)=X
DO EXPIRE
+2 QUIT X
