| [613] | 1 | RMPRPF ;HOIFO/TH,DDA - Patient Financial Services System (PFSS) Support Main ;8/18/05
|
|---|
| 2 | ;;3.0;PROSTHETICS;**98**;Feb 09, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine is the main entry point for the RMPR PFSS BACGROUND process.
|
|---|
| 5 | ; Entry point EN will check the current setting of the PFSS Master Switch,
|
|---|
| 6 | ; process Account Creation, Charges, and Updates for Purchasing,
|
|---|
| 7 | ; Stock Issue, and Home Oxygen.
|
|---|
| 8 | ;
|
|---|
| 9 | ; Entry point SEED is a one time subroutine that is to be run at implementation
|
|---|
| 10 | ; to seed Home Oxygen with PFSS ACCOUNT REFERENCE numbers for all those Home
|
|---|
| 11 | ; Oxygen prescriptions that are valid at the date the PFSS Master Switch was
|
|---|
| 12 | ; turned on. SEED should only be run at implementation (or re-implementation)
|
|---|
| 13 | ; of PFSS, as directed by the implementation team.
|
|---|
| 14 | ;
|
|---|
| 15 | ; DBIA # 4663 for SWSTAT^IBBAPI
|
|---|
| 16 | ;
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | EN ; Entry Point
|
|---|
| 20 | ; Check PFSS Master Switch
|
|---|
| 21 | Q:'+$$SWSTAT^IBBAPI()
|
|---|
| 22 | ;
|
|---|
| 23 | ; Loop thru APH x-ref
|
|---|
| 24 | S RMPRDA="" F S RMPRDA=$O(^RMPR(660,"APH",1,RMPRDA)) Q:RMPRDA="" D
|
|---|
| 25 | . D EN^RMPRPF1
|
|---|
| 26 | ;
|
|---|
| 27 | ; Loop thru APD x-ref
|
|---|
| 28 | S RMPRDA="" F S RMPRDA=$O(^RMPR(660,"APD",1,RMPRDA)) Q:RMPRDA="" D
|
|---|
| 29 | . D EN^RMPRPF2
|
|---|
| 30 | ; Call Home Oxygen
|
|---|
| 31 | D EN^RMPOPF
|
|---|
| 32 | D EXIT
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | EXIT ; Common exit point
|
|---|
| 36 | D KILL^XUSCLEAN
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | ; The following code is to be run at implementation time only.
|
|---|
| 40 | SEED ; Seed Home Oxygen Prescription items with initial PFSS ACCOUNT REFERENCE numbers.
|
|---|
| 41 | ; If this is a re-implementation, previous account references will be replaced.
|
|---|
| 42 | ;
|
|---|
| 43 | S RMPRSW=$$SWSTAT^IBBAPI()
|
|---|
| 44 | G:'+RMPRSW EXSEED
|
|---|
| 45 | S RMPRSWDT=$P(RMPRSW,"^",2)
|
|---|
| 46 | S RMPRIEN=0
|
|---|
| 47 | F S RMPRIEN=$O(^RMPR(665,RMPRIEN)) Q:RMPRIEN'>0 D
|
|---|
| 48 | .S RMPRRX=0
|
|---|
| 49 | .F S RMPRRX=$O(^RMPR(665,RMPRIEN,"RMPOB",RMPRRX)) Q:RMPRRX'>0 D
|
|---|
| 50 | ..;QUIT IF RX EXPRIRATION DATE IS LESS THAN (BEFORE) PFSS SWITCH ON DATE
|
|---|
| 51 | ..Q:$P($G(^RMPR(665,RMPRIEN,"RMPOB",RMPRRX,0)),"^",3)<RMPRSWDT
|
|---|
| 52 | ..;SET THE "APNEW" FLAG FOR THE PRESCRIPTION
|
|---|
| 53 | ..S DIE="^RMPR(665,"_RMPRIEN_",""RMPOB"","
|
|---|
| 54 | ..S DA(1)=RMPRIEN,DA=RMPRRX
|
|---|
| 55 | ..S DR="100///1"
|
|---|
| 56 | ..D ^DIE
|
|---|
| 57 | ..K DIE,DA,DR
|
|---|
| 58 | ..Q
|
|---|
| 59 | .Q
|
|---|
| 60 | ; DIRECT CALL TO THE BACKGROUND PROCESS CODE FOR HOME OXYGEN TO PROCESS THE APNEW FLAG
|
|---|
| 61 | ; AND OBTAIN PFSS ACCOUNT REFERENCE NUMBERS.
|
|---|
| 62 | D EN^RMPOPF
|
|---|
| 63 | ;
|
|---|
| 64 | EXSEED ;
|
|---|
| 65 | K RMPRIEN,RMPRRX,RMPRSW,RMPRSWDT
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | POST ; The following code is only to be run during patch installation as the post-init
|
|---|
| 69 | ; This code tasks the running of the routine RMPR112P which contains the fix for the
|
|---|
| 70 | ; partial patient merge data-KIDS build issue.
|
|---|
| 71 | N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC
|
|---|
| 72 | S ZTIO="",ZTRTN="RMPR112P",ZTDESC="Prosthetics Post-INIT for patch RMPR*3*98.",ZTDTH=$H
|
|---|
| 73 | D ^%ZTLOAD
|
|---|
| 74 | Q
|
|---|
