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