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