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