| 1 | AUPNLK1I ; IHS/CMI/LAB - INITIALIZATION FOR ^AUPNLK1 ;16DEC2006
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**167**;Aug 12, 1996;Build 22
|
|---|
| 3 | ; Copyright (C) 2007 WorldVistA
|
|---|
| 4 | ;
|
|---|
| 5 | ; This program is free software; you can redistribute it and/or modify
|
|---|
| 6 | ; it under the terms of the GNU General Public License as published by
|
|---|
| 7 | ; the Free Software Foundation; either version 2 of the License, or
|
|---|
| 8 | ; (at your option) any later version.
|
|---|
| 9 | ;
|
|---|
| 10 | ; This program is distributed in the hope that it will be useful,
|
|---|
| 11 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|---|
| 12 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|---|
| 13 | ; GNU General Public License for more details.
|
|---|
| 14 | ;
|
|---|
| 15 | ; You should have received a copy of the GNU General Public License
|
|---|
| 16 | ; along with this program; if not, write to the Free Software
|
|---|
| 17 | ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
|---|
| 18 | ;'Modified' MAS Patient Look-up Check Cross-References June 1987
|
|---|
| 19 | ;
|
|---|
| 20 | INIT ; INITIALIZATION - FIX UP AUPX AND SET UP XREFS
|
|---|
| 21 | I AUPX?.E1L.E F AUPI=1:1:$L(AUPX) S:$E(AUPX,AUPI)?1L AUPX=$E(AUPX,0,AUPI-1)_$C($A(AUPX,AUPI)-32)_$E(AUPX,AUPI+1,$L(AUPX))
|
|---|
| 22 | I AUPX[", " F AUPL=0:0 Q:'$F(AUPX,", ") S AUPX=$E(AUPX,1,($F(AUPX,", ")-2))_$E(AUPX,$F(AUPX,", "),$L(AUPX))
|
|---|
| 23 | K AUPREFS S AUPREFS=$S(DIC(0)'["M":"B",AUPX?1A1N.N:"CN,RM,BS5",AUPX?4N.1A:"CN,RM,BS",AUPX?9N.E:"SSN,CN,RM",1:"")
|
|---|
| 24 | S:AUPREFS="" AUPREFS=$S(AUPX?1N.N:$S($L(AUPX)<5:"CN,RM,BS,SSN",1:"CN,RM,SSN"),AUPX?1N.E:"CN,RM",1:"B,CN,RM,BS5") S:$D(AUPIX) AUPREFS=AUPIX_","_AUPREFS
|
|---|
| 25 | ; - - - - - IHS DOB - - - - -
|
|---|
| 26 | ;beginning Y2K IHS/CMI/LAB
|
|---|
| 27 | ;change "X" to %DT="PX", change allowable input from 6N to 8N
|
|---|
| 28 | ;I DIC(0)["M",AUPX'?1N.N S %DT="X",X=$S(AUPX?1"B"6N:$E(AUPX,2,7),1:AUPX) D ^%DT S:Y'=-1 AUPDT=Y,AUPREFS=AUPREFS_",ADOB" K %DT,Y ;Y2000 IHS/CMI/LAB
|
|---|
| 29 | I DIC(0)["M",AUPX'?1N.N S %DT="PX",X=$S(AUPX?1"B"8N:$E(AUPX,2,9),1:AUPX) D ^%DT S:Y'=-1 AUPDT=Y,AUPREFS=AUPREFS_",ADOB" K %DT,Y ;Y2000 IHS/CMI/LAB
|
|---|
| 30 | ;end Y2K fix
|
|---|
| 31 | ; - - - - - IHS TEMPORARY CHART # - - - - -
|
|---|
| 32 | I AUPX?1"T"5N,$D(^AUPNPAT("D",AUPX)) S (AUPIFN,Y)=$O(^AUPNPAT("D",AUPX,0)) D SETAUP^AUPNLKUT
|
|---|
| 33 | ; - - - - - - - - - - - - - - - - - - - - -
|
|---|
| 34 | PHONE I DIC(0)["M",AUPX?.NP S AUPREFS=AUPREFS_",AZVWVOE" ;**GFT/VW
|
|---|
| 35 | Q
|
|---|
