RMPOPST0 ;EDS/JAM - HOME OXYGEN BILLING TRANSACTIONS/POSTING,Part 1 ;7/24/98
;;3.0;PROSTHETICS;**29,44,47,55**;Feb 09, 1996
;
;This subroutine is part of the billing module. Patient records are
;sorted by fund control point (FCP) and then posted to a 1358 service
;order or Purchase Card order. It calls IFCAP modules to post
; transactions.
Q
;
POST ;main module to post billing transactions to IFCAP
N SITE,RVDT,VDR,FIL K ^TMP($J)
S FIL=665.72,SITE=RMPOXITE,RVDT=RMPODATE,VDR=RMPOVDR,QUIT=0
;
; P55 see if user wants to post $0 amounts to 2319 or ignore them
K DIR
S RMPRPZAM=$$ANY2319()
I RMPRPZAM="^" W !!,"Posting Cancelled..." D EXIT Q
;
D BUILD
;I $O(IFCAP(""))="" W !!,"Nothing to Post..." Q
I $O(^TMP($J,""))="" W !!,"Nothing to Post..." Q
;
;Give user last chance to cancell posting
W !
K DIR S DIR(0)="Y",DIR("A")="Are you Sure you Want to Post Transactions"
S DIR("B")="NO",DIR("?")="NO to Cancel Posting or YES to Proceed"
W ! D ^DIR
I Y'=1!($D(DIRUT)) W !!,"Posting Cancelled..." D EXIT Q
K DIR
D PROCESS
;
EXIT D CLEANUP
K ^TMP($J),VADM,A,Y,DIRUT,QUIT
Q ;EXIT
;
; p55 - prompt if user wants option to post $0 to 2319
; - returns
; 0 if user doesn't want 'the post to 2319' prompt
; "^" on 'time out' or '^'
; 1 if user wants prompting
ANY2319() ;
N DIR,X,Y,RMPRPAM0
S RMPRPAM0=0
W !
S DIR(0)="Y"
S DIR("A",1)="If any transactions with $0.00 amounts exist, do you want "
S DIR("A")="to be able to post any of them to the 2319"
S DIR("B")="NO"
S DIR("?")="Enter 'Y' to be prompted to create a 2319 record at each $0 tranasction."
S DIR("?",1)="If you don't want ANY $0 transactions to be posted to the 2319"
S DIR("?",2)="then enter 'N'"
D ^DIR
S RMPRPAM0=$S(Y=1:1,Y=0:0,1:"^")
W !
Q RMPRPAM0
;
BUILD ;Build array IFCAP with patient transactions to post
;Separate patient individual items by fund control point
;^TMP($J) array
; ^TMP($J,FCP)=FCP total^Post flag^error message^purchase card total
; ^TMP($J,FCP,DFN)=patient tot^pat last name_" "_4 digit SSN^post flag^
; IFCAP error message^pat name
; ^TMP($J,FCP,DFN,ITEM)=item tot
N DFN,ITM,ITDT,ITNO,PATNAM,PATSSN,LNAM,PATFLG,ITSTR,FCP,LCK,ITOT
S DFN="" F S DFN=$O(DFNS(DFN)) Q:DFN="" D
. S PATFLG=^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0)
. ;check patient accept flag
. I $P(PATFLG,U,2)'="Y" Q
. ;check patient post flag
. I $P(PATFLG,U,3)="Y" Q
. D DEM^VADPT S PATNAM=VADM(1),PATSSN=VA("BID") ;patient name & ssn
. ;lock patient record
. S LCK=$$PATLCK() I 'LCK W !,PATNAM," record locked by another user" Q
. ;get items not posted for each patient
. S ITM=0
. F S ITM=$O(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,ITM)) Q:'ITM D
. . S ITDT=^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,ITM,0)
. . K R2319F
. . ;check if item posted
. . I $P(ITDT,U,10)="Y" Q
. . S ITNO=$P(ITDT,U),FCP=$P(ITDT,U,3),ITOT=$P(ITDT,U,6)
. .; I ITOT'>0 Q ;no amount to post
. . I ITOT'>0 D
. . .S RMITEM=$P($G(^RMPR(661,ITNO,0)),U,1)
. . .I RMPRPZAM D
. . . .W !,"*** Patient: ",$E(PATNAM,1,7)," - Line Item: ",$P($G(^PRC(441,RMITEM,0)),U,2)," has a ZERO DOLLAR amount ***"
. . . .S DIR("??")="This is a required field, you must enter Y/N"
. . . .S DIR(0)="Y",DIR("A")="Would You like to Post to 2319 (Y/N) "
. . . .F D ^DIR I Y=1!(Y=0) S R2319F=Y K DIR Q
. . .E D
. . . .S R2319F=0
. . .I $D(R2319F),(R2319F=0) D
. . . .K DIE,DA,DR S DA(4)=RMPOXITE,DA(3)=RMPODATE,DA(2)=RMPOVDR
. . . .S DA(1)=DFN,DIK="^RMPO(665.72,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_",""V"","_DA(1)
. . . .S DIK=DIK_",1,",DA=ITM D ^DIK K DIK,DA
. . . .S RNEXITEM=$O(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RMPOVDR,"V",DFN,1,0))
. . . .I 'RNEXITEM S DA(3)=RMPOXITE,DA(2)=RMPODATE,DA(1)=RMPOVDR,DA=DFN D
. . . . .S DIK="^RMPO(665.72,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",""V""," D ^DIK K DIK,DA
. . I $D(R2319F),(R2319F=0) Q
. . I FCP="" Q ;no fund control point
. . ;set ^TMP($J) array
. . S ^TMP($J,FCP)=$S('$D(^TMP($J,FCP)):0.00,1:^TMP($J,FCP))+ITOT
. . I $G(^TMP($J,FCP,DFN))="" D
. . . S LNAM=$E($P(PATNAM,",")_" ",1,7) ;pad/truncate last name
. . . S ^TMP($J,FCP,DFN)="^"_LNAM_" "_PATSSN_"^^^"_$E(PATNAM,1,18)
. . S $P(^TMP($J,FCP,DFN),U)=+^TMP($J,FCP,DFN)+ITOT,^TMP($J,FCP,DFN,ITM)=ITOT
. D UNLKPAT
Q ;BUILD
;
PROCESS ;process FCP data - ask for method of payment
N FCP,PAYINF,FCPTOT,IEN442,SRVORD,PCTOT,IENFCP,LCK
S FCP="" F S FCP=$O(^TMP($J,FCP)) Q:FCP="" D I QUIT Q
. ;PAYINF=payment type^IEN of file 442^service order number^purchase
. ;card total^IEN of fund control point transaction
. S FCPTOT=+^TMP($J,FCP) W !!,"Fund Control Point: ",FCP
. S PAYINF=$$FCP^RMPOBILU(FCP)
. I PAYINF="" S $P(^TMP($J,FCP),U,3)="Posting aborted"
. Q:QUIT!(PAYINF="") I PAYINF=-1 D Q
. . S $P(^TMP($J,FCP),U,2)=0,$P(^TMP($J,FCP),U,3)="Payment type not given"
. . ;W " ",$P^TMP($J,FCP),U,3)
. S IEN442=$P(PAYINF,U,2),SRVORD=$P(PAYINF,U,3)
. S PCTOT=$P(PAYINF,U,4),IENFCP=$P(PAYINF,U,5)
. ;W !,"Service Order Number: ",SRVORD
. ;check lock on FCP
. S LCK=$$FCPLCK() I 'LCK D Q
. . S $P(^TMP($J,FCP),U,2)=0,$P(^TMP($J,FCP),U,3)="Locked by another user"
. . W " ",$P(^TMP($J,FCP),U,3)
. D IFCAP^RMPOPST1 ;process payment to IFCAP
. D UNLKFCP ;unlock FCP level
Q ;PROCESS
;
PATLCK() ;Lock patient level in ^RMPO(665.72
L +^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0):5
Q $T ;PATLCK
;
FCPLCK() ;Lock fund control level in ^RPO(665.72
L +^RMPO(FIL,SITE,1,RVDT,2,IENFCP,0):5
Q $T ;FCPLCK
;
UNLKPAT ;Unlock patient level in ^RMPO(665.72
L -^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0)
Q ;UNLKPAT
;
UNLKFCP ;Unlock fund contrl point level in ^RMPO(665.72
L -^RMPO(FIL,SITE,1,RVDT,2,IENFCP,0)
Q ;UNLKFCP
;
CLEANUP ;Display post messages for FCP
;Call line tag to unlock ^RMPO at patient level
N DFN,UNLCK,FLG
S FCP="",FLG=1
F S FCP=$O(^TMP($J,FCP)) Q:FCP="" D
. I '$P(^TMP($J,FCP),U,2) D
. . I FLG W !!,"FCP Not Posted",?40,"Message" D
. . . W !,"---------------",?40,"-------"
. . W !,FCP,?40,$P(^TMP($J,FCP),U,3) S FLG=0
. S DFN="" F DFN=$O(^TMP($J,FCP,DFN)) Q:DFN="" D
. . I '$D(UNLCK(DFN)) D UNLKPAT S UNLCK(DFN)=""
W !! I FLG W "All Fund Control Points posted successfully"
K DIR S DIR(0)="FO",DIR("A")="Press any Key to Continue" D ^DIR
Q ;CLEANUP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOPST0 6401 printed Dec 13, 2024@02:31:23 Page 2
RMPOPST0 ;EDS/JAM - HOME OXYGEN BILLING TRANSACTIONS/POSTING,Part 1 ;7/24/98
+1 ;;3.0;PROSTHETICS;**29,44,47,55**;Feb 09, 1996
+2 ;
+3 ;This subroutine is part of the billing module. Patient records are
+4 ;sorted by fund control point (FCP) and then posted to a 1358 service
+5 ;order or Purchase Card order. It calls IFCAP modules to post
+6 ; transactions.
+7 QUIT
+8 ;
POST ;main module to post billing transactions to IFCAP
+1 NEW SITE,RVDT,VDR,FIL
KILL ^TMP($JOB)
+2 SET FIL=665.72
SET SITE=RMPOXITE
SET RVDT=RMPODATE
SET VDR=RMPOVDR
SET QUIT=0
+3 ;
+4 ; P55 see if user wants to post $0 amounts to 2319 or ignore them
+5 KILL DIR
+6 SET RMPRPZAM=$$ANY2319()
+7 IF RMPRPZAM="^"
WRITE !!,"Posting Cancelled..."
DO EXIT
QUIT
+8 ;
+9 DO BUILD
+10 ;I $O(IFCAP(""))="" W !!,"Nothing to Post..." Q
+11 IF $ORDER(^TMP($JOB,""))=""
WRITE !!,"Nothing to Post..."
QUIT
+12 ;
+13 ;Give user last chance to cancell posting
+14 WRITE !
+15 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Are you Sure you Want to Post Transactions"
+16 SET DIR("B")="NO"
SET DIR("?")="NO to Cancel Posting or YES to Proceed"
+17 WRITE !
DO ^DIR
+18 IF Y'=1!($DATA(DIRUT))
WRITE !!,"Posting Cancelled..."
DO EXIT
QUIT
+19 KILL DIR
+20 DO PROCESS
+21 ;
EXIT DO CLEANUP
+1 KILL ^TMP($JOB),VADM,A,Y,DIRUT,QUIT
+2 ;EXIT
QUIT
+3 ;
+4 ; p55 - prompt if user wants option to post $0 to 2319
+5 ; - returns
+6 ; 0 if user doesn't want 'the post to 2319' prompt
+7 ; "^" on 'time out' or '^'
+8 ; 1 if user wants prompting
ANY2319() ;
+1 NEW DIR,X,Y,RMPRPAM0
+2 SET RMPRPAM0=0
+3 WRITE !
+4 SET DIR(0)="Y"
+5 SET DIR("A",1)="If any transactions with $0.00 amounts exist, do you want "
+6 SET DIR("A")="to be able to post any of them to the 2319"
+7 SET DIR("B")="NO"
+8 SET DIR("?")="Enter 'Y' to be prompted to create a 2319 record at each $0 tranasction."
+9 SET DIR("?",1)="If you don't want ANY $0 transactions to be posted to the 2319"
+10 SET DIR("?",2)="then enter 'N'"
+11 DO ^DIR
+12 SET RMPRPAM0=$SELECT(Y=1:1,Y=0:0,1:"^")
+13 WRITE !
+14 QUIT RMPRPAM0
+15 ;
BUILD ;Build array IFCAP with patient transactions to post
+1 ;Separate patient individual items by fund control point
+2 ;^TMP($J) array
+3 ; ^TMP($J,FCP)=FCP total^Post flag^error message^purchase card total
+4 ; ^TMP($J,FCP,DFN)=patient tot^pat last name_" "_4 digit SSN^post flag^
+5 ; IFCAP error message^pat name
+6 ; ^TMP($J,FCP,DFN,ITEM)=item tot
+7 NEW DFN,ITM,ITDT,ITNO,PATNAM,PATSSN,LNAM,PATFLG,ITSTR,FCP,LCK,ITOT
+8 SET DFN=""
FOR
SET DFN=$ORDER(DFNS(DFN))
if DFN=""
QUIT
Begin DoDot:1
+9 SET PATFLG=^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0)
+10 ;check patient accept flag
+11 IF $PIECE(PATFLG,U,2)'="Y"
QUIT
+12 ;check patient post flag
+13 IF $PIECE(PATFLG,U,3)="Y"
QUIT
+14 ;patient name & ssn
DO DEM^VADPT
SET PATNAM=VADM(1)
SET PATSSN=VA("BID")
+15 ;lock patient record
+16 SET LCK=$$PATLCK()
IF 'LCK
WRITE !,PATNAM," record locked by another user"
QUIT
+17 ;get items not posted for each patient
+18 SET ITM=0
+19 FOR
SET ITM=$ORDER(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,ITM))
if 'ITM
QUIT
Begin DoDot:2
+20 SET ITDT=^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,ITM,0)
+21 KILL R2319F
+22 ;check if item posted
+23 IF $PIECE(ITDT,U,10)="Y"
QUIT
+24 SET ITNO=$PIECE(ITDT,U)
SET FCP=$PIECE(ITDT,U,3)
SET ITOT=$PIECE(ITDT,U,6)
+25 ; I ITOT'>0 Q ;no amount to post
+26 IF ITOT'>0
Begin DoDot:3
+27 SET RMITEM=$PIECE($GET(^RMPR(661,ITNO,0)),U,1)
+28 IF RMPRPZAM
Begin DoDot:4
+29 WRITE !,"*** Patient: ",$EXTRACT(PATNAM,1,7)," - Line Item: ",$PIECE($GET(^PRC(441,RMITEM,0)),U,2)," has a ZERO DOLLAR amount ***"
+30 SET DIR("??")="This is a required field, you must enter Y/N"
+31 SET DIR(0)="Y"
SET DIR("A")="Would You like to Post to 2319 (Y/N) "
+32 FOR
DO ^DIR
IF Y=1!(Y=0)
SET R2319F=Y
KILL DIR
QUIT
End DoDot:4
+33 IF '$TEST
Begin DoDot:4
+34 SET R2319F=0
End DoDot:4
+35 IF $DATA(R2319F)
IF (R2319F=0)
Begin DoDot:4
+36 KILL DIE,DA,DR
SET DA(4)=RMPOXITE
SET DA(3)=RMPODATE
SET DA(2)=RMPOVDR
+37 SET DA(1)=DFN
SET DIK="^RMPO(665.72,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_",""V"","_DA(1)
+38 SET DIK=DIK_",1,"
SET DA=ITM
DO ^DIK
KILL DIK,DA
+39 SET RNEXITEM=$ORDER(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RMPOVDR,"V",DFN,1,0))
+40 IF 'RNEXITEM
SET DA(3)=RMPOXITE
SET DA(2)=RMPODATE
SET DA(1)=RMPOVDR
SET DA=DFN
Begin DoDot:5
+41 SET DIK="^RMPO(665.72,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",""V"","
DO ^DIK
KILL DIK,DA
End DoDot:5
End DoDot:4
End DoDot:3
+42 IF $DATA(R2319F)
IF (R2319F=0)
QUIT
+43 ;no fund control point
IF FCP=""
QUIT
+44 ;set ^TMP($J) array
+45 SET ^TMP($JOB,FCP)=$SELECT('$DATA(^TMP($JOB,FCP)):0.00,1:^TMP($JOB,FCP))+ITOT
+46 IF $GET(^TMP($JOB,FCP,DFN))=""
Begin DoDot:3
+47 ;pad/truncate last name
SET LNAM=$EXTRACT($PIECE(PATNAM,",")_" ",1,7)
+48 SET ^TMP($JOB,FCP,DFN)="^"_LNAM_" "_PATSSN_"^^^"_$EXTRACT(PATNAM,1,18)
End DoDot:3
+49 SET $PIECE(^TMP($JOB,FCP,DFN),U)=+^TMP($JOB,FCP,DFN)+ITOT
SET ^TMP($JOB,FCP,DFN,ITM)=ITOT
End DoDot:2
+50 DO UNLKPAT
End DoDot:1
+51 ;BUILD
QUIT
+52 ;
PROCESS ;process FCP data - ask for method of payment
+1 NEW FCP,PAYINF,FCPTOT,IEN442,SRVORD,PCTOT,IENFCP,LCK
+2 SET FCP=""
FOR
SET FCP=$ORDER(^TMP($JOB,FCP))
if FCP=""
QUIT
Begin DoDot:1
+3 ;PAYINF=payment type^IEN of file 442^service order number^purchase
+4 ;card total^IEN of fund control point transaction
+5 SET FCPTOT=+^TMP($JOB,FCP)
WRITE !!,"Fund Control Point: ",FCP
+6 SET PAYINF=$$FCP^RMPOBILU(FCP)
+7 IF PAYINF=""
SET $PIECE(^TMP($JOB,FCP),U,3)="Posting aborted"
+8 if QUIT!(PAYINF="")
QUIT
IF PAYINF=-1
Begin DoDot:2
+9 SET $PIECE(^TMP($JOB,FCP),U,2)=0
SET $PIECE(^TMP($JOB,FCP),U,3)="Payment type not given"
+10 ;W " ",$P^TMP($J,FCP),U,3)
End DoDot:2
QUIT
+11 SET IEN442=$PIECE(PAYINF,U,2)
SET SRVORD=$PIECE(PAYINF,U,3)
+12 SET PCTOT=$PIECE(PAYINF,U,4)
SET IENFCP=$PIECE(PAYINF,U,5)
+13 ;W !,"Service Order Number: ",SRVORD
+14 ;check lock on FCP
+15 SET LCK=$$FCPLCK()
IF 'LCK
Begin DoDot:2
+16 SET $PIECE(^TMP($JOB,FCP),U,2)=0
SET $PIECE(^TMP($JOB,FCP),U,3)="Locked by another user"
+17 WRITE " ",$PIECE(^TMP($JOB,FCP),U,3)
End DoDot:2
QUIT
+18 ;process payment to IFCAP
DO IFCAP^RMPOPST1
+19 ;unlock FCP level
DO UNLKFCP
End DoDot:1
IF QUIT
QUIT
+20 ;PROCESS
QUIT
+21 ;
PATLCK() ;Lock patient level in ^RMPO(665.72
+1 LOCK +^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0):5
+2 ;PATLCK
QUIT $TEST
+3 ;
FCPLCK() ;Lock fund control level in ^RPO(665.72
+1 LOCK +^RMPO(FIL,SITE,1,RVDT,2,IENFCP,0):5
+2 ;FCPLCK
QUIT $TEST
+3 ;
UNLKPAT ;Unlock patient level in ^RMPO(665.72
+1 LOCK -^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0)
+2 ;UNLKPAT
QUIT
+3 ;
UNLKFCP ;Unlock fund contrl point level in ^RMPO(665.72
+1 LOCK -^RMPO(FIL,SITE,1,RVDT,2,IENFCP,0)
+2 ;UNLKFCP
QUIT
+3 ;
CLEANUP ;Display post messages for FCP
+1 ;Call line tag to unlock ^RMPO at patient level
+2 NEW DFN,UNLCK,FLG
+3 SET FCP=""
SET FLG=1
+4 FOR
SET FCP=$ORDER(^TMP($JOB,FCP))
if FCP=""
QUIT
Begin DoDot:1
+5 IF '$PIECE(^TMP($JOB,FCP),U,2)
Begin DoDot:2
+6 IF FLG
WRITE !!,"FCP Not Posted",?40,"Message"
Begin DoDot:3
+7 WRITE !,"---------------",?40,"-------"
End DoDot:3
+8 WRITE !,FCP,?40,$PIECE(^TMP($JOB,FCP),U,3)
SET FLG=0
End DoDot:2
+9 SET DFN=""
FOR DFN=$ORDER(^TMP($JOB,FCP,DFN))
if DFN=""
QUIT
Begin DoDot:2
+10 IF '$DATA(UNLCK(DFN))
DO UNLKPAT
SET UNLCK(DFN)=""
End DoDot:2
End DoDot:1
+11 WRITE !!
IF FLG
WRITE "All Fund Control Points posted successfully"
+12 KILL DIR
SET DIR(0)="FO"
SET DIR("A")="Press any Key to Continue"
DO ^DIR
+13 ;CLEANUP
QUIT
