Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRPFDR4

PRPFDR4.m

Go to the documentation of this file. 
  1. PRPFDR4 ;BAYPINES/MJE  VPFS DATA MIGRATION ROUTINE 4 ;05/15/03
  1.  ;;3.0;PATIENT FUNDS DIAG V5.9;**15**;JUNE 1, 1989
  1.  ;BAD ENTRY POINT
  1.  Q
  1. NODE1 S PFNODE1=$G(^PRPF(470,PRPFHLD1,1))
  1.  S PFSTDBAL=$P(PFNODE1,"^",4)
  1.  I PFSTDBAL>0 S CNTBAL=CNTBAL+PFSTDBAL
  1.  I PFSTDBAL'="" I PFSTDBAL<0!(PFSTDBAL>99999)!((PFSTDBAL'=+PFSTDBAL)&(PFSTDBAL'?.N1".".N)) D
  1.  .S ^TMP("PRPF_DIAGX",$J,PFSTAID,27,PFNAME_"_"_PRPFHLD1)="STORED BALANCE^Stored balance invalid or out of range either < $0 or > $99,999^"_PFSTDBAL
  1.  .S CNTERR(27)=CNTERR(27)+1
  1.  .S CNTERR(100)=CNTERR(100)+1
  1.  S PFSTDPVT=$P(PFNODE1,"^",5)
  1.  I PFSTDPVT'="" I PFSTDPVT<0!(PFSTDPVT>99999)!((PFSTDPVT'=+PFSTDPVT)&(PFSTDPVT'?.N1".".N)) D
  1.  .S ^TMP("PRPF_DIAGX",$J,PFSTAID,28,PFNAME_"_"_PRPFHLD1)="STORED PRIVATE SOURCE^Stored private invalid or out of range either < $0 or > $99,999^"_PFSTDPVT
  1.  .S CNTERR(28)=CNTERR(28)+1
  1.  .S CNTERR(100)=CNTERR(100)+1
  1.  S PFSTDGRT=$P(PFNODE1,"^",6)
  1.  I PFSTDGRT'="" I PFSTDGRT<0!(PFSTDGRT>99999)!((PFSTDGRT'=+PFSTDGRT)&(PFSTDGRT'?.N1".".N)) D
  1.  .S ^TMP("PRPF_DIAGX",$J,PFSTAID,29,PFNAME_"_"_PRPFHLD1)="STORED GRATUITOUS^Stored gratuitous invalid or out of range either < $0 or > $99,999^"_PFSTDGRT
  1.  .S CNTERR(29)=CNTERR(29)+1
  1.  .S CNTERR(100)=CNTERR(100)+1
  1.  S PFARPM=$P(PFNODE1,"^",7)
  1.  I PFARPM'="" I PFARPM<0!(PFARPM>99999)!((PFARPM'=+PFARPM)&(PFARPM'?.N1".".N)) D
  1.  .S ^TMP("PRPF_DIAGX",$J,PFSTAID,30,PFNAME_"_"_PRPFHLD1)="RESTRICTED AMOUNT^Restricted monthly amount invalid or < $0 or > $99,999^"_PFARPM
  1.  .S CNTERR(30)=CNTERR(30)+1
  1.  .S CNTERR(100)=CNTERR(100)+1
  1.  S PFARPW=$P(PFNODE1,"^",8)
  1.  I PFARPW'="" I PFARPW<0!(PFARPW>99999)!((PFARPW'=+PFARPW)&(PFARPW'?.N1".".N)) D
  1.  .S ^TMP("PRPF_DIAGX",$J,PFSTAID,31,PFNAME_"_"_PRPFHLD1)="RESTRICTED AMOUNT^Restricted weekly amount invalid or < $0 or > $99,999^"_PFARPW
  1.  .S CNTERR(31)=CNTERR(31)+1
  1.  .S CNTERR(100)=CNTERR(100)+1
  1.  I PFARPW'=""&(PFARPM'="") I PFARPM<(5*PFARPW) D
  1.  .S ^TMP("PRPF_DIAGX",$J,PFSTAID,32,PFNAME_"_"_PRPFHLD1)="RESTRCT AMT ER^Restrict Mnthly amount < (5X) weekly amt^"_PFARPM
  1.  .S CNTERR(32)=CNTERR(32)+1
  1.  .S CNTERR(100)=CNTERR(100)+1
  1.  I PFARPW'=""&(PFARPM'="") I PFARPM<PFARPW D
  1.  .S ^TMP("PRPF_DIAGX",$J,PFSTAID,33,PFNAME_"_"_PRPFHLD1)="RESTRCT AMT ER^Restrict Mnthly amount < weekly amt^"_PFARPM
  1.  .S CNTERR(33)=CNTERR(33)+1
  1.  .S CNTERR(100)=CNTERR(100)+1
  1.  Q
  1. NODE1X S ^TMP("PRPF_DIAGX",$J,PFSTAID,36,PFNAME_"_"_PRPFHLD1)="NO BALANCE REC^BALANCE RECORD DATA MISSING^"_PFNAME
  1.  S CNTERR(36)=CNTERR(36)+1
  1.  S CNTERR(100)=CNTERR(100)+1
  1.  Q
  1. NODE2 S PFNODE2=^PRPF(470,PRPFHLD1,2)
  1.  S PFMIN1=$P(PFNODE2,"^",1)
  1.  I PFMIN1'="" I PFMIN1<0!(PFMIN1>99999)!((PFMIN1'=+PFMIN1)&(PFMIN1'?.N1".".N)) D
  1.  .S ^TMP("PRPF_DIAGX",$J,PFSTAID,34,PFNAME_"_"_PRPFHLD1)="MINIMUM BALANCE #1^MIN balance invalid or out of range either < $0 or > $99,999^"_PFMIN1
  1.  .S CNTERR(34)=CNTERR(34)+1
  1.  .S CNTERR(100)=CNTERR(100)+1
  1.  S PFMAX1=$P(PFNODE2,"^",2)
  1.  I PFMAX1'="" I PFMAX1<0!(PFMAX1>99999)!((PFMAX1'=+PFMAX1)&(PFMAX1'?.N1".".N)) D
  1.  .S ^TMP("PRPF_DIAGX",$J,PFSTAID,35,PFNAME_"_"_PRPFHLD1)="MAXIMUM BALANCE #1^MAX balance invalid or out of range either < $0 or > $99,999^"_PFMAX1
  1.  .S CNTERR(35)=CNTERR(35)+1
  1.  .S CNTERR(100)=CNTERR(100)+1
  1.  Q
  1. NODE6 S PRPFHLD2=0
  1.  S (PFMCTR1,PFMCTR2,PFMCTR3)=1
  1.  S PFMCTR1=1
  1.  F  S PRPFHLD2=$O(^PRPF(470,PRPFHLD1,6,PRPFHLD2)) Q:'PRPFHLD2  D
  1.  .S PFNODE6=^PRPF(470,PRPFHLD1,6,PRPFHLD2,0)
  1.  .S PFINCPYE=$P(PFNODE6,"^",2)
  1.  .I PFINCPYE="" D
  1.  ..S ^TMP("PRPF_DIAGX",$J,PFSTAID,37,PFNAME_"_"_PRPFHLD1_"_"_"Inc#"_PRPFHLD2)="INCOME PAYEE^Income payee blank, Income source present^"_PFINCPYE
  1.  ..S PFMCTR1=PFMCTR1+1
  1.  ..S CNTERR(37)=CNTERR(37)+1
  1.  ..S CNTERR(100)=CNTERR(100)+1
  1.  .S PFINCOME=$P(PFNODE6,"^",3)
  1.  .I +PFINCOME'=PFINCOME&(PFINCOME'?.N1".".N) D
  1.  ..S ^TMP("PRPF_DIAGX",$J,PFSTAID,38,PFNAME_"_"_PRPFHLD1_"_"_"Inc#"_PRPFHLD2)="INCOME AMOUNT^Invalid income amount, Income source present^"_PFINCOME
  1.  ..S PFMCTR2=PFMCTR2+1
  1.  ..S CNTERR(38)=CNTERR(38)+1
  1.  ..S CNTERR(100)=CNTERR(100)+1
  1.  .I +PFINCOME=PFINCOME I PFINCOME<1!(PFINCOME>99999) D
  1.  ..S ^TMP("PRPF_DIAGX",$J,PFSTAID,39,PFNAME_"_"_PRPFHLD1_"_"_"Inc#"_PRPFHLD2)="INCOME AMOUNT^Income amount out of range either < $1 or > $99,999^"_PFINCOME
  1.  ..S CNTERR(39)=CNTERR(39)+1
  1.  ..S CNTERR(100)=CNTERR(100)+1
  1.  .S PFINCFRQ=$P(PFNODE6,"^",4)
  1.  .I PFINCFRQ="" D
  1.  ..S PRPFBC40=PRPFBC40+1
  1.  .I PFINCFRQ'["D"&(PFINCFRQ'["W")&(PFINCFRQ'["M")&(PFINCFRQ'["Y")&(PFINCFRQ'["X")&(PFINCFRQ'["V")&(PFINCFRQ'["O")&(PFINCFRQ'="") D
  1.  ..S ^TMP("PRPF_DIAGX",$J,PFSTAID,40,PFNAME_"_"_PRPFHLD1_"_"_"Inc#"_PRPFHLD2)="INCOME FREQUENCY^Income frequency not D,W,M,Y,X,V,O,Blank^"_PFINCFRQ
  1.  ..S PFMCTR3=PFMCTR3+1
  1.  ..S CNTERR(40)=CNTERR(40)+1
  1.  ..S CNTERR(100)=CNTERR(100)+1
  1.  Q
  1. KILLIT ;VARIABLES KILLED HERE
  1.  K CNTBAL,CNTERR,CNTREC,CNTRPSU,CNTSEG,CNTTOT,ND,PARAMS,PFADDR1,PFADDR2
  1.  K PFADDR3,PFAPPOR,PFARPM,PFARPW,PFAUTH,PFAUTHDT,PFAUTHRS,PFCITY,PFCLAIM,PFDOB
  1.  K PFG,PFGUARD,PFICNFLG,PFINCFRQ,PFINCOME,PFINCPYE,PFINDIG,PFINSAWD,PFMAX1,PFMCTR1
  1.  K PFMCTR2,PFMCTR3,PFMIN1,PFNAME,PFNAMEX,PFNODE0,PFNODE1,PFNODE2,PFNODE4,PFNODE4D
  1.  K PFNODE4X,PFNODE5,PFNODE51,PFNODE52,PFNODE6,PFNODE7,PFNODE8,PFOTRAST,PFPSTAT
  1.  K PFRGNID,PFSITE,PFSSN,PFSTAID,PFSTAT,PFSTATE,PFSTDBAL,PFSTDGRT,PFSTDPVT,PFSUSDT
  1.  K PFSUSID,PFSUSTXT,PFTDT,PFTDTE,PFTEMP,PFTYPE,PFWARD,PFX,PFY,PFZ,PFZIP,POP,PRPFBADD
  1.  K PRPFBBAL,PRPFBDMO,PRPFCNTR,PRPFDEFR,PRPFHLD1,PRPFHLD2,PRPFHLD3,PRPFHLD4,PRPFSEG
  1.  K X,XION
  1.  Q