ABMDFALN.m

ABMDFALN ; IHS/ASDST/DMJ - ALIGNMENT TEST ; 

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;Original;TMD;03/28/96 1:01 PM

 W !

 S DIC="^ABMDEXP("

 S DIC(0)="AEMQ"

 S DIC("S")="I $P($G(^(1)),""^"",5)'=""E"""

 D ^DIC

 K DIC

 Q:Y<0

 S ABMP("EXP")=+Y

 I $P(^ABMDEXP(ABMP("EXP"),0),U,5)="" D  Q

 . W !,"TEST PRINT ROUTINE UNDEFINED FOR FORM "

 . W $P(^ABMDEXP(ABMP("EXP"),0),U)

 . Q

 ;

DEV ;OPEN DEVICE

 D ^%ZIS

 Q:POP

 ;

LOOP ;LOOP TILL IT'S RIGHT

 S Y=0

 F  D  Q:Y=1

 . I $D(IOP) D ^%ZIS K IOP I POP S Y=1 Q

 . U IO

 . D @("TEST^"_$P(^ABMDEXP(ABMP("EXP"),0),U,5))

 . W $$EN^ABMVDF("IOF")

 . I $D(IO("S")) S IOP=ION D ^%ZISC

 . U IO(0)

 . W !

 . S DIR(0)="Y"

 . S DIR("A")="IS THE ALIGNMENT CORRECT"

 . S DIR("B")="Y"

 . D ^DIR

 . K DIR

 D ^%ZISC

 K IOP

 Q

ABMDFALN  ; IHS/ASDST/DMJ - ALIGNMENT TEST ; 

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;Original;TMD;03/28/96 1:01 PM

 +3        WRITE !

 +4        SET DIC="^ABMDEXP("

 +5        SET DIC(0)="AEMQ"

 +6        SET DIC("S")="I $P($G(^(1)),""^"",5)'=""E"""

 +7        DO ^DIC

 +8        KILL DIC

 +9        IF Y<0

               QUIT 

 +10       SET ABMP("EXP")=+Y

 +11       IF $PIECE(^ABMDEXP(ABMP("EXP"),0),U,5)=""

               Begin DoDot:1

 +12               WRITE !,"TEST PRINT ROUTINE UNDEFINED FOR FORM "

 +13               WRITE $PIECE(^ABMDEXP(ABMP("EXP"),0),U)

 +14               QUIT 

               End DoDot:1

               QUIT 

 +15      ;

DEV       ;OPEN DEVICE

 +1        DO ^%ZIS

 +2        IF POP

               QUIT 

 +3       ;

LOOP      ;LOOP TILL IT'S RIGHT

 +1        SET Y=0

 +2        FOR 

               Begin DoDot:1

 +3                IF $DATA(IOP)

                       DO ^%ZIS

                       KILL IOP

                       IF POP

                           SET Y=1

                           QUIT 

 +4                USE IO

 +5                DO @("TEST^"_$PIECE(^ABMDEXP(ABMP("EXP"),0),U,5))

 +6                WRITE $$EN^ABMVDF("IOF")

 +7                IF $DATA(IO("S"))

                       SET IOP=ION

                       DO ^%ZISC

 +8                USE IO(0)

 +9                WRITE !

 +10               SET DIR(0)="Y"

 +11               SET DIR("A")="IS THE ALIGNMENT CORRECT"

 +12               SET DIR("B")="Y"

 +13               DO ^DIR

 +14               KILL DIR

               End DoDot:1

               IF Y=1

                   QUIT 

 +15       DO ^%ZISC

 +16       KILL IOP

 +17       QUIT