AMQQAV.m

AMQQAV ; IHS/CMI/THL - AMQQAT SUBROUTINE...GETS COMPARISON VALUES ;

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

 ;-----

 I $D(AMQQSQRD) D EN1^AMQQAVR G EXIT

 I $D(AMQQSVAL) D  Q

 .K AMQQCOMP

 .I $D(Y) S %=$G(^AMQQ(5,+Y,0)) I $P(%,U,3)=7!($P(%,U,20)="D") S X=AMQQSVAL,%DT="" D ^%DT K:Y<1 AMQQSVAL S:Y>0 AMQQSVAL=Y

 .I '$D(AMQQSVAL) W "  ??",*7 H 1

 .I $D(AMQQSVAL) S AMQQCOMP=+AMQQSVAL

 .K AMQQSVAL

 I $D(AMQQNATF),$P(AMQQNATF,";",2)'="" S AMQQCOMP=$P(AMQQNATF,";",2) Q

RUN D @("COMP"_AMQQFTYP)

EXIT K %DT,A,B,AMQQSQRD

 Q

 ;

COMPA D COMPA^AMQQAV0

 Q

 ;

COMPD I AMQQATNM="ALIVE" D ALIVE Q

 D COMPD^AMQQAV0

 Q

 ;

COMPS D COMPS^AMQQAV0

 Q

 ;

COMPN D COMPN^AMQQAV0

 Q

 ;

COMPL S DIC("A")="Enter "_AMQQATNM_": "

 S DIC=$P(^AMQQ(1,AMQQLINK,0),U,2)

 S DIC(0)="AEQ"

 D ^DIC

 K DIC

 I X=U S AMQQQUIT="" Q

 I X="" Q

 S AMQQCOMP=+Y

 Q

 ;

COMPQ D COMPQ^AMQQAV1

 Q

 ;

COMPF D COMPF^AMQQAV1

 Q

 ;

COMPZ D COMPZ^AMQQAV1

 Q

 ;

COMPB D ^AMQQAVB

 Q

 ;

COMPT D COMPT^AMQQAV2

 Q

 ;

COMPC S AMQQCOMP=AMQQCHRT K AMQQCHRT

 Q

 ;

COMPV D COMPV^AMQQAV2

 Q

 ;

COMPX D ^AMQQSQ

 Q

 ;

ALIVE ; ENTRY POINT FROM AMQQAV0

 S %DT="AEX"

 S %DT("A")="Alive at least until exactly what date: "

 S %DT("B")="TODAY"

 I $D(AMQQADAM) S %DT="AE"

 D ^%DT

 I $D(DTOUT) S X=U K DTOUT

 I Y'=-1 S AMQQCOMP=Y Q

 I $E(X)=U S AMQQQUIT=""

 Q

 ;

AMQQAV    ; IHS/CMI/THL - AMQQAT SUBROUTINE...GETS COMPARISON VALUES ;

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

 +2       ;-----

 +3        IF $DATA(AMQQSQRD)

               DO EN1^AMQQAVR

               GOTO EXIT

 +4        IF $DATA(AMQQSVAL)

               Begin DoDot:1

 +5                KILL AMQQCOMP

 +6                IF $DATA(Y)

                       SET %=$GET(^AMQQ(5,+Y,0))

                       IF $PIECE(%,U,3)=7!($PIECE(%,U,20)="D")

                           SET X=AMQQSVAL

                           SET %DT=""

                           DO ^%DT

                           IF Y<1

                               KILL AMQQSVAL

                           IF Y>0

                               SET AMQQSVAL=Y

 +7                IF '$DATA(AMQQSVAL)

                       WRITE "  ??",*7

                       HANG 1

 +8                IF $DATA(AMQQSVAL)

                       SET AMQQCOMP=+AMQQSVAL

 +9                KILL AMQQSVAL

               End DoDot:1

               QUIT 

 +10       IF $DATA(AMQQNATF)

               IF $PIECE(AMQQNATF,";",2)'=""

                   SET AMQQCOMP=$PIECE(AMQQNATF,";",2)

                   QUIT 

RUN        DO @("COMP"_AMQQFTYP)

EXIT       KILL %DT,A,B,AMQQSQRD

 +1        QUIT 

 +2       ;

COMPA      DO COMPA^AMQQAV0

 +1        QUIT 

 +2       ;

COMPD      IF AMQQATNM="ALIVE"

               DO ALIVE

               QUIT 

 +1        DO COMPD^AMQQAV0

 +2        QUIT 

 +3       ;

COMPS      DO COMPS^AMQQAV0

 +1        QUIT 

 +2       ;

COMPN      DO COMPN^AMQQAV0

 +1        QUIT 

 +2       ;

COMPL      SET DIC("A")="Enter "_AMQQATNM_": "

 +1        SET DIC=$PIECE(^AMQQ(1,AMQQLINK,0),U,2)

 +2        SET DIC(0)="AEQ"

 +3        DO ^DIC

 +4        KILL DIC

 +5        IF X=U

               SET AMQQQUIT=""

               QUIT 

 +6        IF X=""

               QUIT 

 +7        SET AMQQCOMP=+Y

 +8        QUIT 

 +9       ;

COMPQ      DO COMPQ^AMQQAV1

 +1        QUIT 

 +2       ;

COMPF      DO COMPF^AMQQAV1

 +1        QUIT 

 +2       ;

COMPZ      DO COMPZ^AMQQAV1

 +1        QUIT 

 +2       ;

COMPB      DO ^AMQQAVB

 +1        QUIT 

 +2       ;

COMPT      DO COMPT^AMQQAV2

 +1        QUIT 

 +2       ;

COMPC      SET AMQQCOMP=AMQQCHRT

           KILL AMQQCHRT

 +1        QUIT 

 +2       ;

COMPV      DO COMPV^AMQQAV2

 +1        QUIT 

 +2       ;

COMPX      DO ^AMQQSQ

 +1        QUIT 

 +2       ;

ALIVE     ; ENTRY POINT FROM AMQQAV0

 +1        SET %DT="AEX"

 +2        SET %DT("A")="Alive at least until exactly what date: "

 +3        SET %DT("B")="TODAY"

 +4        IF $DATA(AMQQADAM)

               SET %DT="AE"

 +5        DO ^%DT

 +6        IF $DATA(DTOUT)

               SET X=U

               KILL DTOUT

 +7        IF Y'=-1

               SET AMQQCOMP=Y

               QUIT 

 +8        IF $EXTRACT(X)=U

               SET AMQQQUIT=""

 +9        QUIT 

 +10      ;