PXTTU1 ;ISL/JVS/ESW - Utility Routine-calls from input transforms ;5/20/96 17:14
;;1.0;PCE PATIENT CARE ENCOUNTER;**106,205**;Aug 12, 1996;Build 6
Q
; This routines purpose is to hold utilities used by the supporting
;files for the v files.
;
ZERO(PXB,PXNAT) ;PXTT TOPICS - Reset the zero node for new ifn's to add
; at option
;PXB - parameter "^AUTT...(" passed from ENTRY ACTION of the related
; Option:
; PXTT EDIT EDUCATION TOPICS
; PXTT EDIT HEALTH FACTORS
; PXTT EDIT IMMUNIZATIONS
; PXTT EDIT SKIN TESTS
; PXTT EDIT TREATMENT
; PXTT EDIT EXAM
;PXNAT (optional) - a variable to be set temporarily to PXNAT=1 in
; ENTRY ACTION, see above, by a developer for setting/editing
; a national package.
;
D GETSITE Q:$L(PXTDUZ)'=3
I +$G(PXNAT) S $P(@(PXB_"0)"),U,3)=0
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"
Q
;
GETSITE S PXTDUZ=+$P($$SITE^VASITE,U,3)
I $L(PXTDUZ)'=3 W !,"Primary site is not 3 character station number! See IRM for setup." Q
Q
;
CKNA(PXB) ;Check for duplicat names.
;PXB - parameter "^AUTT...(" passed by INPUT TRANSFORM of .01 field
; of the related file:
; HEALTH FACTORS ; 9999999.64
; EDUCATION TOPICS ; 9999999.09
; IMMUNIZATION ; 9999999.14
; EXAM ; 9999999.15
; TREATMENT ; 9999999.17
; SKIN TEST ; 9999999.28
;PXNAT - optional variable, see above
N PXD
S PXD=PXB_"""B"""_","_""""_X_""")"
;I $D(@PXD),$O(@PXD@(""))<100000 D Q
I $D(@PXD) D Q ;PX*1.0*205 replaced line above
.;check for existing national
.W !,"Duplicate NAMES not allowed." K X
;additional check for EDUCATION TOPICS
I $P(PXB,"(")="^AUTTEDT",$F(X,"VA-")=4,'$G(PXNAT) D
.W !,"NAME cannot start with ""VA-"", reserved for national distribution!" K X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXTTU1 2025 printed Oct 16, 2024@18:32:10 Page 2
PXTTU1 ;ISL/JVS/ESW - Utility Routine-calls from input transforms ;5/20/96 17:14
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**106,205**;Aug 12, 1996;Build 6
+2 QUIT
+3 ; This routines purpose is to hold utilities used by the supporting
+4 ;files for the v files.
+5 ;
ZERO(PXB,PXNAT) ;PXTT TOPICS - Reset the zero node for new ifn's to add
+1 ; at option
+2 ;PXB - parameter "^AUTT...(" passed from ENTRY ACTION of the related
+3 ; Option:
+4 ; PXTT EDIT EDUCATION TOPICS
+5 ; PXTT EDIT HEALTH FACTORS
+6 ; PXTT EDIT IMMUNIZATIONS
+7 ; PXTT EDIT SKIN TESTS
+8 ; PXTT EDIT TREATMENT
+9 ; PXTT EDIT EXAM
+10 ;PXNAT (optional) - a variable to be set temporarily to PXNAT=1 in
+11 ; ENTRY ACTION, see above, by a developer for setting/editing
+12 ; a national package.
+13 ;
+14 DO GETSITE
if $LENGTH(PXTDUZ)'=3
QUIT
+15 IF +$GET(PXNAT)
SET $PIECE(@(PXB_"0)"),U,3)=0
+16 IF '$TEST
if (+$PIECE($GET(@(PXB_"0)")),U,3)<(PXTDUZ_"000"))!(+$PIECE($GET(@(PXB_"0)")),U,3)>(PXTDUZ_"999"))
SET $PIECE(@(PXB_"0)"),U,3)=PXTDUZ_"000"
+17 QUIT
+18 ;
GETSITE SET PXTDUZ=+$PIECE($$SITE^VASITE,U,3)
+1 IF $LENGTH(PXTDUZ)'=3
WRITE !,"Primary site is not 3 character station number! See IRM for setup."
QUIT
+2 QUIT
+3 ;
CKNA(PXB) ;Check for duplicat names.
+1 ;PXB - parameter "^AUTT...(" passed by INPUT TRANSFORM of .01 field
+2 ; of the related file:
+3 ; HEALTH FACTORS ; 9999999.64
+4 ; EDUCATION TOPICS ; 9999999.09
+5 ; IMMUNIZATION ; 9999999.14
+6 ; EXAM ; 9999999.15
+7 ; TREATMENT ; 9999999.17
+8 ; SKIN TEST ; 9999999.28
+9 ;PXNAT - optional variable, see above
+10 NEW PXD
+11 SET PXD=PXB_"""B"""_","_""""_X_""")"
+12 ;I $D(@PXD),$O(@PXD@(""))<100000 D Q
+13 ;PX*1.0*205 replaced line above
IF $DATA(@PXD)
Begin DoDot:1
+14 ;check for existing national
+15 WRITE !,"Duplicate NAMES not allowed."
KILL X
End DoDot:1
QUIT
+16 ;additional check for EDUCATION TOPICS
+17 IF $PIECE(PXB,"(")="^AUTTEDT"
IF $FIND(X,"VA-")=4
IF '$GET(PXNAT)
Begin DoDot:1
+18 WRITE !,"NAME cannot start with ""VA-"", reserved for national distribution!"
KILL X
End DoDot:1
+19 QUIT