FBXIP33 ;WCIOFO/MJE-IMPORT GPCI/ZIP CODE DATA ;9/18/2001
;;3.5;FEE BASIS;**33**;JAN 30, 1995
Q
;
PS ; post-install entry point
; create KIDS checkpoints with call backs
N FBX,Y
F FBX="LOAD" D
.S Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP33")
.I 'Y D BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
N FBX,Y
F FBX="LOADA" D
.S Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP33A")
.I 'Y D BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
N FBX,Y
F FBX="MRGDOL" D
.S Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP33B")
.I 'Y D BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
Q
;
;
LOAD ; Load data into 162.96 using included DATA as source
N FBI,FBY,X,ZIP
D BMES^XPDUTL("--Updating file 162.96")
F FBI=1:1 S FBY=$P($T(DATA+FBI),";;",2) Q:FBY="END" D
. S ZIP=$P(FBY,U)
. S Y=$O(^FB(162.96,"B",ZIP,0))
. I 'Y D Q:Y'>0
. . K DA,DIC
. . S DIC="^FB(162.96,",DLAYGO=162.96,DIC(0)="L",X=ZIP
. . K DD,DO D FILE^DICN I Y'>0 D BMES^XPDUTL("ERROR ADDING NEW ZIP "_ZIP)
. . K DIC,DLAYGO
. ;
. K DA,DIC
. S DA(1)=+Y
. S Y=$O(^FB(162.96,DA(1),"CY","B",2001,0))
. I 'Y D Q:Y'>0
. . S DIC="^FB(162.96,"_DA(1)_",""CY"",",DIC(0)="L",DIC("P")="162.961A"
. . S X=2001
. . K DD,DO D FILE^DICN I Y'>0 D BMES^XPDUTL("ERROR ADDING 2001 for "_ZIP)
. . K DIC,DLAYGO
. S DA=+Y
. ;
. S DIE="^FB(162.96,"_DA(1)_",""CY"","
. S DR=".02///"_$P(FBY,U,2)_";.03///"_$P(FBY,U,3)_";.04///"_$P(FBY,U,4)
. D ^DIE K DIE,DR,DA
;
D BMES^XPDUTL("---Update of file 162.96 complete")
Q
;
DATA ;This is the ZIP and GPCI data ZIP^GPCI1^GCPI2^GPCI3
;;12062^1.01^1.079^1.3
;;15295^0.989^0.93^0.705
;;18202^0.989^0.93^0.705
;;19415^1.023^1.09^1.31
;;19505^1.023^1.09^1.31
;;22107^1.05^1.164^0.97
;;22108^1.05^1.164^0.97
;;23114^0.985^0.939^0.529
;;27205^0.97^0.927^0.546
;;27332^0.97^0.927^0.546
;;27517^0.97^0.927^0.546
;;27537^0.97^0.927^0.546
;;28271^0.97^0.927^0.546
;;30156^1.006^1.046^0.943
;;30160^1.006^1.046^0.943
;;31059^0.97^0.896^0.943
;;32128^0.975^0.947^1.296
;;32162^0.975^0.947^1.296
;;33508^0.975^0.947^1.296
;;33558^0.975^0.947^1.296
;;33559^0.975^0.947^1.296
;;33896^0.975^0.947^1.296
;;33897^0.975^0.947^1.296
;;33898^0.975^0.947^1.296
;;34211^0.975^0.947^1.296
;;34212^0.975^0.947^1.296
;;34269^0.975^0.947^1.296
;;34288^0.975^0.947^1.296
;;34289^0.975^0.947^1.296
;;38016^0.975^0.9^0.572
;;38571^0.975^0.9^0.572
;;38572^0.975^0.9^0.572
;;39540^0.957^0.841^0.75
;;45280^0.989^0.941^1.016
;;48085^1.042^1.03^2.903
;;48088^1.042^1.03^2.903
;;60103^1.006^1.069^1.505
;;60133^1.027^1.09^1.745
;;60527^1.006^1.069^1.505
;;60696^1.027^1.09^1.745
;;61616^0.964^0.888^1.074
;;63041^0.946^0.826^0.979
;;63190^0.994^0.94^1.022
;;75071^0.966^0.884^0.914
;;75098^0.966^0.884^0.914
;;75109^0.966^0.884^0.914
;;75252^0.966^0.884^0.914
;;75254^1.01^1.04^0.93
;;75287^0.966^0.884^0.914
;;75645^0.966^0.884^0.914
;;75752^0.966^0.884^0.914
;;75803^0.966^0.884^0.914
;;75965^0.966^0.884^0.914
;;77053^0.966^0.884^0.914
;;77615^0.966^0.884^0.914
;;78641^0.986^0.998^0.854
;;78737^0.966^0.884^0.914
;;80285^0.986^0.981^0.817
;;84194^0.977^0.925^0.619
;;84195^0.977^0.925^0.619
;;85042^0.994^0.975^1.15
;;85218^0.994^0.975^1.15
;;85297^0.994^0.975^1.15
;;85383^0.994^0.975^1.15
;;87507^0.973^0.905^0.809
;;87508^0.973^0.905^0.809
;;89074^1.005^1.035^1.103
;;89084^1.005^1.035^1.103
;;89086^1.005^1.035^1.103
;;91387^1.055^1.169^0.901
;;91390^1.055^1.169^0.901
;;92637^1.036^1.187^0.901
;;92809^1.036^1.187^0.901
;;94303^1.062^1.321^0.653
;;95033^1.007^1.039^0.723
;;98082^0.982^0.974^0.765
;;00727^0.882^0.72^0.317
;;03258^0.987^1.032^0.919
;;07086^1.057^1.192^0.827
;;08205^1.028^1.102^0.827
;;END
;
;FBXIP33
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXIP33 3788 printed Sep 23, 2025@19:37:46 Page 2
FBXIP33 ;WCIOFO/MJE-IMPORT GPCI/ZIP CODE DATA ;9/18/2001
+1 ;;3.5;FEE BASIS;**33**;JAN 30, 1995
+2 QUIT
+3 ;
PS ; post-install entry point
+1 ; create KIDS checkpoints with call backs
+2 NEW FBX,Y
+3 FOR FBX="LOAD"
Begin DoDot:1
+4 SET Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP33")
+5 IF 'Y
DO BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
End DoDot:1
+6 NEW FBX,Y
+7 FOR FBX="LOADA"
Begin DoDot:1
+8 SET Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP33A")
+9 IF 'Y
DO BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
End DoDot:1
+10 NEW FBX,Y
+11 FOR FBX="MRGDOL"
Begin DoDot:1
+12 SET Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP33B")
+13 IF 'Y
DO BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
End DoDot:1
+14 QUIT
+15 ;
+16 ;
LOAD ; Load data into 162.96 using included DATA as source
+1 NEW FBI,FBY,X,ZIP
+2 DO BMES^XPDUTL("--Updating file 162.96")
+3 FOR FBI=1:1
SET FBY=$PIECE($TEXT(DATA+FBI),";;",2)
if FBY="END"
QUIT
Begin DoDot:1
+4 SET ZIP=$PIECE(FBY,U)
+5 SET Y=$ORDER(^FB(162.96,"B",ZIP,0))
+6 IF 'Y
Begin DoDot:2
+7 KILL DA,DIC
+8 SET DIC="^FB(162.96,"
SET DLAYGO=162.96
SET DIC(0)="L"
SET X=ZIP
+9 KILL DD,DO
DO FILE^DICN
IF Y'>0
DO BMES^XPDUTL("ERROR ADDING NEW ZIP "_ZIP)
+10 KILL DIC,DLAYGO
End DoDot:2
if Y'>0
QUIT
+11 ;
+12 KILL DA,DIC
+13 SET DA(1)=+Y
+14 SET Y=$ORDER(^FB(162.96,DA(1),"CY","B",2001,0))
+15 IF 'Y
Begin DoDot:2
+16 SET DIC="^FB(162.96,"_DA(1)_",""CY"","
SET DIC(0)="L"
SET DIC("P")="162.961A"
+17 SET X=2001
+18 KILL DD,DO
DO FILE^DICN
IF Y'>0
DO BMES^XPDUTL("ERROR ADDING 2001 for "_ZIP)
+19 KILL DIC,DLAYGO
End DoDot:2
if Y'>0
QUIT
+20 SET DA=+Y
+21 ;
+22 SET DIE="^FB(162.96,"_DA(1)_",""CY"","
+23 SET DR=".02///"_$PIECE(FBY,U,2)_";.03///"_$PIECE(FBY,U,3)_";.04///"_$PIECE(FBY,U,4)
+24 DO ^DIE
KILL DIE,DR,DA
End DoDot:1
+25 ;
+26 DO BMES^XPDUTL("---Update of file 162.96 complete")
+27 QUIT
+28 ;
DATA ;This is the ZIP and GPCI data ZIP^GPCI1^GCPI2^GPCI3
+1 ;;12062^1.01^1.079^1.3
+2 ;;15295^0.989^0.93^0.705
+3 ;;18202^0.989^0.93^0.705
+4 ;;19415^1.023^1.09^1.31
+5 ;;19505^1.023^1.09^1.31
+6 ;;22107^1.05^1.164^0.97
+7 ;;22108^1.05^1.164^0.97
+8 ;;23114^0.985^0.939^0.529
+9 ;;27205^0.97^0.927^0.546
+10 ;;27332^0.97^0.927^0.546
+11 ;;27517^0.97^0.927^0.546
+12 ;;27537^0.97^0.927^0.546
+13 ;;28271^0.97^0.927^0.546
+14 ;;30156^1.006^1.046^0.943
+15 ;;30160^1.006^1.046^0.943
+16 ;;31059^0.97^0.896^0.943
+17 ;;32128^0.975^0.947^1.296
+18 ;;32162^0.975^0.947^1.296
+19 ;;33508^0.975^0.947^1.296
+20 ;;33558^0.975^0.947^1.296
+21 ;;33559^0.975^0.947^1.296
+22 ;;33896^0.975^0.947^1.296
+23 ;;33897^0.975^0.947^1.296
+24 ;;33898^0.975^0.947^1.296
+25 ;;34211^0.975^0.947^1.296
+26 ;;34212^0.975^0.947^1.296
+27 ;;34269^0.975^0.947^1.296
+28 ;;34288^0.975^0.947^1.296
+29 ;;34289^0.975^0.947^1.296
+30 ;;38016^0.975^0.9^0.572
+31 ;;38571^0.975^0.9^0.572
+32 ;;38572^0.975^0.9^0.572
+33 ;;39540^0.957^0.841^0.75
+34 ;;45280^0.989^0.941^1.016
+35 ;;48085^1.042^1.03^2.903
+36 ;;48088^1.042^1.03^2.903
+37 ;;60103^1.006^1.069^1.505
+38 ;;60133^1.027^1.09^1.745
+39 ;;60527^1.006^1.069^1.505
+40 ;;60696^1.027^1.09^1.745
+41 ;;61616^0.964^0.888^1.074
+42 ;;63041^0.946^0.826^0.979
+43 ;;63190^0.994^0.94^1.022
+44 ;;75071^0.966^0.884^0.914
+45 ;;75098^0.966^0.884^0.914
+46 ;;75109^0.966^0.884^0.914
+47 ;;75252^0.966^0.884^0.914
+48 ;;75254^1.01^1.04^0.93
+49 ;;75287^0.966^0.884^0.914
+50 ;;75645^0.966^0.884^0.914
+51 ;;75752^0.966^0.884^0.914
+52 ;;75803^0.966^0.884^0.914
+53 ;;75965^0.966^0.884^0.914
+54 ;;77053^0.966^0.884^0.914
+55 ;;77615^0.966^0.884^0.914
+56 ;;78641^0.986^0.998^0.854
+57 ;;78737^0.966^0.884^0.914
+58 ;;80285^0.986^0.981^0.817
+59 ;;84194^0.977^0.925^0.619
+60 ;;84195^0.977^0.925^0.619
+61 ;;85042^0.994^0.975^1.15
+62 ;;85218^0.994^0.975^1.15
+63 ;;85297^0.994^0.975^1.15
+64 ;;85383^0.994^0.975^1.15
+65 ;;87507^0.973^0.905^0.809
+66 ;;87508^0.973^0.905^0.809
+67 ;;89074^1.005^1.035^1.103
+68 ;;89084^1.005^1.035^1.103
+69 ;;89086^1.005^1.035^1.103
+70 ;;91387^1.055^1.169^0.901
+71 ;;91390^1.055^1.169^0.901
+72 ;;92637^1.036^1.187^0.901
+73 ;;92809^1.036^1.187^0.901
+74 ;;94303^1.062^1.321^0.653
+75 ;;95033^1.007^1.039^0.723
+76 ;;98082^0.982^0.974^0.765
+77 ;;00727^0.882^0.72^0.317
+78 ;;03258^0.987^1.032^0.919
+79 ;;07086^1.057^1.192^0.827
+80 ;;08205^1.028^1.102^0.827
+81 ;;END
+82 ;
+83 ;FBXIP33
