| 1 | PXTTU1 ;ISL/JVS/ESW - Utility Routine-calls from input transforms ;10/10/06 19:07
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**106,167**;Aug 12, 1996;Build 22
|
|---|
| 3 | ; Modified from FOIA VISTA,
|
|---|
| 4 | ; Copyright (C) 2007 WorldVistA
|
|---|
| 5 | ;
|
|---|
| 6 | ; This program is free software; you can redistribute it and/or modify
|
|---|
| 7 | ; it under the terms of the GNU General Public License as published by
|
|---|
| 8 | ; the Free Software Foundation; either version 2 of the License, or
|
|---|
| 9 | ; (at your option) any later version.
|
|---|
| 10 | ;
|
|---|
| 11 | ; This program is distributed in the hope that it will be useful,
|
|---|
| 12 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|---|
| 13 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|---|
| 14 | ; GNU General Public License for more details.
|
|---|
| 15 | ;
|
|---|
| 16 | ; You should have received a copy of the GNU General Public License
|
|---|
| 17 | ; along with this program; if not, write to the Free Software
|
|---|
| 18 | ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
|---|
| 19 | Q
|
|---|
| 20 | ; This routines purpose is to hold utilities used by the supporting
|
|---|
| 21 | ;files for the v files.
|
|---|
| 22 | ;
|
|---|
| 23 | ZERO(PXB,PXNAT) ;PXTT TOPICS - Reset the zero node for new ifn's to add
|
|---|
| 24 | ; at option
|
|---|
| 25 | ;PXB - parameter "^AUTT...(" passed from ENTRY ACTION of the related
|
|---|
| 26 | ; Option:
|
|---|
| 27 | ; PXTT EDIT EDUCATION TOPICS
|
|---|
| 28 | ; PXTT EDIT HEALTH FACTORS
|
|---|
| 29 | ; PXTT EDIT IMMUNIZATIONS
|
|---|
| 30 | ; PXTT EDIT SKIN TESTS
|
|---|
| 31 | ; PXTT EDIT TREATMENT
|
|---|
| 32 | ; PXTT EDIT EXAM
|
|---|
| 33 | ;PXNAT (optional) - a variable to be set temporarily to PXNAT=1 in
|
|---|
| 34 | ; ENTRY ACTION, see above, by a developer for setting/editing
|
|---|
| 35 | ; a national package.
|
|---|
| 36 | ;
|
|---|
| 37 | D GETSITE Q:$L(PXTDUZ)'=3
|
|---|
| 38 | I +$G(PXNAT) S $P(@(PXB_"0)"),U,3)=0
|
|---|
| 39 | E S:(+$P($G(@(PXB_"0)")),U,3)<(PXTDUZ_"000"))!(+$P($G(@(PXB_"0)")),U,3)>(PXTDUZ_"999")) $P(@(PXB_"0)"),U,3)=PXTDUZ_"000"
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | GETSITE S PXTDUZ=$P($$SITE^VASITE,U,3) S:$G(DUZ("AG"))="V" PXTDUZ=+PXTDUZ
|
|---|
| 43 | I $L(PXTDUZ)'=3 W !,"Primary site is not 3 character station number! See IRM for setup." Q
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | CKNA(PXB) ;Check for duplicat names.
|
|---|
| 47 | ;PXB - parameter "^AUTT...(" passed by INPUT TRANSFORM of .01 field
|
|---|
| 48 | ; of the related file:
|
|---|
| 49 | ; HEALTH FACTORS ; 9999999.64
|
|---|
| 50 | ; EDUCATION TOPICS ; 9999999.09
|
|---|
| 51 | ; IMMUNIZATION ; 9999999.14
|
|---|
| 52 | ; EXAM ; 9999999.15
|
|---|
| 53 | ; TREATMENT ; 9999999.17
|
|---|
| 54 | ; SKIN TEST ; 9999999.28
|
|---|
| 55 | ;PXNAT - optional variable, see above
|
|---|
| 56 | N PXD
|
|---|
| 57 | S PXD=PXB_"""B"""_","_""""_X_""")"
|
|---|
| 58 | I $D(@PXD),$O(@PXD@(""))<100000 D Q
|
|---|
| 59 | .;check for existing national
|
|---|
| 60 | .W !,"Duplicate NAMES not allowed." K X
|
|---|
| 61 | ;additional check for EDUCATION TOPICS
|
|---|
| 62 | I $P(PXB,"(")="^AUTTEDT",$F(X,"VA-")=4,'$G(PXNAT) D
|
|---|
| 63 | .W !,"NAME cannot start with ""VA-"", reserved for national distribution!" K X
|
|---|
| 64 | Q
|
|---|
