| [613] | 1 | DGYPREG5 ;ALB/REW - ZIP+4 POST-INIT CONVERSION ;4-JUN-93
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | QUEZIP4 ;
|
|---|
| 5 | S ZTRTN="ZIP4PT^DGYPREG5",ZTDESC="PIMS 5.3 ZIP+4 CONVERSION",ZTIO=""
|
|---|
| 6 | D ^%ZTLOAD
|
|---|
| 7 | Q
|
|---|
| 8 | ZIP4PT ;
|
|---|
| 9 | N DFN
|
|---|
| 10 | S DFN=0
|
|---|
| 11 | W:'$D(ZTQUEUED) !,">>> Populating ZIP+4 fields...",!
|
|---|
| 12 | F S DFN=$O(^DPT(DFN)) Q:'DFN W:'(DFN#100)&('$D(ZTQUEUED)) "." D MAKEZIP4(DFN) D DISPZIP(DFN)
|
|---|
| 13 | W:'$D(ZTQUEUED) !!,"...ZIP+4 CONVERSION DONE "
|
|---|
| 14 | D SETUP^DGYPREG1(3)
|
|---|
| 15 | G:'$D(ZTQUEUED) QTZ4PT
|
|---|
| 16 | S DGXM=1 ;message line number
|
|---|
| 17 | D MESS^DGYPREG1("The Population of the following ZIP+4 fields is complete (Field #'s):")
|
|---|
| 18 | D MESS^DGYPREG1(".2201,.2202,.2203,.2204,.2205,.2206,.2207,.12112,.290012,.29013,.1112",1)
|
|---|
| 19 | D MESS^DGYPREG1("PIMS will use the above fields instead of the following ZIP CODE list:")
|
|---|
| 20 | D MESS^DGYPREG1(".338,.348,.2198,.3318,.3118,.257,.218,.1216,.2928,.2918,.116",1)
|
|---|
| 21 | D MESS^DGYPREG1(" - Also sub-field #38 of the DISPOSITION multiple is populated (A-ZIP+4)")
|
|---|
| 22 | D MESS^DGYPREG1(" it will be used instead of subfield #36 (A-ZIP CODE)",1)
|
|---|
| 23 | D END^DGYPREG1
|
|---|
| 24 | QTZ4PT Q
|
|---|
| 25 | DISPZIP(DFN) ;Populates the attorney's zip+4 in disposition multiple
|
|---|
| 26 | N DFN1
|
|---|
| 27 | S DFN1=0
|
|---|
| 28 | F S DFN1=$O(^DPT(DFN,"DIS",DFN1)) Q:'DFN1 D
|
|---|
| 29 | .S:$P($G(^DPT(DFN,"DIS",DFN1,3)),U,7)&($P($G(^DPT(DFN,"DIS",DFN1,3)),U,7)']"") $P(^(3),U,9)=$P(^(3),U,7)
|
|---|
| 30 | Q
|
|---|
| 31 | MAKEZIP4(DFN) ;Populates zip+4 fields with zip code fields
|
|---|
| 32 | ;ZIP->ZIP+4
|
|---|
| 33 | D FROMTO(DFN,.33,8,.22,1)
|
|---|
| 34 | D FROMTO(DFN,.34,8,.22,2)
|
|---|
| 35 | D FROMTO(DFN,.211,8,.22,3)
|
|---|
| 36 | D FROMTO(DFN,.331,8,.22,4)
|
|---|
| 37 | D FROMTO(DFN,.311,8,.22,5)
|
|---|
| 38 | D FROMTO(DFN,.25,7,.22,6)
|
|---|
| 39 | D FROMTO(DFN,.21,8,.22,7)
|
|---|
| 40 | D FROMTO(DFN,.121,6,.121,12)
|
|---|
| 41 | D FROMTO(DFN,.291,10,.291,12)
|
|---|
| 42 | D FROMTO(DFN,.29,10,.29,13)
|
|---|
| 43 | D FROMTO(DFN,.11,6,.11,12)
|
|---|
| 44 | Q
|
|---|
| 45 | FROMTO(DFN,FROMNODE,FROMPC,TONODE,TOPC) ;POPULATES ZIP+4 WITH ZIP DATA
|
|---|
| 46 | ;VARIABLES:
|
|---|
| 47 | ; DFN - IEN of Patient File
|
|---|
| 48 | ;FROMNODE - zip code node
|
|---|
| 49 | ;TONODE - zip+4 node
|
|---|
| 50 | ;FROMPC - zip code piece
|
|---|
| 51 | ;TOPC -zip+4 piece
|
|---|
| 52 | ;
|
|---|
| 53 | I '$G(DFN)!('$G(FROMNODE))!('$G(FROMPC))!('$G(TONODE))!('$G(TOPC)) D Q
|
|---|
| 54 | .W:'$D(ZTQUEUED) !,"MISSING INPUT VARIABLE"
|
|---|
| 55 | I $P($G(^DPT(DFN,FROMNODE)),U,FROMPC) D
|
|---|
| 56 | .S:'$P($G(^DPT(DFN,TONODE)),U,TOPC) $P(^DPT(DFN,TONODE),U,TOPC)=$P(^DPT(DFN,FROMNODE),U,FROMPC)
|
|---|
| 57 | Q
|
|---|
