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