| 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 | 
|---|