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
|
---|