1 | PFXIP12 ;WOIFO/MJE-PATCH INSTALL ROUTINE ;11/19/2001
|
---|
2 | ;;3.0;PATIENT FUNDS;**12**;JUNE 1, 1989
|
---|
3 | Q
|
---|
4 | PS ; post-install entry point
|
---|
5 | ; create KIDS checkpoints with call backs
|
---|
6 | N PFX,Y
|
---|
7 | F PFX="UPDPRPF" D
|
---|
8 | .S Y=$$NEWCP^XPDUTL(PFX,PFX_"^PFXIP12")
|
---|
9 | .I 'Y D BMES^XPDUTL("ERROR Creating "_PFX_" Checkpoint.")
|
---|
10 | Q
|
---|
11 | ;
|
---|
12 | UPDPRPF ;Update selected Personal Funds records
|
---|
13 | N X,Y,DA,DR,DIE,DIK,IENX,IENY,NEWIEN,PFF1,PFX
|
---|
14 | D BMES^XPDUTL(" Updating Personal Funds files 470.1,470.2")
|
---|
15 | ; check for the existence of bad pfunds form if not present quit routine
|
---|
16 | D:'$D(^PRPF(470.2,"B","PICKLO, JOSEPH")) MES^XPDUTL(" Update of the Personal Funds Forms file not required.")
|
---|
17 | Q:'$D(^PRPF(470.2,"B","PICKLO, JOSEPH"))
|
---|
18 | ; check for the form that will be pointed to if updates are made, if not present quit routine
|
---|
19 | D:'$D(^PRPF(470.2,"B","10-1083")) MES^XPDUTL(" Problem: Form 10-1083 not found! Update aborted, please refer to installation instructions.")
|
---|
20 | Q:'$D(^PRPF(470.2,"B","10-1083"))
|
---|
21 | D:'$D(^PRPF(470.1)) MES^XPDUTL(" Problem: Patient Funds Master Transaction file does not exist, Update Aborted")
|
---|
22 | Q:'$D(^PRPF(470.1,0))
|
---|
23 | ;search files 470.1 for records that need to be re-pointed
|
---|
24 | S (IENX,IENY,NEWIEN)=0
|
---|
25 | S NEWIEN=$O(^PRPF(470.2,"B","10-1083",0))
|
---|
26 | F S IENX=$O(^PRPF(470.2,"B","PICKLO, JOSEPH",IENX)) Q:'IENX D
|
---|
27 | .F S IENY=$O(^PRPF(470.1,IENY)) Q:'IENY D
|
---|
28 | ..I $P(^PRPF(470.1,IENY,0),"^",11)=IENX D
|
---|
29 | ...S DR="10////^S X=NEWIEN",DIE="^PRPF(470.1,",DA=IENY
|
---|
30 | ...L +^PRPF(470.1,IENY):0 I $T D
|
---|
31 | ....D ^DIE L -^PRPF(470.1,IENY)
|
---|
32 | ...E I '$D(PFF1) D
|
---|
33 | ....D BMES^XPDUTL(" Error: Could not lock file 470.1, rerun patch")
|
---|
34 | ....S PFF1=1
|
---|
35 | .;if no lock errors flagged then delete bad pfunds form entry
|
---|
36 | .I '$D(PFF1) S DIK="^PRPF(470.2,",DA=IENX D ^DIK D MES^XPDUTL(" Update Successful")
|
---|
37 | Q
|
---|
38 | ;PFXIP12
|
---|