| 1 | PXTTU1 ;ISL/JVS/ESW - Utility Routine-calls from input transforms ;5/20/96 17:14
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**106**;Aug 12, 1996
|
|---|
| 3 | Q
|
|---|
| 4 | ; This routines purpose is to hold utilities used by the supporting
|
|---|
| 5 | ;files for the v files.
|
|---|
| 6 | ;
|
|---|
| 7 | ZERO(PXB,PXNAT) ;PXTT TOPICS - Reset the zero node for new ifn's to add
|
|---|
| 8 | ; at option
|
|---|
| 9 | ;PXB - parameter "^AUTT...(" passed from ENTRY ACTION of the related
|
|---|
| 10 | ; Option:
|
|---|
| 11 | ; PXTT EDIT EDUCATION TOPICS
|
|---|
| 12 | ; PXTT EDIT HEALTH FACTORS
|
|---|
| 13 | ; PXTT EDIT IMMUNIZATIONS
|
|---|
| 14 | ; PXTT EDIT SKIN TESTS
|
|---|
| 15 | ; PXTT EDIT TREATMENT
|
|---|
| 16 | ; PXTT EDIT EXAM
|
|---|
| 17 | ;PXNAT (optional) - a variable to be set temporarily to PXNAT=1 in
|
|---|
| 18 | ; ENTRY ACTION, see above, by a developer for setting/editing
|
|---|
| 19 | ; a national package.
|
|---|
| 20 | ;
|
|---|
| 21 | D GETSITE Q:$L(PXTDUZ)'=3
|
|---|
| 22 | I +$G(PXNAT) S $P(@(PXB_"0)"),U,3)=0
|
|---|
| 23 | 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"
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | GETSITE S PXTDUZ=+$P($$SITE^VASITE,U,3)
|
|---|
| 27 | I $L(PXTDUZ)'=3 W !,"Primary site is not 3 character station number! See IRM for setup." Q
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | CKNA(PXB) ;Check for duplicat names.
|
|---|
| 31 | ;PXB - parameter "^AUTT...(" passed by INPUT TRANSFORM of .01 field
|
|---|
| 32 | ; of the related file:
|
|---|
| 33 | ; HEALTH FACTORS ; 9999999.64
|
|---|
| 34 | ; EDUCATION TOPICS ; 9999999.09
|
|---|
| 35 | ; IMMUNIZATION ; 9999999.14
|
|---|
| 36 | ; EXAM ; 9999999.15
|
|---|
| 37 | ; TREATMENT ; 9999999.17
|
|---|
| 38 | ; SKIN TEST ; 9999999.28
|
|---|
| 39 | ;PXNAT - optional variable, see above
|
|---|
| 40 | N PXD
|
|---|
| 41 | S PXD=PXB_"""B"""_","_""""_X_""")"
|
|---|
| 42 | I $D(@PXD),$O(@PXD@(""))<100000 D Q
|
|---|
| 43 | .;check for existing national
|
|---|
| 44 | .W !,"Duplicate NAMES not allowed." K X
|
|---|
| 45 | ;additional check for EDUCATION TOPICS
|
|---|
| 46 | I $P(PXB,"(")="^AUTTEDT",$F(X,"VA-")=4,'$G(PXNAT) D
|
|---|
| 47 | .W !,"NAME cannot start with ""VA-"", reserved for national distribution!" K X
|
|---|
| 48 | Q
|
|---|
