INHVA1.m

INHVA1 ;FRW ; 6 Feb 92 12:20; SACI-Care/VA data element mapping utilities

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;COPYRIGHT 1991-2000 SAIC

 Q

CONF ;Consistency check for the .01 field on file #4090.2

 ;Called from ^DD(4090.2,.01,9)

 ;INPUT:

 ;  X - value of .01 field

 ;  DA - entry being editted (ien)

 ;

 ;OUTPUT:

 ;  X - killed if not valid name

 ;

 S %=$O(^INVD(4090.2,"B",X,0)) I %,%'=DA W *7,!,"The function ",X," already exists." K X

 Q

 ;

DEL ;Verify if entry can be deleted

 ;INPUT:

 ;  DA - entry being deleted

 ;OUTPUT:

 ;  $T - flagged to indicate if entry can be deleted

 ;        0 - ok to delete ; 1 - NOT ok to delete

 ;

 I $D(^INVD(4090.1,"SC",DA))!$D(^INVD(4090.1,"VA",DA)) D

 .D:$D(DWD)>9 MESS^DWD(6)

 .W *7,!!,"Entry may not be deleted.",!,"Entries in the DATA ELEMENT VALUE MAP file use this function."

 .R !,"Press <RETURN> to continue ",%:DTIME

 Q

 ;

ADDR(SUBSCR,ITER) ;Transform addresses with no state

 ;INPUT:

 ;  X => value of state field (ZZZ99.5)

 ;  INV => array of data values

 ;  SUBSCR => subscript where address field resides in INV (ex. ZPD17)

 ;  ITER => (opt) indicates an iteration count

 ;

 ;OUTPUT:

 ;  X => transformed value of state

 ;  INV => modified array of data values

 ;

 S:$G(SUBSCR)="" SUBSCR="XXX"

 ;Look for zip codes in state field

 G:'$G(ITER) AD1

 I X?5N.E S @("@INV@("""_SUBSCR_".6"",ITER)")=X,X="",@("@INV@("""_SUBSCR_".5"",ITER)")=""

 I X]"" S X=$$MAP^INHVA2("GEOGRAPHIC LOCATION",@("@INV@("""_SUBSCR_".4"",ITER)")_"\"_X,0) K:'X X I $D(X) S X="`"_+X

 Q

AD1 ;non-looping

 I X?5N.E S @("@INV@("""_SUBSCR_".6"")")=X,X="",@("@INV@("""_SUBSCR_".5"")")=""

 I X]"" S X=$$MAP^INHVA2("GEOGRAPHIC LOCATION",@("@INV@("""_SUBSCR_".4"")")_"\"_X,0) K:'X X I $D(X) S X="`"_+X

 Q

 ;

TEST ;

 S INMODE="I",SUBDELIM="\"

 K INV S X="ILLINOIS",INV("ZPD17.5")=X,INV("ZPD17.4")=17 D ADDR("ZPD17") W !!,"X => ",X

 K INV S X=98124,INV("ZPD17.5")=X D ADDR("ZPD17") W !!,"X => ",X,!,"INV(17.6) => ",INV("ZPD17.6")

 Q

 ;

KILL(%V,%D,%I) ;kill segment %V

 ;%D holds description of script var which failed required check

 ;If %I exists, it is an array containing subscript levels to wipe out

 N X,Y,I,Z S (%V,X)=$E(%V,1,3)

 I '$D(%I) D  Q

 . F  S X=$O(@INV@(X)) Q:$E(X,1,3)'=%V  K @INV@(X)

 . D ERROR^INHS("Required data missing: '"_%D_"' ... "_%V_" segment deleted.  Processing continues.",0)

 S Y="",I=0 F  S I=$O(%I(I)) Q:'I  S Y=Y_","_%I(I)

 S Z=$TR(INV,")",",")_$E("(",INV'["(")

 F  S X=$O(@INV@(X)) Q:$E(X,1,3)'=%V  K @(Z_""""_X_""""_Y_")")

 S Z="Required data missing: '"_%D_"' ... "_%V_" segment deleted for iteration #" S I=0 F  S I=$O(%I(I)) Q:'I  S Z=Z_%I(I)_","

 D ERROR^INHS($E(Z,1,$L(Z)-1)_".  Processing continues.",0)

 Q

INHVA1    ;FRW ; 6 Feb 92 12:20; SACI-Care/VA data element mapping utilities

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;COPYRIGHT 1991-2000 SAIC

 +3        QUIT 

CONF      ;Consistency check for the .01 field on file #4090.2

 +1       ;Called from ^DD(4090.2,.01,9)

 +2       ;INPUT:

 +3       ;  X - value of .01 field

 +4       ;  DA - entry being editted (ien)

 +5       ;

 +6       ;OUTPUT:

 +7       ;  X - killed if not valid name

 +8       ;

 +9        SET %=$ORDER(^INVD(4090.2,"B",X,0))

           IF %

               IF %'=DA

                   WRITE *7,!,"The function ",X," already exists."

                   KILL X

 +10       QUIT 

 +11      ;

DEL       ;Verify if entry can be deleted

 +1       ;INPUT:

 +2       ;  DA - entry being deleted

 +3       ;OUTPUT:

 +4       ;  $T - flagged to indicate if entry can be deleted

 +5       ;        0 - ok to delete ; 1 - NOT ok to delete

 +6       ;

 +7        IF $DATA(^INVD(4090.1,"SC",DA))!$DATA(^INVD(4090.1,"VA",DA))

               Begin DoDot:1

 +8                IF $DATA(DWD)>9

                       DO MESS^DWD(6)

 +9                WRITE *7,!!,"Entry may not be deleted.",!,"Entries in the DATA ELEMENT VALUE MAP file use this function."

 +10               READ !,"Press <RETURN> to continue ",%:DTIME

               End DoDot:1

 +11       QUIT 

 +12      ;

ADDR(SUBSCR,ITER) ;Transform addresses with no state

 +1       ;INPUT:

 +2       ;  X => value of state field (ZZZ99.5)

 +3       ;  INV => array of data values

 +4       ;  SUBSCR => subscript where address field resides in INV (ex. ZPD17)

 +5       ;  ITER => (opt) indicates an iteration count

 +6       ;

 +7       ;OUTPUT:

 +8       ;  X => transformed value of state

 +9       ;  INV => modified array of data values

 +10      ;

 +11       IF $GET(SUBSCR)=""

               SET SUBSCR="XXX"

 +12      ;Look for zip codes in state field

 +13       IF '$GET(ITER)

               GOTO AD1

 +14       IF X?5N.E

               SET @("@INV@("""_SUBSCR_".6"",ITER)")=X

               SET X=""

               SET @("@INV@("""_SUBSCR_".5"",ITER)")=""

 +15       IF X]""

               SET X=$$MAP^INHVA2("GEOGRAPHIC LOCATION",@("@INV@("""_SUBSCR_".4"",ITER)")_"\"_X,0)

               IF 'X

                   KILL X

               IF $DATA(X)

                   SET X="`"_+X

 +16       QUIT 

AD1       ;non-looping

 +1        IF X?5N.E

               SET @("@INV@("""_SUBSCR_".6"")")=X

               SET X=""

               SET @("@INV@("""_SUBSCR_".5"")")=""

 +2        IF X]""

               SET X=$$MAP^INHVA2("GEOGRAPHIC LOCATION",@("@INV@("""_SUBSCR_".4"")")_"\"_X,0)

               IF 'X

                   KILL X

               IF $DATA(X)

                   SET X="`"_+X

 +3        QUIT 

 +4       ;

TEST      ;

 +1        SET INMODE="I"

           SET SUBDELIM="\"

 +2        KILL INV

           SET X="ILLINOIS"

           SET INV("ZPD17.5")=X

           SET INV("ZPD17.4")=17

           DO ADDR("ZPD17")

           WRITE !!,"X => ",X

 +3        KILL INV

           SET X=98124

           SET INV("ZPD17.5")=X

           DO ADDR("ZPD17")

           WRITE !!,"X => ",X,!,"INV(17.6) => ",INV("ZPD17.6")

 +4        QUIT 

 +5       ;

KILL(%V,%D,%I) ;kill segment %V

 +1       ;%D holds description of script var which failed required check

 +2       ;If %I exists, it is an array containing subscript levels to wipe out

 +3        NEW X,Y,I,Z

           SET (%V,X)=$EXTRACT(%V,1,3)

 +4        IF '$DATA(%I)

               Begin DoDot:1

 +5                FOR 

                       SET X=$ORDER(@INV@(X))

                       IF $EXTRACT(X,1,3)'=%V

                           QUIT 

                       KILL @INV@(X)

 +6                DO ERROR^INHS("Required data missing: '"_%D_"' ... "_%V_" segment deleted.  Processing continues.",0)

               End DoDot:1

               QUIT 

 +7        SET Y=""

           SET I=0

           FOR 

               SET I=$ORDER(%I(I))

               IF 'I

                   QUIT 

               SET Y=Y_","_%I(I)

 +8        SET Z=$TRANSLATE(INV,")",",")_$EXTRACT("(",INV'["(")

 +9        FOR 

               SET X=$ORDER(@INV@(X))

               IF $EXTRACT(X,1,3)'=%V

                   QUIT 

               KILL @(Z_""""_X_""""_Y_")")

 +10       SET Z="Required data missing: '"_%D_"' ... "_%V_" segment deleted for iteration #"

           SET I=0

           FOR 

               SET I=$ORDER(%I(I))

               IF 'I

                   QUIT 

               SET Z=Z_%I(I)_","

 +11       DO ERROR^INHS($EXTRACT(Z,1,$LENGTH(Z)-1)_".  Processing continues.",0)

 +12       QUIT