PXTTU1.m

PXTTU1 ;ISL/JVS/ESW - Utility Routine-calls from input transforms ;5/20/96  17:14

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**106**;Aug 12, 1996

 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

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

PXTTU1    ;ISL/JVS/ESW - Utility Routine-calls from input transforms ;5/20/96  17:14

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**106**;Aug 12, 1996

 +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       IF $DATA(@PXD)

               IF $ORDER(@PXD@(""))<100000

                   Begin DoDot:1

 +13      ;check for existing national

 +14                   WRITE !,"Duplicate NAMES not allowed."

                       KILL X

                   End DoDot:1

                   QUIT 

 +15      ;additional check for EDUCATION TOPICS

 +16       IF $PIECE(PXB,"(")="^AUTTEDT"

               IF $FIND(X,"VA-")=4

                   IF '$GET(PXNAT)

                       Begin DoDot:1

 +17                       WRITE !,"NAME cannot start with ""VA-"", reserved for national distribution!"

                           KILL X

                       End DoDot:1

 +18       QUIT