154 lines
8.5 KiB
Mathematica
154 lines
8.5 KiB
Mathematica
|
PRPFDR1 ;BAYPINES/MJE VPFS DATA MIGRATION ROUTINE 1 ;05/15/03
|
||
|
|
;;3.0;PATIENT FUNDS DIAG V5.9;**15**;JUNE 1, 1989
|
||
|
|
;BAD ENTRY POINT
|
||
|
|
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)
|
||
|
|
.I '$D(^PRPF(470.1,+$P(PFNODE4,"^",1),0)) D
|
||
|
|
..S ^TMP("PRPF_DIAGX",$J,PFSTAID,47,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="TRANSACTION REC^Transaction record missing, blank or ID invalid (Transaction missing)^"_$P(PFNODE4,"^",1)
|
||
|
|
..S CNTERR(47)=CNTERR(47)+1
|
||
|
|
..S CNTERR(100)=CNTERR(100)+1
|
||
|
|
.I $D(^PRPF(470.1,+$P(PFNODE4,"^",1),0)) D
|
||
|
|
..S PFNODE4D=^PRPF(470.1,$P(PFNODE4,"^",1),0)
|
||
|
|
..I PFNODE4D="" D
|
||
|
|
...S ^TMP("PRPF_DIAGX",$J,PFSTAID,47,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="TRANSACTION REC^Transaction record missing, blank or ID invalid (Record blank)^"_$P(PFNODE4,"^",1)
|
||
|
|
...S CNTERR(47)=CNTERR(47)+1
|
||
|
|
...S CNTERR(100)=CNTERR(100)+1
|
||
|
|
..I PFNODE4D'="" D
|
||
|
|
...I +($P(PFNODE4D,"^",1))'=+$P(PFNODE4,"^",1) D
|
||
|
|
....S ^TMP("PRPF_DIAGX",$J,PFSTAID,47,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="TRANSACTION REC^Transaction record missing, blank or ID invalid (Transaction ID does not match IEN)^"_$P(PFNODE4,"^",1)
|
||
|
|
....S CNTERR(47)=CNTERR(47)+1
|
||
|
|
....S CNTERR(100)=CNTERR(100)+1
|
||
|
|
...I $P(PFNODE4D,"^",2)'=PRPFHLD1 D
|
||
|
|
....S ^TMP("PRPF_DIAGX",$J,PFSTAID,48,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PATIENT NAME^Patient name does not match transaction^"_$P(PFNODE4D,"^",2)
|
||
|
|
....S CNTERR(48)=CNTERR(48)+1
|
||
|
|
....S CNTERR(100)=CNTERR(100)+1
|
||
|
|
...S PFNODE4X=$P(PFNODE4D,"^",3)
|
||
|
|
...I +PFNODE4X'=PFNODE4X!(PFNODE4X>99999)!(PFNODE4X<1) D
|
||
|
|
....S ^TMP("PRPF_DIAGX",$J,PFSTAID,49,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PATIENT TRANSACTION #^Patient transaction # invalid^"_$P(PFNODE4D,"^",3)
|
||
|
|
....S CNTERR(49)=CNTERR(49)+1
|
||
|
|
....S CNTERR(100)=CNTERR(100)+1
|
||
|
|
...S PFNODE4X=$P(PFNODE4D,"^",4)
|
||
|
|
...I PFNODE4X=""!(+PFNODE4X'=PFNODE4X)&(PFNODE4X'?.N1".".N)!(PFNODE4X>99999)!(PFNODE4X<.01) D
|
||
|
|
....S ^TMP("PRPF_DIAGX",$J,PFSTAID,50,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="AMOUNT^Deferred amount invalid^"_$P(PFNODE4D,"^",4)
|
||
|
|
....S CNTERR(50)=CNTERR(50)+1
|
||
|
|
....S CNTERR(100)=CNTERR(100)+1
|
||
|
|
...S PFTDT=$P(PFNODE4D,"^",5)
|
||
|
|
...S PRPFBADD=""
|
||
|
|
...D DT^DILF("X",PFTDT,.PRPFBADD)
|
||
|
|
...I $L(+PFTDT)'=7!(PRPFBADD=-1)!(PRPFBADD="") D
|
||
|
|
....S ^TMP("PRPF_DIAGX",$J,PFSTAID,51,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="TRANSACTION DATE^Transaction date Invalid^"_$P(PFNODE4D,"^",5)
|
||
|
|
....S CNTERR(51)=CNTERR(51)+1
|
||
|
|
....S CNTERR(100)=CNTERR(100)+1
|
||
|
|
...S PFTDTE=$P(PFNODE4D,"^",6)
|
||
|
|
...S PRPFBADD=""
|
||
|
|
...D DT^DILF("X",PFTDTE,.PRPFBADD)
|
||
|
|
...I $L(+PFTDTE)'=7!(PRPFBADD=-1)!(PRPFBADD="") D
|
||
|
|
....S ^TMP("PRPF_DIAGX",$J,PFSTAID,52,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="DATE TRANSACTION ENTERED^Date transaction entered Invalid^"_$P(PFNODE4D,"^",6)
|
||
|
|
....S CNTERR(52)=CNTERR(52)+1
|
||
|
|
....S CNTERR(100)=CNTERR(100)+1
|
||
|
|
...S PFNODE4X=$P(PFNODE4D,"^",7)
|
||
|
|
...I $L(PFNODE4X)>10!($L(PFNODE4X)<1) D
|
||
|
|
....S ^TMP("PRPF_DIAGX",$J,PFSTAID,53,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="REFERENCE^Reference Invalid < 1 or > 10 in length^"_$P(PFNODE4D,"^",7)
|
||
|
|
....S CNTERR(53)=CNTERR(53)+1
|
||
|
|
....S CNTERR(100)=CNTERR(100)+1
|
||
|
|
...S PFNODE4X=$P(PFNODE4D,"^",8)
|
||
|
|
...I PFNODE4X'["D"&(PFNODE4X'["W") D
|
||
|
|
....S ^TMP("PRPF_DIAGX",$J,PFSTAID,54,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="DEPOSIT/WITHDRAWAL^Deposit/Withdrawal status Invalid^"_$P(PFNODE4D,"^",8)
|
||
|
|
....S CNTERR(54)=CNTERR(54)+1
|
||
|
|
....S CNTERR(100)=CNTERR(100)+1
|
||
|
|
...S PFNODE4X=$P(PFNODE4D,"^",9)
|
||
|
|
...I PFNODE4X'["1"&(PFNODE4X'["2")&(PFNODE4X'["3") D
|
||
|
|
....S ^TMP("PRPF_DIAGX",$J,PFSTAID,55,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="CASH/CHECK/OTHER^Cash/Check/Other status Invalid^"_$P(PFNODE4D,"^",9)
|
||
|
|
....S CNTERR(55)=CNTERR(55)+1
|
||
|
|
....S CNTERR(100)=CNTERR(100)+1
|
||
|
|
...S PFNODE4X=$P(PFNODE4D,"^",10)
|
||
|
|
...I PFNODE4X'["P"&(PFNODE4X'["G")&(PFNODE4X'="B") D
|
||
|
|
....S ^TMP("PRPF_DIAGX",$J,PFSTAID,56,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="SOURCE^Transaction source invalid^"_$P(PFNODE4D,"^",10)
|
||
|
|
....S CNTERR(56)=CNTERR(56)+1
|
||
|
|
....S CNTERR(100)=CNTERR(100)+1
|
||
|
|
...I $P(PFNODE4D,"^",11)="" D
|
||
|
|
....S ^TMP("PRPF_DIAGX",$J,PFSTAID,57,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="FORM^Form does not match^"_$P(PFNODE4D,"^",11)
|
||
|
|
....S CNTERR(57)=CNTERR(57)+1
|
||
|
|
....S CNTERR(100)=CNTERR(100)+1
|
||
|
|
...I $P(PFNODE4D,"^",11)'="" D
|
||
|
|
....I '$D(^PRPF(470.2,$P(PFNODE4D,"^",11),0)) D
|
||
|
|
.....S ^TMP("PRPF_DIAGX",$J,PFSTAID,57,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="FORM^Form does not match^"_$P(PFNODE4D,"^",11)
|
||
|
|
.....S CNTERR(57)=CNTERR(57)+1
|
||
|
|
.....S CNTERR(100)=CNTERR(100)+1
|
||
|
|
...S PFNODE4X=$P(PFNODE4D,"^",12)
|
||
|
|
...I PFNODE4X'="" I +PFNODE4X'=PFNODE4X&(PFNODE4X'?.N1".".N)!(PFNODE4X>99999)!(PFNODE4X<.01) D
|
||
|
|
....S ^TMP("PRPF_DIAGX",$J,PFSTAID,58,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PRIVATE SOURCE AMT^Pvt src amt invalid or < 0 or > 99999^"_$P(PFNODE4D,"^",12)
|
||
|
|
....S CNTERR(58)=CNTERR(58)+1
|
||
|
|
....S CNTERR(100)=CNTERR(100)+1
|
||
|
|
...S PFNODE4X=$P(PFNODE4D,"^",13)
|
||
|
|
...I PFNODE4X'="" I +PFNODE4X'=PFNODE4X&(PFNODE4X'?.N1".".N)!(PFNODE4X>99999)!(PFNODE4X<.01) D
|
||
|
|
....S ^TMP("PRPF_DIAGX",$J,PFSTAID,59,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="GRATUITOUS AMOUNT^Gratuitous amt invalid or < 0 or > 99999^"_$P(PFNODE4D,"^",13)
|
||
|
|
....S CNTERR(59)=CNTERR(59)+1
|
||
|
|
....S CNTERR(100)=CNTERR(100)+1
|
||
|
|
...S PFNODE4X=$P(PFNODE4D,"^",14)
|
||
|
|
...I PFNODE4X'="" D
|
||
|
|
....I '$D(^VA(200,PFNODE4X,0))!($L($P($G(^VA(200,PFNODE4X,0)),"^",1))<3!($L($P($G(^VA(200,PFNODE4X,0)),"^",1))>35)) D
|
||
|
|
.....S ^TMP("PRPF_DIAGX",$J,PFSTAID,60,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PATIENT FUNDS CLERK^Pfunds clerk invalid^"_$P($G(^VA(200,PFNODE4X,0)),"^",1)
|
||
|
|
.....S CNTERR(60)=CNTERR(60)+1
|
||
|
|
.....S CNTERR(100)=CNTERR(100)+1
|
||
|
|
...I PFNODE4X="" D
|
||
|
|
....S ^TMP("PRPF_DIAGX",$J,PFSTAID,60,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PATIENT FUNDS CLERK^Pfunds clerk invalid^"_""
|
||
|
|
....S CNTERR(60)=CNTERR(60)+1
|
||
|
|
....S CNTERR(100)=CNTERR(100)+1
|
||
|
|
.S PRPFDEFR=PRPFDEFR+1
|
||
|
|
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 PFSUSDT=$P(PFNODE5,"^",1)
|
||
|
|
.I PFSUSDT="" D
|
||
|
|
..S ^TMP("PRPF_DIAGX",$J,PFSTAID,43.1,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2)="SUSPENSE DATE^Suspense date is blank^"_PFSUSDT
|
||
|
|
..S CNTERR(43)=CNTERR(43)+1
|
||
|
|
..S CNTERR(100)=CNTERR(100)+1
|
||
|
|
.ELSE D
|
||
|
|
..K PRPFBADD
|
||
|
|
..D DT^DILF("X",PFSUSDT,.PRPFBADD)
|
||
|
|
..I $L(+PFSUSDT)'=7!(PRPFBADD=-1) D
|
||
|
|
...S ^TMP("PRPF_DIAGX",$J,PFSTAID,43.2,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2)="SUSPENSE DATE^Suspense date is not valid^"_PFSUSDT
|
||
|
|
...S CNTERR(43)=CNTERR(43)+1
|
||
|
|
...S CNTERR(100)=CNTERR(100)+1
|
||
|
|
.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 PFSUSID=PFNODE51
|
||
|
|
..I PFSUSID="" D
|
||
|
|
...S ^TMP("PRPF_DIAGX",$J,PFSTAID,44.1,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2_"_Item#"_PRPFHLD3)="SUSPENSE ID^Suspense ID is blank^"_PFSUSID
|
||
|
|
...S CNTERR(44)=CNTERR(44)+1
|
||
|
|
...S CNTERR(100)=CNTERR(100)+1
|
||
|
|
..I PFSUSID'="" I $L(PFSUSID)<1!($L(PFSUSID)>40) D
|
||
|
|
...S ^TMP("PRPF_DIAGX",$J,PFSTAID,44.2,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2_"_Item#"_PRPFHLD3)="SUSPENSE ID^Suspense ID < 1 or > 40 characters^"_PFSUSID
|
||
|
|
...S CNTERR(44)=CNTERR(44)+1
|
||
|
|
...S CNTERR(100)=CNTERR(100)+1
|
||
|
|
..S PFSUSTXT=""
|
||
|
|
..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))
|
||
|
|
...S PFSUSTXT=PFSUSTXT_PFNODE52
|
||
|
|
..I PFSUSTXT="" D
|
||
|
|
...S ^TMP("PRPF_DIAGX",$J,PFSTAID,45.1,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2_"_Item#"_PRPFHLD3)="SUSPENSE DESC^Suspense description is blank^"_PFSUSTXT
|
||
|
|
...S CNTERR(45)=CNTERR(45)+1
|
||
|
|
...S CNTERR(100)=CNTERR(100)+1
|
||
|
|
..I PFSUSTXT'="" I $L(PFSUSTXT)<1!($L(PFSUSTXT)>255) D
|
||
|
|
...S ^TMP("PRPF_DIAGX",$J,PFSTAID,45.2,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2_"_Item#"_PRPFHLD3)="SUSPENSE DESC^Suspense description < 1 or > 255 characters^"_"SUSPENSE ID="_PFSUSID_", DESCRIPTION LENGTH="_$L(PFSUSTXT)
|
||
|
|
...S CNTERR(45)=CNTERR(45)+1
|
||
|
|
...S CNTERR(100)=CNTERR(100)+1
|
||
|
|
..S PRPFHLD4=0
|
||
|
|
.S PRPFHLD3=0
|
||
|
|
Q
|
||
|
|
NODE12 I $G(^PRPF(470,PRPFHLD1,12))'="" D
|
||
|
|
.I '$D(^DIC(4,^PRPF(470,PRPFHLD1,12),99))!(PFSTAID="ERRBADID")!(PFSTAID="ERRBADID1") D
|
||
|
|
..S ^TMP("PRPF_DIAGX",$J,PFSTAID,42,PFNAME_"_"_PRPFHLD1)="STATIONID^STATION ID INVALID^"_PFSTAID
|
||
|
|
..S CNTERR(42)=CNTERR(42)+1
|
||
|
|
..S CNTERR(100)=CNTERR(100)+1
|
||
|
|
S:$G(^PRPF(470,PRPFHLD1,12))="" PFSTAID="UNASSIGNED"
|
||
|
|
NODE12X I PFSTAID=""!(PFSTAID="UNASSIGNED")!(PFSTAID="ERRNOID")!(PFSTAID="ERRNOID1") D
|
||
|
|
.S:PFSTAID="" PFSTAID="UNASSIGNED"
|
||
|
|
.S CNTERR(41)=CNTERR(41)+1
|
||
|
|
.S CNTERR(100)=CNTERR(100)+1
|
||
|
|
Q
|