- 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 Feb 18, 2025@23:57:52 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