[613] | 1 | XLFNP176 ;SFISC/MKO-FIX NEW PERSON NAMES ;3:16 PM 27 Oct 2000
|
---|
| 2 | ;;8.0;KERNEL;**176**;Jul 10, 1995
|
---|
| 3 | LIST ;; M D^ D D S^ PH D^ R N^ D P M^ D O^ P A^ N P^ C R N A^ L P N
|
---|
| 4 | Q
|
---|
| 5 | ;
|
---|
| 6 | FIX N XUFIX,DIRUT
|
---|
| 7 | D INTRO Q:$D(DIRUT)
|
---|
| 8 | S XUFIX=$$ASKFIX Q:$D(DIRUT)
|
---|
| 9 | D DEVSEL Q:$D(DIRUT)
|
---|
| 10 | U IO
|
---|
| 11 | ;
|
---|
| 12 | MAIN ;Loop through the New person file; entry point for queued jobs
|
---|
| 13 | N XUHLIN,XUIEN,XULIST,XUNAM,XUNEW,XUPAGE,XUPC,XUPROB,XUSUF
|
---|
| 14 | D INIT
|
---|
| 15 | S XULIST=$P($T(LIST),";;",2,999)
|
---|
| 16 | ;
|
---|
| 17 | S XUIEN=0 F S XUIEN=$O(^VA(200,XUIEN)) Q:'XUIEN D Q:$D(DIRUT)
|
---|
| 18 | . S XUNAM=$P($G(^VA(200,XUIEN,0)),U) Q:XUNAM=""
|
---|
| 19 | . F XUPC=1:1 S XUSUF=$P(XULIST,U,XUPC) Q:XUSUF="" D Q:$D(DIRUT)
|
---|
| 20 | .. Q:XUNAM'?@(".E1"""_XUSUF_"""")
|
---|
| 21 | .. S XUPROB=1
|
---|
| 22 | .. D BLDCOMP(XUNAM,XUSUF,.XUNEW)
|
---|
| 23 | .. D WRITE(XUIEN,XUNAM,.XUNEW) Q:$D(DIRUT)
|
---|
| 24 | .. D:XUFIX FILE(XUIEN,.XUNEW) Q:$D(DIRUT)
|
---|
| 25 | ;
|
---|
| 26 | W:'$G(XUPROB) !,"NO PROBLEMS FOUND",!
|
---|
| 27 | D END
|
---|
| 28 | Q
|
---|
| 29 | ;
|
---|
| 30 | BLDCOMP(XUNAM,XUSUF,XUNEW) ;Build new name components
|
---|
| 31 | K XUNEW
|
---|
| 32 | S XUNEW=$E(XUNAM,1,$L(XUNAM)-$L(XUSUF))
|
---|
| 33 | S XUSUF=$TR(XUSUF," ")
|
---|
| 34 | D NAMECOMP^XLFNAME(.XUNEW)
|
---|
| 35 | S XUNEW=XUNEW_" "_XUSUF
|
---|
| 36 | S XUNEW("SUFFIX")=$G(XUNEW("SUFFIX"))_$E(" ",$G(XUNEW("SUFFIX"))]"")_XUSUF
|
---|
| 37 | Q
|
---|
| 38 | ;
|
---|
| 39 | WRITE(XUIEN,XUNAM,XUNEW) ;Write info
|
---|
| 40 | D W() Q:$D(DIRUT)
|
---|
| 41 | D W("Entry #"_XUIEN) Q:$D(DIRUT)
|
---|
| 42 | D W("Old Name: "_XUNAM) Q:$D(DIRUT)
|
---|
| 43 | D W("New Name: "_XUNEW) Q:$D(DIRUT)
|
---|
| 44 | I $G(XUNEW("GIVEN"))]"" D W(" Given: "_XUNEW("GIVEN"),10) Q:$D(DIRUT)
|
---|
| 45 | I $G(XUNEW("MIDDLE"))]"" D W("Middle: "_XUNEW("MIDDLE"),10) Q:$D(DIRUT)
|
---|
| 46 | I $G(XUNEW("FAMILY"))]"" D W("Family: "_XUNEW("FAMILY"),10) Q:$D(DIRUT)
|
---|
| 47 | I $G(XUNEW("SUFFIX"))]"" D W("Suffix: "_XUNEW("SUFFIX"),10) Q:$D(DIRUT)
|
---|
| 48 | Q
|
---|
| 49 | ;
|
---|
| 50 | FILE(XUIEN,XUNEW) ;Correct Name
|
---|
| 51 | N DIERR,XUFDA,XUMSG,XUNC
|
---|
| 52 | ;
|
---|
| 53 | S XUNC=$P($G(^VA(200,XUIEN,3.1)),U)
|
---|
| 54 | I XUNC,$D(^VA(20,XUNC,0))#2,$P(^(0),U,1,3)="200^.01^"_XUIEN_"," D
|
---|
| 55 | . S XUFDA(20,XUNC_",",1)=$G(XUNEW("FAMILY"))
|
---|
| 56 | . S XUFDA(20,XUNC_",",2)=$G(XUNEW("GIVEN"))
|
---|
| 57 | . S XUFDA(20,XUNC_",",3)=$G(XUNEW("MIDDLE"))
|
---|
| 58 | . S XUFDA(20,XUNC_",",5)=$G(XUNEW("SUFFIX"))
|
---|
| 59 | . D FILE^DIE("","XUFDA","XUMSG")
|
---|
| 60 | ;
|
---|
| 61 | E D
|
---|
| 62 | . D W("** Unable to file new name **")
|
---|
| 63 | . D W(" There is no corresponding entry in the Name Components file.")
|
---|
| 64 | ;
|
---|
| 65 | I $G(DIERR) D
|
---|
| 66 | . N XUI,XUOUT
|
---|
| 67 | . D MSG^DIALOG("AE","XUOUT","",5,"XUMSG")
|
---|
| 68 | . D W("** Unable to file new name **") Q:$D(DIRUT)
|
---|
| 69 | . F XUI=1:1:XUOUT D W(XUOUT(XUI)) Q:$D(DIRUT)
|
---|
| 70 | Q
|
---|
| 71 | ;
|
---|
| 72 | W(XUSTR,XUTAB) ;Write XUSTR
|
---|
| 73 | I $Y+4>IOSL D EOP Q:$D(DIRUT)
|
---|
| 74 | W !?+$G(XUTAB),$G(XUSTR)
|
---|
| 75 | Q
|
---|
| 76 | ;
|
---|
| 77 | EOP ;End-of-page prompt/check
|
---|
| 78 | I $E(IOST,1,2)="C-" D Q:$D(DIRUT)
|
---|
| 79 | . N DIR,DIROUT,DTOUT,DUOUT,X,Y
|
---|
| 80 | . S DIR(0)="E" W ! D ^DIR
|
---|
| 81 | I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DIRUT)=1 Q
|
---|
| 82 | W @IOF
|
---|
| 83 | D HDR
|
---|
| 84 | Q
|
---|
| 85 | ;
|
---|
| 86 | HDR ;Print header
|
---|
| 87 | S ($X,$Y)=0
|
---|
| 88 | S XUPAGE=$G(XUPAGE)+1
|
---|
| 89 | I XUFIX W "NEW PERSON NAMES FIXED BY FIX^XLFNP176"
|
---|
| 90 | E W "HOW FIX^XLFNP176 WOULD FIX NEW PERSON NAMES"
|
---|
| 91 | W ?(IOM-$L(XUHLIN)-$L(XUPAGE)-1),XUHLIN_XUPAGE
|
---|
| 92 | W !,$TR($J("",IOM-1)," ","-")
|
---|
| 93 | Q
|
---|
| 94 | ;
|
---|
| 95 | ASKFIX() ;Ask whether to file corrected New Person name
|
---|
| 96 | N DIR,DIROUT,DTOUT,DUOUT,X,Y K DIRUT
|
---|
| 97 | S DIR(0)="SBA^R:Report Only;F:Fix Names"
|
---|
| 98 | S DIR("A")="Fix names or just print a Report (F/R)? "
|
---|
| 99 | S DIR("?",1)="Answer 'R' to print a report of names with a potential problems."
|
---|
| 100 | S DIR("?")="Answer 'F' to fix the names."
|
---|
| 101 | W ! D ^DIR
|
---|
| 102 | Q Y="F"
|
---|
| 103 | ;
|
---|
| 104 | DEVSEL ;Select device
|
---|
| 105 | N %ZIS,POP K DIRUT
|
---|
| 106 | S %ZIS=$S($D(^%ZTSK):"Q",1:"")
|
---|
| 107 | W ! D ^%ZIS
|
---|
| 108 | I $G(POP) S DIRUT=1 Q
|
---|
| 109 | ;
|
---|
| 110 | ;Queue report
|
---|
| 111 | I $D(IO("Q")),$D(^%ZTSK) D S DIRUT=1 Q
|
---|
| 112 | . N ZTSK
|
---|
| 113 | . S ZTRTN="MAIN^XLFNP176"
|
---|
| 114 | . S ZTDESC="Names in New Person file with spaces within a suffix."
|
---|
| 115 | . S ZTSAVE("XUFIX")=""
|
---|
| 116 | . D ^%ZTLOAD
|
---|
| 117 | . I $D(ZTSK)#2 W !,"Report queued!",!,"Task number: "_$G(ZTSK),!
|
---|
| 118 | . E W !,"Report canceled!",!
|
---|
| 119 | . S IOP="HOME" D ^%ZIS
|
---|
| 120 | Q
|
---|
| 121 | ;
|
---|
| 122 | INIT ;Setup
|
---|
| 123 | N %,%H,X,Y
|
---|
| 124 | S %H=$H D YX^%DTC
|
---|
| 125 | S XUHLIN=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2)_" PAGE "
|
---|
| 126 | W:$E(IOST,1,2)="C-" @IOF
|
---|
| 127 | D HDR
|
---|
| 128 | Q
|
---|
| 129 | ;
|
---|
| 130 | END ;Finish up
|
---|
| 131 | I $D(ZTQUEUED) S ZTREQ="@"
|
---|
| 132 | E N POP D ^%ZISC
|
---|
| 133 | Q
|
---|
| 134 | ;
|
---|
| 135 | INTRO ;
|
---|
| 136 | N DIR,DIROUT,DUOUT,DTOUT,I,L,S,X,Y
|
---|
| 137 | W !,"Routine XLFNP176 was released with patch XU*8*176."
|
---|
| 138 | ;
|
---|
| 139 | W !!,"This entry point (FIX^XLFNP176) loops through all the entries in the New"
|
---|
| 140 | W !,"Person file (#200) and looks for names that may have been standardized and"
|
---|
| 141 | W !,"parsed incorrectly by the Name Standardization Patch XU*8*134. If a name"
|
---|
| 142 | W !,"in the New Person file prior to the installation of Patch XU*8*134"
|
---|
| 143 | W !,"contained periods within its suffix, the Post-Install Conversion of that"
|
---|
| 144 | W !,"patch converted those periods to spaces, and didn't recognize the name"
|
---|
| 145 | W !,"component as a suffix. This entry point prints a report of names that may"
|
---|
| 146 | W !,"have the problem, and optionally corrects them."
|
---|
| 147 | ;
|
---|
| 148 | W !!,"NOTE: This routine should be run only after Patches XU*8*134 and XU*8*152"
|
---|
| 149 | W !,"have been installed."
|
---|
| 150 | ;
|
---|
| 151 | I '$$PATCH^XPDUTL("XU*8.0*134")!'$$PATCH^XPDUTL("XU*8.0*152") D Q
|
---|
| 152 | . W !!,$C(7)," It appears that the above two patches have NOT been installed on"
|
---|
| 153 | . W !," your system. Exiting ...",!
|
---|
| 154 | . S DIRUT=1
|
---|
| 155 | ;
|
---|
| 156 | W !!," It appears that those two patches HAVE been installed in this acccount"
|
---|
| 157 | W ! S DIR(0)="E" D ^DIR K DIR Q:$D(DIRUT)
|
---|
| 158 | ;
|
---|
| 159 | W !!,"Each New Person file Name will be checked to determine whether any"
|
---|
| 160 | W !,"following strings occur at the end of the Name:",!
|
---|
| 161 | S L=$P($T(LIST),";;",2,99)
|
---|
| 162 | F I=1:1:$L(L,U) S S=$P(L,U,I) W:S]"" !," '"_S_"'"
|
---|
| 163 | ;
|
---|
| 164 | S DIR(0)="Y"
|
---|
| 165 | S DIR("A")="Do you wish to use a different list"
|
---|
| 166 | S DIR("B")="NO"
|
---|
| 167 | S DIR("?",1)=" Enter 'YES' to exit and modify line tag LIST^XLFNP162."
|
---|
| 168 | S DIR("?")=" Enter 'NO' to accept the above list and continue."
|
---|
| 169 | W ! D ^DIR K DIR Q:$D(DIRUT)
|
---|
| 170 | I Y D Q
|
---|
| 171 | . W !!," Edit the list at line tag LIST^XLFNP176.",!
|
---|
| 172 | . S DIRUT=1
|
---|
| 173 | Q
|
---|