source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGYPREG5.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1DGYPREG5 ;ALB/REW - ZIP+4 POST-INIT CONVERSION ;4-JUN-93
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4QUEZIP4 ;
5 S ZTRTN="ZIP4PT^DGYPREG5",ZTDESC="PIMS 5.3 ZIP+4 CONVERSION",ZTIO=""
6 D ^%ZTLOAD
7 Q
8ZIP4PT ;
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
24QTZ4PT Q
25DISPZIP(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
31MAKEZIP4(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
45FROMTO(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
Note: See TracBrowser for help on using the repository browser.