AFSHSELX.m

AFSHSELX ;IHS/OIRM/DSD/JDM-SET SELECTED BATCH FOR EXPORT (SPLITOUT); [ 10/27/2004   4:20 PM ]

 ;;3.0T1;AO FINANCIAL DATA MGMT SYSTEM;**13**;FEB 02, 1999

 ;;MODIFIED FOR CACHE' COMPLIANCE ;ACR*2.1*9

GETTYCLR ;

 D ^XBCLS

 W !,?20,"SELECTION OF BATCH(ES) FOR EXPORT",!!

 W !,?5,"You must now select the batches you wish to be included in the splitout."

 W !!

 I $D(AFSHSKPA) K AFSHSKPA S AFSHTYCL=AFSHBCLR G SETDIE

 K DIR S DIR(0)="S^1:PCC-BLUE;2:PCC-RED;3:BCBS-BLUE;4:BCBS-RED;5:ARMS-BLUE;6:ARMS-RED"

 S DIR("A")="ENTER TYPE-COLOR OF BATCH "

 D ^DIR

 I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S AFSHSABT=1 G ENDIT

 S AFSHTYCL=X

 S A=0 D CLRSEL

SETDIE ;

 S DIE="^AFSHRCDS(",DA=AFSHTYCL,DR="[AFSH.SELECT EXPORT]"

RSET ;

 D ^DIE

 I $D(Y) W !,"COULD NOT COMPLETE THE REQUEST.  NOTIFY SUPERVISOR."

 W !

 K DIR S DIR(0)="Y",DIR("A")="ANOTHER BATCH? ",DIR("B")="Y" D ^DIR

 I $D(DTOUT)!($D(DIRUT))!($D(DUOUT)) G ENDIT

 I X="Y"!(X="y") W ! G RSET

 I $D(DTOUT)!($D(DIRUT))!($D(DUOUT)) G ENDIT

 I X="Y"!(X="y") W ! G RSET

ENDIT ;

 I '$D(Y) W !,"PROCESS COMPLETED."

 W !!,"***NOTE*** ALL BATCHES SELECTED FOR EXPORT MUST HAVE A TRAILER!!!",!

 ;R !,"PRESS <RETURN>",AFSHRTNX:300        ; ACR*2.1*13.02 IM13574

 D PAUSE^ACRFWARN                          ; ACR*2.1*13.02 IM13574

 K DIE,DA,DR,DIR,DTOUT,DUOUT,DIRUT,DIROUT,AFSHTYCL,AFSHRTNX,%,D,D0,D1,D2,DI,DQ,DIC

 D PREXPORT^AFSHVKIL

 Q

CLRSEL ;

 I '$O(^AFSHRCDS(A)) Q

 S A=$O(^AFSHRCDS(A))

 S B=0 D B1

 G CLRSEL

 Q

B1 ;

 I '$O(^AFSHRCDS(A,"D",B)) Q

 S B=$O(^AFSHRCDS(A,"D",B))

 S C=0 D C1

 G B1

C1 ;

 I '$O(^AFSHRCDS(A,"D",B,"I",C)) Q

 S C=$O(^AFSHRCDS(A,"D",B,"I",C))

 S $P(^AFSHRCDS(A,"D",B,"I",C,0),U,8)=""

 G C1

AFSHSELX  ;IHS/OIRM/DSD/JDM-SET SELECTED BATCH FOR EXPORT (SPLITOUT); [ 10/27/2004   4:20 PM ]

 +1       ;;3.0T1;AO FINANCIAL DATA MGMT SYSTEM;**13**;FEB 02, 1999

 +2       ;;MODIFIED FOR CACHE' COMPLIANCE ;ACR*2.1*9

GETTYCLR  ;

 +1        DO ^XBCLS

 +2        WRITE !,?20,"SELECTION OF BATCH(ES) FOR EXPORT",!!

 +3        WRITE !,?5,"You must now select the batches you wish to be included in the splitout."

 +4        WRITE !!

 +5        IF $DATA(AFSHSKPA)

               KILL AFSHSKPA

               SET AFSHTYCL=AFSHBCLR

               GOTO SETDIE

 +6        KILL DIR

           SET DIR(0)="S^1:PCC-BLUE;2:PCC-RED;3:BCBS-BLUE;4:BCBS-RED;5:ARMS-BLUE;6:ARMS-RED"

 +7        SET DIR("A")="ENTER TYPE-COLOR OF BATCH "

 +8        DO ^DIR

 +9        IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))

               SET AFSHSABT=1

               GOTO ENDIT

 +10       SET AFSHTYCL=X

 +11       SET A=0

           DO CLRSEL

SETDIE    ;

 +1        SET DIE="^AFSHRCDS("

           SET DA=AFSHTYCL

           SET DR="[AFSH.SELECT EXPORT]"

RSET      ;

 +1        DO ^DIE

 +2        IF $DATA(Y)

               WRITE !,"COULD NOT COMPLETE THE REQUEST.  NOTIFY SUPERVISOR."

 +3        WRITE !

 +4        KILL DIR

           SET DIR(0)="Y"

           SET DIR("A")="ANOTHER BATCH? "

           SET DIR("B")="Y"

           DO ^DIR

 +5        IF $DATA(DTOUT)!($DATA(DIRUT))!($DATA(DUOUT))

               GOTO ENDIT

 +6        IF X="Y"!(X="y")

               WRITE !

               GOTO RSET

 +7        IF $DATA(DTOUT)!($DATA(DIRUT))!($DATA(DUOUT))

               GOTO ENDIT

 +8        IF X="Y"!(X="y")

               WRITE !

               GOTO RSET

ENDIT     ;

 +1        IF '$DATA(Y)

               WRITE !,"PROCESS COMPLETED."

 +2        WRITE !!,"***NOTE*** ALL BATCHES SELECTED FOR EXPORT MUST HAVE A TRAILER!!!",!

 +3       ;R !,"PRESS <RETURN>",AFSHRTNX:300        ; ACR*2.1*13.02 IM13574

 +4       ; ACR*2.1*13.02 IM13574

           DO PAUSE^ACRFWARN

 +5        KILL DIE,DA,DR,DIR,DTOUT,DUOUT,DIRUT,DIROUT,AFSHTYCL,AFSHRTNX,%,D,D0,D1,D2,DI,DQ,DIC

 +6        DO PREXPORT^AFSHVKIL

 +7        QUIT 

CLRSEL    ;

 +1        IF '$ORDER(^AFSHRCDS(A))

               QUIT 

 +2        SET A=$ORDER(^AFSHRCDS(A))

 +3        SET B=0

           DO B1

 +4        GOTO CLRSEL

 +5        QUIT 

B1        ;

 +1        IF '$ORDER(^AFSHRCDS(A,"D",B))

               QUIT 

 +2        SET B=$ORDER(^AFSHRCDS(A,"D",B))

 +3        SET C=0

           DO C1

 +4        GOTO B1

C1        ;

 +1        IF '$ORDER(^AFSHRCDS(A,"D",B,"I",C))

               QUIT 

 +2        SET C=$ORDER(^AFSHRCDS(A,"D",B,"I",C))

 +3        SET $PIECE(^AFSHRCDS(A,"D",B,"I",C,0),U,8)=""

 +4        GOTO C1