| 1 | AUPNLKI ; IHS/CMI/LAB - IHS PATIENT LOOKUP, MAIN ROUTINE INITIALIZATION ;12/26/06 10:45
|
|---|
| 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 | ;patch 5 fm v22
|
|---|
| 20 | ;
|
|---|
| 21 | START ; INITIALIZATION
|
|---|
| 22 | S AUPQF=0,AUPDIC=DIC
|
|---|
| 23 | K AUPX,AUPDFN
|
|---|
| 24 | ;
|
|---|
| 25 | I '$D(DIC(0)) S AUPQF=1 Q
|
|---|
| 26 | I DIC(0)'["A"&('$D(X)) S AUPQF=1 Q
|
|---|
| 27 | I '$D(^DD("VERSION")) D:DIC(0)["E" EN^DDIOL("Unable to proceed. Fileman version node ^DD(""VERSION"") is undefined.","","!!?3") S AUPQF=1 Q
|
|---|
| 28 | I ^DD("VERSION")<17.2 D:DIC(0)["E" EN^DDIOL("Unable to proceed. Fileman version must be at least 17.2.","","!!?3") S AUPQF=1 Q
|
|---|
| 29 | I '$D(^DPT(0)) D:DIC(0)["E" EN^DDIOL("Unable to proceed. 0th node of ^DPT missing.","","!!?3") S AUPQF=1 Q
|
|---|
| 30 | I '$D(^AUPNPAT(0)) D:DIC(0)["E" EN^DDIOL("Unable to proceed. 0th node of ^AUPNPAT missing.","","!!?3") S AUPQF=1 Q
|
|---|
| 31 | I '$D(DUZ(2)) D:DIC(0)["E" EN^DDIOL("Unable to proceed. DUZ(2) is undefined.","","!!?3") S AUPQF=1 Q
|
|---|
| 32 | I '$G(DUZ(2)) D:DIC(0)["E" EN^DDIOL("Unable to proceed. DUZ(2) is NULL.","","!!?3") S AUPQF=1 Q
|
|---|
| 33 | I DUZ(2),'$D(^DIC(4,DUZ(2))) D:DIC(0)["E" EN^DDIOL("Unable to proceed. DUZ(2) is not a valid Location.","","!!?3") S AUPQF=1 Q
|
|---|
| 34 | ;D:$D(AUPNLK("ALL")) SET^AUPNLKZ ; Undocumented feature (UGH!)
|
|---|
| 35 | ;
|
|---|
| 36 | ; - - - - - CHART # SCREEN - - - - -
|
|---|
| 37 | S:$D(DIC("S"))#2 AUPDICS=DIC("S")
|
|---|
| 38 | NOTALL I '$G(AUPNLK("ALL")) D SETDICS ;**GFT/VW
|
|---|
| 39 | ; - - - - - SETUP DIC("W") - - - - -
|
|---|
| 40 | ; ** AUPNLKW overrides identifiers. Must be set & killed by caller **
|
|---|
| 41 | K DUOUT,DTOUT S DIC="^DPT(" D DO^DIC1 S DIC("W")=$S($D(DIC("W")):DIC("W"),1:"") S:DIC("W")="W "" "" D ^AUPNLKID"!(DIC("W")="") DIC("W")=$S($D(AUPNLKW):AUPNLKW,1:"D ^AUPNLKID")
|
|---|
| 42 | K AUPNLK("DICW")
|
|---|
| 43 | S:$L(DIC("W"))>110 AUPNLK("DICW")=DIC("W")
|
|---|
| 44 | S DIC("W")="D IHSDUPE^AUPNLKID "_$S($D(AUPNLK("DICW")):"X AUPNLK(""DICW"")",1:DIC("W"))
|
|---|
| 45 | S DIC("W")=DIC("W")_" N DA,X S DA=Y X $P(^DD(2,.081,0),U,5,99) D:$G(X) EN^DDIOL(""<Unresolved potential duplicate>"","""",""!?10"") W @(""$E(""_DIC_""Y,0),0)"")" ;**GFT/VW
|
|---|
| 46 | S DIC("W")=DIC("W")_" I $D(AUPMAPY) S Y=AUPMAPY K AUPMAPY"
|
|---|
| 47 | S AUPDICW=DIC("W")
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | SETDICS ;SET DIC("S") NODES
|
|---|
| 51 | ;S DIC("S","IHSORIG")=$S($D(DIC("S")):DIC("S"),1:"I 1")
|
|---|
| 52 | S AUPNORIG=$S($D(DIC("S")):DIC("S"),1:"I 1") ;IHS/ANMC/CLS 09/13/2000 fm v22
|
|---|
| 53 | ;S DIC("S","IHSLOOK")="I $D(^AUPNPAT(Y,41,DUZ(2),0))"_$S('$D(AUPNLK("INAC")):","_"$P(^(0),U,3)=""""",1:""),DIC("S")="X DIC(""S"",""IHSORIG"") I $T X DIC(""S"",""IHSLOOK"")"
|
|---|
| 54 | S AUPNLOOK="I $D(^AUPNPAT(Y,41,DUZ(2),0))"_$S('$D(AUPNLK("INAC")):","_"$P(^(0),U,3)=""""",1:""),DIC("S")="X AUPNORIG I $T X AUPNLOOK" ;IHS/ANMC/CLS 09/13/2000 fm v22
|
|---|
| 55 | Q
|
|---|
