RMPRPF ;HOIFO/TH,DDA - Patient Financial Services System (PFSS) Support Main ;8/18/05
;;3.0;PROSTHETICS;**98**;Feb 09, 1996
;
; This routine is the main entry point for the RMPR PFSS BACGROUND process.
; Entry point EN will check the current setting of the PFSS Master Switch,
; process Account Creation, Charges, and Updates for Purchasing,
; Stock Issue, and Home Oxygen.
;
; Entry point SEED is a one time subroutine that is to be run at implementation
; to seed Home Oxygen with PFSS ACCOUNT REFERENCE numbers for all those Home
; Oxygen prescriptions that are valid at the date the PFSS Master Switch was
; turned on. SEED should only be run at implementation (or re-implementation)
; of PFSS, as directed by the implementation team.
;
; DBIA # 4663 for SWSTAT^IBBAPI
;
Q
;
EN ; Entry Point
; Check PFSS Master Switch
Q:'+$$SWSTAT^IBBAPI()
;
; Loop thru APH x-ref
S RMPRDA="" F S RMPRDA=$O(^RMPR(660,"APH",1,RMPRDA)) Q:RMPRDA="" D
. D EN^RMPRPF1
;
; Loop thru APD x-ref
S RMPRDA="" F S RMPRDA=$O(^RMPR(660,"APD",1,RMPRDA)) Q:RMPRDA="" D
. D EN^RMPRPF2
; Call Home Oxygen
D EN^RMPOPF
D EXIT
Q
;
EXIT ; Common exit point
D KILL^XUSCLEAN
Q
;
; The following code is to be run at implementation time only.
SEED ; Seed Home Oxygen Prescription items with initial PFSS ACCOUNT REFERENCE numbers.
; If this is a re-implementation, previous account references will be replaced.
;
S RMPRSW=$$SWSTAT^IBBAPI()
G:'+RMPRSW EXSEED
S RMPRSWDT=$P(RMPRSW,"^",2)
S RMPRIEN=0
F S RMPRIEN=$O(^RMPR(665,RMPRIEN)) Q:RMPRIEN'>0 D
.S RMPRRX=0
.F S RMPRRX=$O(^RMPR(665,RMPRIEN,"RMPOB",RMPRRX)) Q:RMPRRX'>0 D
..;QUIT IF RX EXPRIRATION DATE IS LESS THAN (BEFORE) PFSS SWITCH ON DATE
..Q:$P($G(^RMPR(665,RMPRIEN,"RMPOB",RMPRRX,0)),"^",3)<RMPRSWDT
..;SET THE "APNEW" FLAG FOR THE PRESCRIPTION
..S DIE="^RMPR(665,"_RMPRIEN_",""RMPOB"","
..S DA(1)=RMPRIEN,DA=RMPRRX
..S DR="100///1"
..D ^DIE
..K DIE,DA,DR
..Q
.Q
; DIRECT CALL TO THE BACKGROUND PROCESS CODE FOR HOME OXYGEN TO PROCESS THE APNEW FLAG
; AND OBTAIN PFSS ACCOUNT REFERENCE NUMBERS.
D EN^RMPOPF
;
EXSEED ;
K RMPRIEN,RMPRRX,RMPRSW,RMPRSWDT
Q
;
POST ; The following code is only to be run during patch installation as the post-init
; This code tasks the running of the routine RMPR112P which contains the fix for the
; partial patient merge data-KIDS build issue.
N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC
S ZTIO="",ZTRTN="RMPR112P",ZTDESC="Prosthetics Post-INIT for patch RMPR*3*98.",ZTDTH=$H
D ^%ZTLOAD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPF 2619 printed Sep 23, 2025@20:11:59 Page 2
RMPRPF ;HOIFO/TH,DDA - Patient Financial Services System (PFSS) Support Main ;8/18/05
+1 ;;3.0;PROSTHETICS;**98**;Feb 09, 1996
+2 ;
+3 ; This routine is the main entry point for the RMPR PFSS BACGROUND process.
+4 ; Entry point EN will check the current setting of the PFSS Master Switch,
+5 ; process Account Creation, Charges, and Updates for Purchasing,
+6 ; Stock Issue, and Home Oxygen.
+7 ;
+8 ; Entry point SEED is a one time subroutine that is to be run at implementation
+9 ; to seed Home Oxygen with PFSS ACCOUNT REFERENCE numbers for all those Home
+10 ; Oxygen prescriptions that are valid at the date the PFSS Master Switch was
+11 ; turned on. SEED should only be run at implementation (or re-implementation)
+12 ; of PFSS, as directed by the implementation team.
+13 ;
+14 ; DBIA # 4663 for SWSTAT^IBBAPI
+15 ;
+16 QUIT
+17 ;
EN ; Entry Point
+1 ; Check PFSS Master Switch
+2 if '+$$SWSTAT^IBBAPI()
QUIT
+3 ;
+4 ; Loop thru APH x-ref
+5 SET RMPRDA=""
FOR
SET RMPRDA=$ORDER(^RMPR(660,"APH",1,RMPRDA))
if RMPRDA=""
QUIT
Begin DoDot:1
+6 DO EN^RMPRPF1
End DoDot:1
+7 ;
+8 ; Loop thru APD x-ref
+9 SET RMPRDA=""
FOR
SET RMPRDA=$ORDER(^RMPR(660,"APD",1,RMPRDA))
if RMPRDA=""
QUIT
Begin DoDot:1
+10 DO EN^RMPRPF2
End DoDot:1
+11 ; Call Home Oxygen
+12 DO EN^RMPOPF
+13 DO EXIT
+14 QUIT
+15 ;
EXIT ; Common exit point
+1 DO KILL^XUSCLEAN
+2 QUIT
+3 ;
+4 ; The following code is to be run at implementation time only.
SEED ; Seed Home Oxygen Prescription items with initial PFSS ACCOUNT REFERENCE numbers.
+1 ; If this is a re-implementation, previous account references will be replaced.
+2 ;
+3 SET RMPRSW=$$SWSTAT^IBBAPI()
+4 if '+RMPRSW
GOTO EXSEED
+5 SET RMPRSWDT=$PIECE(RMPRSW,"^",2)
+6 SET RMPRIEN=0
+7 FOR
SET RMPRIEN=$ORDER(^RMPR(665,RMPRIEN))
if RMPRIEN'>0
QUIT
Begin DoDot:1
+8 SET RMPRRX=0
+9 FOR
SET RMPRRX=$ORDER(^RMPR(665,RMPRIEN,"RMPOB",RMPRRX))
if RMPRRX'>0
QUIT
Begin DoDot:2
+10 ;QUIT IF RX EXPRIRATION DATE IS LESS THAN (BEFORE) PFSS SWITCH ON DATE
+11 if $PIECE($GET(^RMPR(665,RMPRIEN,"RMPOB",RMPRRX,0)),"^",3)<RMPRSWDT
QUIT
+12 ;SET THE "APNEW" FLAG FOR THE PRESCRIPTION
+13 SET DIE="^RMPR(665,"_RMPRIEN_",""RMPOB"","
+14 SET DA(1)=RMPRIEN
SET DA=RMPRRX
+15 SET DR="100///1"
+16 DO ^DIE
+17 KILL DIE,DA,DR
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 ; DIRECT CALL TO THE BACKGROUND PROCESS CODE FOR HOME OXYGEN TO PROCESS THE APNEW FLAG
+21 ; AND OBTAIN PFSS ACCOUNT REFERENCE NUMBERS.
+22 DO EN^RMPOPF
+23 ;
EXSEED ;
+1 KILL RMPRIEN,RMPRRX,RMPRSW,RMPRSWDT
+2 QUIT
+3 ;
POST ; The following code is only to be run during patch installation as the post-init
+1 ; This code tasks the running of the routine RMPR112P which contains the fix for the
+2 ; partial patient merge data-KIDS build issue.
+3 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC
+4 SET ZTIO=""
SET ZTRTN="RMPR112P"
SET ZTDESC="Prosthetics Post-INIT for patch RMPR*3*98."
SET ZTDTH=$HOROLOG
+5 DO ^%ZTLOAD
+6 QUIT
