©2011-2018 Open Source Electronic Health Record Alliance
This work is licensed under a Creative Commons Attribution 3.0 Unported License
This work is licensed under a Creative Commons Attribution 3.0 Unported License
- A4A7161 ; GLRISC/REL - New Person File conversion ;5/4/89 14:27 ;
- ;;1.01
- S U="^" W !!,"*** WARNING! *** This program will take all File 16 entries"
- W !,"and add them to the New Person File. This conversion REQUIRES"
- W !,"that the prior A5A5 File 3-16 linkage programs have been run."
- D DT^DICRW S (NUM200,LAST200,PTR,TOT)=0
- W !,"A VERIFY run will perform the same checks as the UPDATE run"
- W !,"except that no entries are moved to the New Person file"
- W !,"nor are any persons in File 16 added to File 3."
- W !!,"You should run VERIFY first. Correct as many errors as"
- W !,"possible and then make an UPDATE run which will move"
- W !,"entries into the New Person File. The final step is the"
- W !,"initialization of the files using A4A7INIT and re-indexing File 200."
- P0 R !!,"Verify or Update run? VER// ",VER:DTIME Q:'$T!(VER["^") S:VER="" VER="V" I $P("VERIFY",VER,1)'="",$P("UPDATE",VER,1)'="" W *7," Enter V or U" G P0
- S VER=$E(VER,1)
- P1 W !!,"Pass 1 will be made through File 3 to make sure"
- W !,"that the 3-16 pointer has a 16-3 back-pointer."
- W !!,"Beginning Pass 1...",!
- F K=.9:0 S K=$N(^DIC(3,K)) Q:K<1 D A1
- I TOT,(PTR/TOT)>.7999 G P2
- W *7,!!,"***** Less than 80% of your File 3 entries have pointers"
- W !,"to File 16. It appears that your A5A5 initialization was"
- W !,"never performed or was incomplete. We cannot continue with"
- W !,"this ",$S(VER="V":"verification",1:"update")," until the A5A5 updating is complete.",! Q
- P2 W !!,"During Pass 2 the File 16 pointer to File 3 will be checked"
- W !,"as well as the File 3 to 16 back-pointer."
- W !!,"Two possible error conditions may occur: the name in File 3"
- W !,"may not match that in 16. Most likely this is the result of"
- W !,"a typing error. A list of such mis-matches will be produced."
- W !!,"A second condition is if more than one entry in File 16"
- W !,"points to the same File 3 entry. Such cases are also listed.",!
- I VER="U" W !,"File 200 entries will be created during this pass.",!,"If the File 3 name differs from that in 16, the File 3 name is used.",!
- W !!,"Beginning Pass 2...",!
- S (ERR1,ERR2)=0 K ^UTILITY($J)
- F K=.9:0 S K=$N(^DIC(16,K)) Q:K<1 I $D(^DIC(16,K,"A3"))#2 D A2
- D:ERR2 A22 K ^UTILITY($J)
- G ^A4A7162
- A1 S P16=$S($D(^DIC(3,K,0))#2:$P(^(0),"^",16),1:""),TOT=TOT+1 Q:P16<1
- S P3=$S($D(^DIC(16,P16,"A3"))#2:^("A3"),1:""),PTR=PTR+1
- Q:P3=K I P3>0 S $P(^DIC(3,K,0),"^",16)="" Q
- I $D(^DIC(16,P16,0))#2 S ^DIC(16,P16,"A3")=K Q
- S $P(^DIC(3,K,0),"^",16)="" Q
- A2 S X0=$S($D(^DIC(16,K,0))#2:^(0),1:""),P3=+^("A3") I P3<1 K ^DIC(16,K,"A3") Q
- S X3=$S($D(^DIC(3,P3,0))#2:^(0),1:"") I X3="" K ^DIC(16,K,"A3") Q
- S P16=$P(X3,"^",16) I P16="" S $P(^DIC(3,P3,0),"^",16)=K,P16=K
- S NAM3=$P(X3,"^",1),NAM16=$P(X0,"^",1),SSN=$P(X0,"^",9)
- I $D(^UTILITY($J,P3)) S ^UTILITY($J,"E2",P3)=K,ERR2=ERR2+1 Q
- G:NAM3=NAM16 A21
- I 'ERR1 W !!?18,"File 3 - File 16 Name Mis-Matches",!,"File 3 #",?12,"File 3 Name",?45,"File 16 #",?57,"File 16 Name",!
- S ERR1=ERR1+1 W !,+P3,?12,NAM3,?45,K,?57,NAM16
- A21 S ^UTILITY($J,P3)=K I VER="U" D ADD200
- Q
- A22 W !!?8,"File 3 Entries pointed to by More than 1 File 16 Entry"
- W !,"File 3 #",?12,"File 3 Name",?45,"File 16 #",?57,"File 16 Name",!
- F P3=0:0 S P3=$N(^UTILITY($J,"E2",P3)) Q:P3<1 S K2=^(P3) D A23
- Q
- A23 S K1=^UTILITY($J,P3),NAM3=$S($D(^DIC(3,P3,0))#2:$P(^(0),"^",1),1:"")
- W !!,P3,?12,NAM3,?45,K1,?57,$S($D(^DIC(16,K1,0))#2:$P(^(0),"^",1),1:"")
- W !?45,K2,?57,$S($D(^DIC(16,K2,0))#2:$P(^(0),"^",1),1:"") Q
- ADD200 Q:$D(^VA(200,P3)) Q:NAM3="" S NUM200=NUM200+1,LAST200=P3
- AD1 I NAM3[", " S NAM3=$P(NAM3,", ",1)_","_$P(NAM3,", ",2,99) G AD1
- S ^VA(200,P3,0)=NAM3
- S:SSN'="" $P(^VA(200,P3,1),"^",9)=SSN Q