215 lines
8.4 KiB
Mathematica
215 lines
8.4 KiB
Mathematica
|
PRPFMR1 ;BAYPINES/MJE DATA MIGRATION ROUTINE 1 ;05/15/03
|
||
|
|
;;3.0;PATIENT FUNDS - MIGRATION 5.1;**16**;JUNE 1, 1989
|
||
|
|
;ENTRY AT LINETAG ONLY
|
||
|
|
Q
|
||
|
|
RPC(RESULTS,PARAM1,PARAM2) ;ENTRY POINT FOR VPFS RPC
|
||
|
|
S PRPFSEG=PARAM1
|
||
|
|
S PRPFJ=PARAM2
|
||
|
|
I PRPFSEG>1 D SENDSEG Q
|
||
|
|
TEST S PRPFOUT1=1
|
||
|
|
LEG ;LEGACY ENTRY POINT
|
||
|
|
S:'$D(PRPFOUT1) PRPFOUT1=2
|
||
|
|
K ^TMP("PRPF_EXTDATA")
|
||
|
|
S (PRPFHLD1,PRPFHLD2,PRPFHLD3,PRPFHLD4,CNTREC,CNTPREC,CNTTOT,PFG,PFX,PFXX)=0
|
||
|
|
S U="^"
|
||
|
|
S PFSITE=$P($$SITE^VASITE(),"^",3)
|
||
|
|
S:PFSITE="" PFSITE="###"
|
||
|
|
S (CNTSEG,CNTXREC)=1
|
||
|
|
F S PRPFHLD1=$O(^PRPF(470,PRPFHLD1)) Q:'PRPFHLD1 D
|
||
|
|
.S PFG=PFG+1 I PFG=100 W "." S PFG=0
|
||
|
|
.S CNTPREC=CNTPREC+1
|
||
|
|
.S PFNODE12=PFSITE
|
||
|
|
.D:$G(^PRPF(470,PRPFHLD1,0))'="" COMPU
|
||
|
|
.D NODE12
|
||
|
|
.D:$G(^PRPF(470,PRPFHLD1,0))'="" NODE0
|
||
|
|
.D:$G(^PRPF(470,PRPFHLD1,1))'="" NODE1
|
||
|
|
.D:$G(^PRPF(470,PRPFHLD1,2))'="" NODE2
|
||
|
|
.D:$O(^PRPF(470,PRPFHLD1,4,0))>0 NODE4
|
||
|
|
.D:$O(^PRPF(470,PRPFHLD1,5,0))>0 NODE5
|
||
|
|
.D:$O(^PRPF(470,PRPFHLD1,6,0))>0 NODE6
|
||
|
|
.D:$O(^PRPF(470,PRPFHLD1,7,0))>0 NODE7
|
||
|
|
.D:$O(^PRPF(470,PRPFHLD1,8,0))>0 NODE8
|
||
|
|
D:PRPFOUT1=1
|
||
|
|
.S CNTTOT=CNTTOT+CNTREC
|
||
|
|
.S ^TMP("PRPF_EXTDATA",$J,0)=DTIME_U_DTIME_U_"DATA FOR PRPF MIGRATION"
|
||
|
|
.S ^TMP("PRPF_EXTDATA",$J,1,0)="VPFS"_U_PFSITE_U_U_U_U_"0"_U_"A1"_U_CNTPREC_U_CNTTOT_U_$J
|
||
|
|
.D NOW^%DTC S Y=% D DD^%DT
|
||
|
|
.S $P(^TMP("PRPF_EXTDATA",$J,1,0),"^",3)="(VER#5.0) "_"RUN-DATE@TIME="_Y
|
||
|
|
.S RESULTS=$NA(^TMP("PRPF_EXTDATA",$J,1))
|
||
|
|
D:PRPFOUT1=2 OUT
|
||
|
|
D KILLIT
|
||
|
|
Q
|
||
|
|
SENDSEG ;SEND A SEGMENT OF DATA TO MIGRATION JAVA APP
|
||
|
|
S RESULTS=$NA(^TMP("PRPF_EXTDATA",PRPFJ,PRPFSEG))
|
||
|
|
Q
|
||
|
|
;***************************************************************
|
||
|
|
COMPU ;
|
||
|
|
S PFNAME=$P($G(^DPT(PRPFHLD1,0)),"^",1)
|
||
|
|
S PFSSN=$P($G(^DPT(PRPFHLD1,0)),"^",9)
|
||
|
|
I PFNAME="" I PFSSN'="" S PFNAME="NAME-MISSING-SSN#"_PFSSN
|
||
|
|
I PFNAME="" I PFSSN="" S PFNAME="NAME-MISSING-NO-SSN-IEN#"_PRPFHLD1
|
||
|
|
S PFSSN=$P($G(^DPT(PRPFHLD1,0)),"^",9)
|
||
|
|
S PFDOB=$P($G(^DPT(PRPFHLD1,0)),"^",3)
|
||
|
|
S PFWARD=$P($G(^DPT(PRPFHLD1,.1)),"^",1)
|
||
|
|
S PFCLAIM=$P($G(^DPT(PRPFHLD1,.31)),"^",3)
|
||
|
|
S PFADDR1=$P($G(^DPT(PRPFHLD1,.11)),"^",1)
|
||
|
|
S PFADDR2=$P($G(^DPT(PRPFHLD1,.11)),"^",2)
|
||
|
|
S PFADDR3=$P($G(^DPT(PRPFHLD1,.11)),"^",3)
|
||
|
|
S PFCITY=$P($G(^DPT(PRPFHLD1,.11)),"^",4)
|
||
|
|
S PFSTATE=$P($G(^DPT(PRPFHLD1,.11)),"^",5)
|
||
|
|
S PFZIP=$P($G(^DPT(PRPFHLD1,.11)),"^",6)
|
||
|
|
;S PFICN=$P($G(^DPT(PRPFHLD1,"MPI")),"^",1)
|
||
|
|
S PFICN=$P($$GETICN^MPIF001(PRPFHLD1),"^")
|
||
|
|
S:PFICN=-1 PFICN=""
|
||
|
|
;S PFSITE=$$KSP^XUPARAM("INST")
|
||
|
|
S PFAUTH=$P(^PRPF(470,PRPFHLD1,0),"^",13)
|
||
|
|
I PFAUTH S PFAUTHRS=$P($G(^VA(200,PFAUTH,0)),"^",1)
|
||
|
|
E S PFAUTHRS=""
|
||
|
|
Q
|
||
|
|
NODE0 S PFNODE0=^PRPF(470,PRPFHLD1,0)
|
||
|
|
S CNTREC=CNTREC+1
|
||
|
|
S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTXREC_U_"D1"_U_PFNAME_U_PFSSN_U_PFDOB_U_PFWARD_U_PFCLAIM_U_PFADDR1_U_PFADDR2_U_PFADDR3_U_PFCITY_U_PFSTATE_U_PFZIP_U_PFAUTHRS_U_PFNODE12
|
||
|
|
D SEG
|
||
|
|
S CNTREC=CNTREC+1
|
||
|
|
S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTXREC_U_"D2"_U_PFNODE0
|
||
|
|
D SEG
|
||
|
|
Q
|
||
|
|
NODE1 S PFNODE1=^PRPF(470,PRPFHLD1,1)
|
||
|
|
S CNTREC=CNTREC+1
|
||
|
|
S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTXREC_U_"B1"_U_PFNODE1
|
||
|
|
D SEG
|
||
|
|
Q
|
||
|
|
NODE2 S PFNODE2=^PRPF(470,PRPFHLD1,2)
|
||
|
|
S CNTREC=CNTREC+1
|
||
|
|
S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTXREC_U_"B2"_U_PFNODE2
|
||
|
|
D SEG
|
||
|
|
Q
|
||
|
|
NODE4 S PRPFHLD2=0
|
||
|
|
F S PRPFHLD2=$O(^PRPF(470,PRPFHLD1,4,PRPFHLD2)) Q:'PRPFHLD2 D
|
||
|
|
.S PFNODE4=^PRPF(470,PRPFHLD1,4,PRPFHLD2,0)
|
||
|
|
.S PFNODE4D=$P(PFNODE4,"^",2)
|
||
|
|
.I $D(^PRPF(470.1,$P(PFNODE4,"^",1),0)) D
|
||
|
|
..S PFNODE4T=^PRPF(470.1,$P(PFNODE4,"^",1),0)
|
||
|
|
..S PFCLERK=$P(PFNODE4T,"^",14)
|
||
|
|
..I $P(PFNODE4T,"^",11) D
|
||
|
|
...S $P(PFNODE4T,"^",11)=$P($G(^PRPF(470.2,$P(PFNODE4T,"^",11),0)),"^",1)
|
||
|
|
..I PFCLERK S PFCLERKN=$P($G(^VA(200,PFCLERK,0)),"^",1)
|
||
|
|
..E S PFCLERKN=""
|
||
|
|
..S $P(PFNODE4T,"^",14)=PFCLERKN
|
||
|
|
..S CNTREC=CNTREC+1
|
||
|
|
..S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTXREC_U_"T1"_U_PFNODE4D_U_PFNODE4T
|
||
|
|
..D SEG
|
||
|
|
Q
|
||
|
|
NODE5 S (PRPFHLD2,PRPFHLD3,PRPFHLD4)=0
|
||
|
|
F S PRPFHLD2=$O(^PRPF(470,PRPFHLD1,5,PRPFHLD2)) Q:'PRPFHLD2 D
|
||
|
|
.S PFNODE5=$G(^PRPF(470,PRPFHLD1,5,PRPFHLD2,0))
|
||
|
|
.S CNTREC=CNTREC+1
|
||
|
|
.S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTXREC_U_"S1"_U_PFNODE5
|
||
|
|
.D SEG
|
||
|
|
.S PRPFHLD3=0
|
||
|
|
.F S PRPFHLD3=$O(^PRPF(470,PRPFHLD1,5,PRPFHLD2,1,PRPFHLD3)) Q:'PRPFHLD3 D
|
||
|
|
..S PFNODE51=$G(^PRPF(470,PRPFHLD1,5,PRPFHLD2,1,PRPFHLD3,0))
|
||
|
|
..S PRPFHLD4=0
|
||
|
|
..I $O(^PRPF(470,PRPFHLD1,5,PRPFHLD2,1,PRPFHLD3,1,PRPFHLD4))'>0 D
|
||
|
|
...S CNTREC=CNTREC+1
|
||
|
|
...S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTXREC_U_"S2"_U_PFNODE51_U
|
||
|
|
...D SEG
|
||
|
|
..F S PRPFHLD4=$O(^PRPF(470,PRPFHLD1,5,PRPFHLD2,1,PRPFHLD3,1,PRPFHLD4)) Q:'PRPFHLD4 D
|
||
|
|
...S PFNODE52=$G(^PRPF(470,PRPFHLD1,5,PRPFHLD2,1,PRPFHLD3,1,PRPFHLD4,0))
|
||
|
|
...I $L(PFNODE52)<128 D
|
||
|
|
....S CNTREC=CNTREC+1
|
||
|
|
....S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTXREC_U_"S2"_U_PFNODE51_U_PFNODE52
|
||
|
|
....D SEG
|
||
|
|
...I $L(PFNODE52)>127 D
|
||
|
|
....S PFNODE53=$E(PFNODE52,128,256)
|
||
|
|
....S PFNODE52=$E(PFNODE52,1,127)
|
||
|
|
....S CNTREC=CNTREC+1
|
||
|
|
....S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTXREC_U_"S2"_U_PFNODE51_U_PFNODE52
|
||
|
|
....D SEG
|
||
|
|
....S CNTREC=CNTREC+1
|
||
|
|
....S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTXREC_U_"S3"_U_PFNODE51_U_PFNODE53
|
||
|
|
....D SEG
|
||
|
|
Q
|
||
|
|
NODE6 S PRPFHLD2=0
|
||
|
|
F S PRPFHLD2=$O(^PRPF(470,PRPFHLD1,6,PRPFHLD2)) Q:'PRPFHLD2 D
|
||
|
|
.S PFNODE6=^PRPF(470,PRPFHLD1,6,PRPFHLD2,0)
|
||
|
|
.S CNTREC=CNTREC+1
|
||
|
|
.S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTXREC_U_"I1"_U_PFNODE6
|
||
|
|
.D SEG
|
||
|
|
Q
|
||
|
|
NODE7 S PRPFHLD2=0
|
||
|
|
F S PRPFHLD2=$O(^PRPF(470,PRPFHLD1,7,PRPFHLD2)) Q:'PRPFHLD2 D
|
||
|
|
.S PFNODE7=^PRPF(470,PRPFHLD1,7,PRPFHLD2,0)
|
||
|
|
.I $L(PFNODE7)<128 D
|
||
|
|
..S CNTREC=CNTREC+1
|
||
|
|
..S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTXREC_U_"R1"_U_PFNODE7
|
||
|
|
..D SEG
|
||
|
|
.I $L(PFNODE7)>127 D
|
||
|
|
..S PFNODE71=$E(PFNODE7,128,256)
|
||
|
|
..S PFNODE7=$E(PFNODE7,1,127)
|
||
|
|
..S CNTREC=CNTREC+1
|
||
|
|
..S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTXREC_U_"R1"_U_PFNODE7
|
||
|
|
..D SEG
|
||
|
|
..S CNTREC=CNTREC+1
|
||
|
|
..S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTXREC_U_"R2"_U_PFNODE71
|
||
|
|
..D SEG
|
||
|
|
Q
|
||
|
|
NODE8 S PRPFHLD2=0
|
||
|
|
F S PRPFHLD2=$O(^PRPF(470,PRPFHLD1,8,PRPFHLD2)) Q:'PRPFHLD2 D
|
||
|
|
.S PFNODE8=^PRPF(470,PRPFHLD1,8,PRPFHLD2,0)
|
||
|
|
.I $L(PFNODE8)<128 D
|
||
|
|
..S CNTREC=CNTREC+1
|
||
|
|
..S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTXREC_U_"X1"_U_PFNODE8
|
||
|
|
..D SEG
|
||
|
|
.I $L(PFNODE8)>127 D
|
||
|
|
..S PFNODE81=$E(PFNODE8,128,256)
|
||
|
|
..S PFNODE8=$E(PFNODE8,1,127)
|
||
|
|
..S CNTREC=CNTREC+1
|
||
|
|
..S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTXREC_U_"X1"_U_PFNODE8
|
||
|
|
..D SEG
|
||
|
|
..S CNTREC=CNTREC+1
|
||
|
|
..S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTXREC_U_"X2"_U_PFNODE81
|
||
|
|
..D SEG
|
||
|
|
Q
|
||
|
|
NODE12 ;CHECK STATION ID
|
||
|
|
I $D(^PRPF(470,PRPFHLD1,12)) I ^PRPF(470,PRPFHLD1,12)'="" D
|
||
|
|
.S:$D(^DIC(4,$G(^PRPF(470,PRPFHLD1,12)),99)) PFNODE12=$P($G(^DIC(4,$G(^PRPF(470,PRPFHLD1,12)),99)),"^",1)
|
||
|
|
.S:'$D(^DIC(4,$G(^PRPF(470,PRPFHLD1,12)),99)) PFNODE12=PFSITE
|
||
|
|
S:'$D(^PRPF(470,PRPFHLD1,12)) PFNODE12=PFSITE
|
||
|
|
S:PFNODE12="" PFNODE12=PFSITE
|
||
|
|
;S CNTREC=CNTREC+1
|
||
|
|
;S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_PFSSN_U_PFICN_U_CNTREC_U_"12"_U_PFNODE12
|
||
|
|
;S ^TMP("PRPF_EXTDATA",$J,CNTSEG,CNTREC)="VPFS"_U_PFSITE_U_PRPFHLD1_U_U_U_CNTREC_U_"12"_U_PFNODE12
|
||
|
|
;D SEG
|
||
|
|
Q
|
||
|
|
SEG ;SET UP NEW SEGMENT NODE
|
||
|
|
S CNTXREC=CNTXREC+1
|
||
|
|
D:CNTREC=10000
|
||
|
|
.S CNTSEG=CNTSEG+1
|
||
|
|
.S CNTTOT=CNTTOT+CNTREC
|
||
|
|
.S CNTREC=0
|
||
|
|
Q
|
||
|
|
OUT ;WRITE OUT TO DEVICE
|
||
|
|
S CNTTOT=CNTTOT+CNTREC
|
||
|
|
W !
|
||
|
|
W !,"Please enter the output device for the detail report or ""^"" to exit:"
|
||
|
|
S %ZIS("B")="",%ZIS("HFSMODE")="W" D ^%ZIS K XION R X:2
|
||
|
|
I POP K ^TMP("PRPF_EXTDATA") Q
|
||
|
|
U IO
|
||
|
|
W "VPFS"_U_PFSITE_U_U_U_U_"0"_U_"A1"_U_CNTPREC_U_CNTXREC
|
||
|
|
F S PFX=$O(^TMP("PRPF_EXTDATA",$J,PFX)) Q:PFX="" D
|
||
|
|
.F S PFXX=$O(^TMP("PRPF_EXTDATA",$J,PFX,PFXX)) Q:PFXX="" D
|
||
|
|
..W !,^TMP("PRPF_EXTDATA",$J,PFX,PFXX)
|
||
|
|
D ^%ZISC
|
||
|
|
K ^TMP("PRPF_EXTDATA")
|
||
|
|
Q
|
||
|
|
KILLIT ;KILL LOCAL VARIABLES
|
||
|
|
K CNTPREC,CNTREC,CNTSEG,CNTTOT,CNTXREC,PARAMS,PFADDR1,PFADDR2,PFADDR3
|
||
|
|
K PFAUTH,PFAUTHRS,PFCITY,PFCLAIM,PFCLERK,PFCLERKN,PFDOB,PFG
|
||
|
|
K PFICN,PFNAME,PFNODE0,PFNODE1,PFNODE12,PFNODE2,PFNODE4,PFNODE4D
|
||
|
|
K PFNODE4T,PFNODE5,PFNODE51,PFNODE52,PFNODE53,PFNODE6,PFNODE7
|
||
|
|
K PFNODE71,PFNODE8,PFNODE81,PFSITE,PFSSN,PFSTATE,PFWARD,PFX
|
||
|
|
K PFXX,PFZIP,POP,PRPFHLD1,PRPFHLD2,PRPFHLD3,PRPFHLD4,PRPFJ
|
||
|
|
K PRPFOUT1,PRPFSEG,X
|
||
|
|
Q
|