ACHSYM.m

ACHSYM ; IHS/ITSC/PMF - CHS PROGRAMMER UTILITIES MENU DRIVER ;

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**11,12,13,18**;JUN 11, 2001

 ;ITSC/SET/JVK ACHS*3.1*11 ADDED THE 4 YEAR EXPORT CALL

 ;ITSC/SET/JVK ACHS*3.1*12 REMOVE THE 4 YEAR EXPORT CALL

 ;ACHS*3.1*13 12.7.06 IHS/OIT/FCJ ADDED ACHSRMVD TO MENU OPTIONS

 ;

 ;  Note:  If you want any other routines to appear on the programmer

 ;         utility menu produced by this routine, add the name of the

 ;         routine after the label R.

 ;

 D HOME^%ZIS,DT^DICRW,^XBKTMP:$L($T(^XBKTMP))

 I '$$RSEL^ZIBRSEL("ACHSY*","^TMP(""ACHSYM"",$J,") W !,"No ""ACHSY*"" Routines to process..." Q

 K ^TMP("ACHSYM",$J,"ACHSYM") ; Don't show THIS routine.

 F %=1:1 S X=$P($T(R+%),";",3) Q:X="###"  S ^TMP("ACHSYM",$J,X)=""

START ;

 W @IOF,!!,$$C^XBFUNC("***   "_$P($P($T(+1),"-",2),";",1)_"   ***"),!!

 N ACHS,C,R

 S R=""

 F C=1:1 S R=$O(^TMP("ACHSYM",$J,R)) Q:'$L(R)  D

 . S X=R,DIF="^TMP(""ACHSYM"",$J,""R"",",XCNP=0

 . X ^%ZOSF("LOAD")

 . S ACHS(C)=R_U_$P($P($G(^TMP("ACHSYM",$J,"R",1,0)),"-",2),";",1)

 . W !,$J(C,2),". ",U,R," -",$P(ACHS(C),U,2)

 . I (R="ACHSYCN")!(R="ACHSYCS") W !,?6,"No longer available for UFMS type records" ;ACHS*3.1*18 IHS/OIT/FCJ ADDED NEW LINE

 . K ^TMP("ACHSYM",$J,"R")

 .Q

 S ACHS=$$DIR^XBDIR("FO^1:"_($L(C)+1),"     Select # to run or ""?#"" for help","","","","",1)

 Q:$D(DUOUT)!$D(DTOUT)!('$L(ACHS))

 I ACHS?1"?"1N.E,+$E(ACHS,2,99)>0,+$E(ACHS,2,99)<C D HELP($P(ACHS(+$E(ACHS,2,99)),U))

 Q:$D(DUOUT)!$D(DTOUT)

 I ACHS,ACHS>0,ACHS<(C+1) D RUN($P(ACHS(ACHS),U)) I 1

 E  W *7,"    ??"

 G START

 ;

HELP(R) ; 

 N ACHS,ACHSGURF,C,QT

 S QT=""""

 S ACHSGURF="K"_" ^UTILIT"_"Y("_$J_")"

 X ACHSGURF

 S ACHSGURF="S"_" ^UTILIT"_"Y("_$J_","_QT_R_QT_")="_QT_QT

 X ACHSGURF

 D EN^XBRPTL

 S C=$$DIR^XBDIR("EO")

 Q

 ;

RUN(R) ;

 N ACHS,C

 D @(U_R)

 S C=$$DIR^XBDIR("EO")

 Q

 ;

 ;ACHS*3.1*13 12.7.06 IHS/OIT/FCJ ADDED ACHSRMVD TO MENU OPTIONS

R ; Non-namespaced routines that you want to appear on the menu.

 ;;ACHSSTL

 ;;ACHSBRF

 ;;ACHSRMVD

 ;;###

 ;;;ACHSTXP-REMOVED ACHS*3.1*12

ACHSYM    ; IHS/ITSC/PMF - CHS PROGRAMMER UTILITIES MENU DRIVER ;

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**11,12,13,18**;JUN 11, 2001

 +2       ;ITSC/SET/JVK ACHS*3.1*11 ADDED THE 4 YEAR EXPORT CALL

 +3       ;ITSC/SET/JVK ACHS*3.1*12 REMOVE THE 4 YEAR EXPORT CALL

 +4       ;ACHS*3.1*13 12.7.06 IHS/OIT/FCJ ADDED ACHSRMVD TO MENU OPTIONS

 +5       ;

 +6       ;  Note:  If you want any other routines to appear on the programmer

 +7       ;         utility menu produced by this routine, add the name of the

 +8       ;         routine after the label R.

 +9       ;

 +10       DO HOME^%ZIS

           DO DT^DICRW

           IF $LENGTH($TEXT(^XBKTMP))

               DO ^XBKTMP

 +11       IF '$$RSEL^ZIBRSEL("ACHSY*","^TMP(""ACHSYM"",$J,")

               WRITE !,"No ""ACHSY*"" Routines to process..."

               QUIT 

 +12      ; Don't show THIS routine.

           KILL ^TMP("ACHSYM",$JOB,"ACHSYM")

 +13       FOR %=1:1

               SET X=$PIECE($TEXT(R+%),";",3)

               IF X="###"

                   QUIT 

               SET ^TMP("ACHSYM",$JOB,X)=""

START     ;

 +1        WRITE @IOF,!!,$$C^XBFUNC("***   "_$PIECE($PIECE($TEXT(+1),"-",2),";",1)_"   ***"),!!

 +2        NEW ACHS,C,R

 +3        SET R=""

 +4        FOR C=1:1

               SET R=$ORDER(^TMP("ACHSYM",$JOB,R))

               IF '$LENGTH(R)

                   QUIT 

               Begin DoDot:1

 +5                SET X=R

                   SET DIF="^TMP(""ACHSYM"",$J,""R"","

                   SET XCNP=0

 +6                XECUTE ^%ZOSF("LOAD")

 +7                SET ACHS(C)=R_U_$PIECE($PIECE($GET(^TMP("ACHSYM",$JOB,"R",1,0)),"-",2),";",1)

 +8                WRITE !,$JUSTIFY(C,2),". ",U,R," -",$PIECE(ACHS(C),U,2)

 +9       ;ACHS*3.1*18 IHS/OIT/FCJ ADDED NEW LINE

                   IF (R="ACHSYCN")!(R="ACHSYCS")

                       WRITE !,?6,"No longer available for UFMS type records"

 +10               KILL ^TMP("ACHSYM",$JOB,"R")

 +11               QUIT 

               End DoDot:1

 +12       SET ACHS=$$DIR^XBDIR("FO^1:"_($LENGTH(C)+1),"     Select # to run or ""?#"" for help","","","","",1)

 +13       IF $DATA(DUOUT)!$DATA(DTOUT)!('$LENGTH(ACHS))

               QUIT 

 +14       IF ACHS?1"?"1N.E

               IF +$EXTRACT(ACHS,2,99)>0

                   IF +$EXTRACT(ACHS,2,99)<C

                       DO HELP($PIECE(ACHS(+$EXTRACT(ACHS,2,99)),U))

 +15       IF $DATA(DUOUT)!$DATA(DTOUT)

               QUIT 

 +16       IF ACHS

               IF ACHS>0

                   IF ACHS<(C+1)

                       DO RUN($PIECE(ACHS(ACHS),U))

                       IF 1

 +17      IF '$TEST

               WRITE *7,"    ??"

 +18       GOTO START

 +19      ;

HELP(R)   ; 

 +1        NEW ACHS,ACHSGURF,C,QT

 +2        SET QT=""""

 +3        SET ACHSGURF="K"_" ^UTILIT"_"Y("_$JOB_")"

 +4        XECUTE ACHSGURF

 +5        SET ACHSGURF="S"_" ^UTILIT"_"Y("_$JOB_","_QT_R_QT_")="_QT_QT

 +6        XECUTE ACHSGURF

 +7        DO EN^XBRPTL

 +8        SET C=$$DIR^XBDIR("EO")

 +9        QUIT 

 +10      ;

RUN(R)    ;

 +1        NEW ACHS,C

 +2        DO @(U_R)

 +3        SET C=$$DIR^XBDIR("EO")

 +4        QUIT 

 +5       ;

 +6       ;ACHS*3.1*13 12.7.06 IHS/OIT/FCJ ADDED ACHSRMVD TO MENU OPTIONS

R         ; Non-namespaced routines that you want to appear on the menu.

 +1       ;;ACHSSTL

 +2       ;;ACHSBRF

 +3       ;;ACHSRMVD

 +4       ;;###

 +5       ;;;ACHSTXP-REMOVED ACHS*3.1*12