AUPNVDXT.m

AUPNVDXT ; IHS/CMI/LAB - WASH ISC/GIS TJK OUTPUT TRANSFORMS FOR V DIAGNOSTIC PROCEDURE RESULT FILE ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ; WHEN THE NEW PERSON FILE IS INSTALLED CHANGE LINE TL+1 TO I B=6 S B=200

RUN N %,A,B

 I $G(Y)=""!('$D(DA)) Q

 S %=+$G(^AUPNVDXP(DA,0)) I '% Q

 S %=$G(^AUTTDXPR(%,0)) I %="" Q

 S A=$P(%,U,2),B=$P(%,U,3)

 I A'?1U Q

 I "LGDS"'[A Q

 D @("T"_A)

 Q

 ;

TL I B=6 S B=16

 S %=$G(^DIC(B,0,"GL")) I %="" Q

 S %="I $G("_%_"Y,0))'="""" S Y=$P("_%_"Y,0),U)"

 X %

 Q

 ;

TG ;

TS I B'[":" Q

 S B=";"_B

 I B'[(";"_Y_":") Q

 S B=$P(B,(";"_Y_":"),2),B=$P(B,";")

 I B="" Q

 S Y=B

 Q

 ;

TD X ^DD("DD")

 Q

 ;

AUPNVDXT  ; IHS/CMI/LAB - WASH ISC/GIS TJK OUTPUT TRANSFORMS FOR V DIAGNOSTIC PROCEDURE RESULT FILE ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ; WHEN THE NEW PERSON FILE IS INSTALLED CHANGE LINE TL+1 TO I B=6 S B=200

RUN        NEW %,A,B

 +1        IF $GET(Y)=""!('$DATA(DA))

               QUIT 

 +2        SET %=+$GET(^AUPNVDXP(DA,0))

           IF '%

               QUIT 

 +3        SET %=$GET(^AUTTDXPR(%,0))

           IF %=""

               QUIT 

 +4        SET A=$PIECE(%,U,2)

           SET B=$PIECE(%,U,3)

 +5        IF A'?1U

               QUIT 

 +6        IF "LGDS"'[A

               QUIT 

 +7        DO @("T"_A)

 +8        QUIT 

 +9       ;

TL         IF B=6

               SET B=16

 +1        SET %=$GET(^DIC(B,0,"GL"))

           IF %=""

               QUIT 

 +2        SET %="I $G("_%_"Y,0))'="""" S Y=$P("_%_"Y,0),U)"

 +3        XECUTE %

 +4        QUIT 

 +5       ;

TG        ;

TS         IF B'[":"

               QUIT 

 +1        SET B=";"_B

 +2        IF B'[(";"_Y_":")

               QUIT 

 +3        SET B=$PIECE(B,(";"_Y_":"),2)

           SET B=$PIECE(B,";")

 +4        IF B=""

               QUIT 

 +5        SET Y=B

 +6        QUIT 

 +7       ;

TD         XECUTE ^DD("DD")

 +1        QUIT 

 +2       ;