58 lines
2.1 KiB
Mathematica
58 lines
2.1 KiB
Mathematica
|
DGYPREG5 ;ALB/REW - ZIP+4 POST-INIT CONVERSION ;4-JUN-93
|
||
|
|
;;5.3;Registration;;Aug 13, 1993
|
||
|
|
;
|
||
|
|
QUEZIP4 ;
|
||
|
|
S ZTRTN="ZIP4PT^DGYPREG5",ZTDESC="PIMS 5.3 ZIP+4 CONVERSION",ZTIO=""
|
||
|
|
D ^%ZTLOAD
|
||
|
|
Q
|
||
|
|
ZIP4PT ;
|
||
|
|
N DFN
|
||
|
|
S DFN=0
|
||
|
|
W:'$D(ZTQUEUED) !,">>> Populating ZIP+4 fields...",!
|
||
|
|
F S DFN=$O(^DPT(DFN)) Q:'DFN W:'(DFN#100)&('$D(ZTQUEUED)) "." D MAKEZIP4(DFN) D DISPZIP(DFN)
|
||
|
|
W:'$D(ZTQUEUED) !!,"...ZIP+4 CONVERSION DONE "
|
||
|
|
D SETUP^DGYPREG1(3)
|
||
|
|
G:'$D(ZTQUEUED) QTZ4PT
|
||
|
|
S DGXM=1 ;message line number
|
||
|
|
D MESS^DGYPREG1("The Population of the following ZIP+4 fields is complete (Field #'s):")
|
||
|
|
D MESS^DGYPREG1(".2201,.2202,.2203,.2204,.2205,.2206,.2207,.12112,.290012,.29013,.1112",1)
|
||
|
|
D MESS^DGYPREG1("PIMS will use the above fields instead of the following ZIP CODE list:")
|
||
|
|
D MESS^DGYPREG1(".338,.348,.2198,.3318,.3118,.257,.218,.1216,.2928,.2918,.116",1)
|
||
|
|
D MESS^DGYPREG1(" - Also sub-field #38 of the DISPOSITION multiple is populated (A-ZIP+4)")
|
||
|
|
D MESS^DGYPREG1(" it will be used instead of subfield #36 (A-ZIP CODE)",1)
|
||
|
|
D END^DGYPREG1
|
||
|
|
QTZ4PT Q
|
||
|
|
DISPZIP(DFN) ;Populates the attorney's zip+4 in disposition multiple
|
||
|
|
N DFN1
|
||
|
|
S DFN1=0
|
||
|
|
F S DFN1=$O(^DPT(DFN,"DIS",DFN1)) Q:'DFN1 D
|
||
|
|
.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)
|
||
|
|
Q
|
||
|
|
MAKEZIP4(DFN) ;Populates zip+4 fields with zip code fields
|
||
|
|
;ZIP->ZIP+4
|
||
|
|
D FROMTO(DFN,.33,8,.22,1)
|
||
|
|
D FROMTO(DFN,.34,8,.22,2)
|
||
|
|
D FROMTO(DFN,.211,8,.22,3)
|
||
|
|
D FROMTO(DFN,.331,8,.22,4)
|
||
|
|
D FROMTO(DFN,.311,8,.22,5)
|
||
|
|
D FROMTO(DFN,.25,7,.22,6)
|
||
|
|
D FROMTO(DFN,.21,8,.22,7)
|
||
|
|
D FROMTO(DFN,.121,6,.121,12)
|
||
|
|
D FROMTO(DFN,.291,10,.291,12)
|
||
|
|
D FROMTO(DFN,.29,10,.29,13)
|
||
|
|
D FROMTO(DFN,.11,6,.11,12)
|
||
|
|
Q
|
||
|
|
FROMTO(DFN,FROMNODE,FROMPC,TONODE,TOPC) ;POPULATES ZIP+4 WITH ZIP DATA
|
||
|
|
;VARIABLES:
|
||
|
|
; DFN - IEN of Patient File
|
||
|
|
;FROMNODE - zip code node
|
||
|
|
;TONODE - zip+4 node
|
||
|
|
;FROMPC - zip code piece
|
||
|
|
;TOPC -zip+4 piece
|
||
|
|
;
|
||
|
|
I '$G(DFN)!('$G(FROMNODE))!('$G(FROMPC))!('$G(TONODE))!('$G(TOPC)) D Q
|
||
|
|
.W:'$D(ZTQUEUED) !,"MISSING INPUT VARIABLE"
|
||
|
|
I $P($G(^DPT(DFN,FROMNODE)),U,FROMPC) D
|
||
|
|
.S:'$P($G(^DPT(DFN,TONODE)),U,TOPC) $P(^DPT(DFN,TONODE),U,TOPC)=$P(^DPT(DFN,FROMNODE),U,FROMPC)
|
||
|
|
Q
|