ACHSOCVQ.m

ACHSOCVQ ; IHS/ITSC/PMF - CHS OBJ CLASS CODE BY VENDOR ;   [ 10/16/2001   8:16 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 ;

 S ACHSUSR=$$USR^ACHS,ACHSFAC=$$LOC^ACHS

 W !!!!?10,"***** SERVICE CLASS CODE by VENDOR for "_ACHSFAC_" *****"

FISYR ;Select Fiscal Year

 S ACHSFY=$$FYSEL^ACHS

 G END:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)

REPTYP ;Choose Report Type

 K DIR

 S DIR(0)="S^S:SUMMARY;D:DETAILED",DIR("B")="Summary",DIR("A")="     Report Type "

 S DIR("?",1)="Enter 'S' or <RETURN> for a 'SUMMARY' report"

 S DIR("?",2)="which includes TOTALS and PERCENTAGES ONLY."

 S DIR("?",3)="Enter 'D' for a 'DETAILED' report"

 S DIR("?")="which includes PATIENT NAME, HRN, and VENDOR DATA."

 D ^DIR

 G FISYR:$D(DUOUT),END:$D(DTOUT)!$D(DIROUT)

 S ACHSRTYP=Y

DEVICE ;Select Device

 W *7,!!?20,"This report may take awhile to compile.",!?15,"It is recommended that you QUEUE to a PRINTER.",!

 K DIR

 S %=$$PB^ACHS

 I %=U!$D(DTOUT)!$D(DUOUT) D END Q

 I %="B" D VIEWR^XBLM($S(ACHSRTYP="S":"^ACHSOCV1",1:"^ACHSOCV2")),EN^XBVK("VALM"),END Q

 S %ZIS="PQ"

 D ^%ZIS

 I POP W !,"NO DEVICE SELECTED - REQUEST ABORTED" S DIR(0)="E" D ^DIR D HOME^%ZIS G END:Y=0,REPTYP:Y=1

 I '$D(IO("Q")) W:'$D(IO("S")) ! D:'$D(IO("S")) WAIT^DICD G ^ACHSOCV1:ACHSRTYP="S",^ACHSOCV2:ACHSRTYP="D"

 I $D(IO("S"))!($E(IOST)'="P") G DEVICE

ZTLOAD ;Loads Taskman

 S ZTRTN=$S(ACHSRTYP="S":"^ACHSOCV1",ACHSRTYP="D":"^ACHSOCV2"),ZTIO="",ZTDESC="OBJ CLASS by VENDOR,"_$S(ACHSRTYP="S":"SUMMARY",1:"DETAIL"),ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL

 F %="ACHSUSR","ACHSQIO","ACHSFY","ACHSFAC" S ZTSAVE(%)=""

 D ^%ZTLOAD

 K IO("Q")

 D HOME^%ZIS

 K IOP

END ;

 K DIR,DIC,DIROUT,DTOUT,DUOUT

 D EN^XBVK("ACHS"),^ACHSVAR,HOME^%ZIS

 Q

 ;

ACHSOCVQ  ; IHS/ITSC/PMF - CHS OBJ CLASS CODE BY VENDOR ;   [ 10/16/2001   8:16 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 +2       ;

 +3        SET ACHSUSR=$$USR^ACHS

           SET ACHSFAC=$$LOC^ACHS

 +4        WRITE !!!!?10,"***** SERVICE CLASS CODE by VENDOR for "_ACHSFAC_" *****"

FISYR     ;Select Fiscal Year

 +1        SET ACHSFY=$$FYSEL^ACHS

 +2        IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               GOTO END

REPTYP    ;Choose Report Type

 +1        KILL DIR

 +2        SET DIR(0)="S^S:SUMMARY;D:DETAILED"

           SET DIR("B")="Summary"

           SET DIR("A")="     Report Type "

 +3        SET DIR("?",1)="Enter 'S' or <RETURN> for a 'SUMMARY' report"

 +4        SET DIR("?",2)="which includes TOTALS and PERCENTAGES ONLY."

 +5        SET DIR("?",3)="Enter 'D' for a 'DETAILED' report"

 +6        SET DIR("?")="which includes PATIENT NAME, HRN, and VENDOR DATA."

 +7        DO ^DIR

 +8        IF $DATA(DUOUT)

               GOTO FISYR

           IF $DATA(DTOUT)!$DATA(DIROUT)

               GOTO END

 +9        SET ACHSRTYP=Y

DEVICE    ;Select Device

 +1        WRITE *7,!!?20,"This report may take awhile to compile.",!?15,"It is recommended that you QUEUE to a PRINTER.",!

 +2        KILL DIR

 +3        SET %=$$PB^ACHS

 +4        IF %=U!$DATA(DTOUT)!$DATA(DUOUT)

               DO END

               QUIT 

 +5        IF %="B"

               DO VIEWR^XBLM($SELECT(ACHSRTYP="S":"^ACHSOCV1",1:"^ACHSOCV2"))

               DO EN^XBVK("VALM")

               DO END

               QUIT 

 +6        SET %ZIS="PQ"

 +7        DO ^%ZIS

 +8        IF POP

               WRITE !,"NO DEVICE SELECTED - REQUEST ABORTED"

               SET DIR(0)="E"

               DO ^DIR

               DO HOME^%ZIS

               IF Y=0

                   GOTO END

               IF Y=1

                   GOTO REPTYP

 +9        IF '$DATA(IO("Q"))

               IF '$DATA(IO("S"))

                   WRITE !

               IF '$DATA(IO("S"))

                   DO WAIT^DICD

               IF ACHSRTYP="S"

                   GOTO ^ACHSOCV1

               IF ACHSRTYP="D"

                   GOTO ^ACHSOCV2

 +10       IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")

               GOTO DEVICE

ZTLOAD    ;Loads Taskman

 +1        SET ZTRTN=$SELECT(ACHSRTYP="S":"^ACHSOCV1",ACHSRTYP="D":"^ACHSOCV2")

           SET ZTIO=""

           SET ZTDESC="OBJ CLASS by VENDOR,"_$SELECT(ACHSRTYP="S":"SUMMARY",1:"DETAIL")

           SET ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL

 +2        FOR %="ACHSUSR","ACHSQIO","ACHSFY","ACHSFAC"

               SET ZTSAVE(%)=""

 +3        DO ^%ZTLOAD

 +4        KILL IO("Q")

 +5        DO HOME^%ZIS

 +6        KILL IOP

END       ;

 +1        KILL DIR,DIC,DIROUT,DTOUT,DUOUT

 +2        DO EN^XBVK("ACHS")

           DO ^ACHSVAR

           DO HOME^%ZIS

 +3        QUIT 

 +4       ;