| [613] | 1 | PFXIP11 ;WOIFO/MJE-PATCH INSTALL ROUTINE ;8/1/2001
|
|---|
| 2 | ;;3.0;PATIENT FUNDS;**11**;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_"^PFXIP11")
|
|---|
| 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.")
|
|---|
| 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 | ;PFXIP11
|
|---|
