ACHS3PPQ.m

ACHS3PPQ ; IHS/ITSC/TPF/PMF - QUEUE THIRD PARTY PAYMENT REPORT (ALL PATIENTS) ;  

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

 ;

 K ^TMP("ACHS3PP",$J)

 ;

 S ACHSUSR=$$USR^ACHS          ;GET USER BASED ON VA(200 ENTRY

 ;

 W !!!!,$$C^XBFUNC("****** 3rd PARTY PAYMENT REPORT FOR "_$$LOC^ACHS_" *****",80)

 S ACHSFAC=DUZ(2)

 ;

FISYR ;Select Fiscal Year

 ;

 S ACHSFY=$$FYSEL^ACHS          ;FISCAL YEAR SELECTION

 I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) D END Q

 ;

SELSER ;Select type of service

 ;

 K DIR,DIC,ACHSSER

 ;

 S DIR("A")="Service Type",DIR(0)="S^1:43 (HOSPITAL);2:57 (DENTAL);3:64 (OUTPATIENT);4:ALL" S DIR("B")="ALL"

 W !

 D ^DIR

 I $D(DTOUT)!($D(DIROUT)) D END Q

 G FISYR:$D(DUOUT)

 S ACHSSER=Y

 ;

SELPAT ;Patient Selection

 K DIR,ACHSPAT

 S DIR(0)="Y",DIR("A")="Include ALL PATIENTS",DIR("B")="YES"

 W !

 D ^DIR

 I $D(DTOUT)!($D(DIROUT)) D END Q

 G SELSER:$D(DUOUT)

 I Y=1 S ACHSPAT(0)="" G REPTYP

 W !

DIR2 ;

 W !

 K DIC

 S DIC="^AUPNPAT(",DIC(0)="AEQM"

 D ^DIC

 I +Y<1,'$D(ACHSPAT) G END

 I +Y<1,$D(ACHSPAT) G REPTYP

 S:+Y>0 ACHSPAT(+Y)=""

 G DIR2

 ;

REPTYP ;

 K DIR

 ;ACHS*3.1*16 IHS.OIT.FCJ ADDED D AND T TO NXT SECTION

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

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

 S:$D(ACHSPAT(0)) DIR(0)=DIR(0)_";T:THIRD PARTY;P:THIRD PARTY DETAILED"

 S DIR("B")="Summary",DIR("A")="     Report Type "

 S DIR("?",1)="Enter 'S' or <RETURN> for a 'SUMMARY' report with Totals and Percentages Only."

 S:$D(ACHSPAT(0)) DIR("?",2)="Enter 'D' for a detailed report which contains a list of PO information."

 S:$D(ACHSPAT(0)) DIR("?",3)="Enter 'T' for a Report that contains Totals by Third Party payor."

 S DIR("?")="Enter 'P' for a report that contains PO information by Third Party Payor."

 D ^DIR

 I $D(DTOUT)!($D(DIROUT)) D END Q

 G SELPAT:$D(DUOUT)

 S ACHSRTYP=Y

DEVICE ;Device Selection

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

 K DIR

 S %=$$PB^ACHS                        ;PRINT OR BROWSE PROMPT

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

 ;

 ;         DISPLAY PRINTOUT OF RTN? ,  KILL VALM* NAMESPACE VARS

 I %="B" D VIEWR^XBLM("^ACHS3PPC"),EN^XBVK("VALM"),END Q

 ;

 ;

 S %ZIS="PQ"

 D ^%ZIS

 I POP W !,"NO DEVICE SELECTED - REQUEST ABORTED" D HOME^%ZIS G END:'$$DIR^XBDIR("E"),FISYR

 ;

 ;                               ;IF SLAVE COMPILE CHS THIRD PARTY

 ;                               ;PAYMENT (ALL PATIENTS)

 I '$D(IO("Q")) W:'$D(IO("S")) ! D:'$D(IO("S")) WAIT^DICD G ^ACHS3PPC

 ;

ZTLOAD ;Loads Taskman

 S ZTRTN="^ACHS3PPC",ZTIO="",ZTDESC="3RD PARTY PAYMENT REPORT",ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL

 F %="ACHSPAT(","ACHSFY","ACHSUSR","ACHSQIO","ACHSSER","ACHSFAC","ACHSCFY","ACHSFYWK","ACHSRTYP" S ZTSAVE(%)=""

 D ^%ZTLOAD

 K IO("Q")

 D HOME^%ZIS

END ;

 K DIC,DIR,DIROUT,DTOUT,DUOUT,ZTSK

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

 Q

 ;

ACHS3PPQ  ; IHS/ITSC/TPF/PMF - QUEUE THIRD PARTY PAYMENT REPORT (ALL PATIENTS) ;  

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

 +2       ;

 +3        KILL ^TMP("ACHS3PP",$JOB)

 +4       ;

 +5       ;GET USER BASED ON VA(200 ENTRY

           SET ACHSUSR=$$USR^ACHS

 +6       ;

 +7        WRITE !!!!,$$C^XBFUNC("****** 3rd PARTY PAYMENT REPORT FOR "_$$LOC^ACHS_" *****",80)

 +8        SET ACHSFAC=DUZ(2)

 +9       ;

FISYR     ;Select Fiscal Year

 +1       ;

 +2       ;FISCAL YEAR SELECTION

           SET ACHSFY=$$FYSEL^ACHS

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

               DO END

               QUIT 

 +4       ;

SELSER    ;Select type of service

 +1       ;

 +2        KILL DIR,DIC,ACHSSER

 +3       ;

 +4        SET DIR("A")="Service Type"

           SET DIR(0)="S^1:43 (HOSPITAL);2:57 (DENTAL);3:64 (OUTPATIENT);4:ALL"

           SET DIR("B")="ALL"

 +5        WRITE !

 +6        DO ^DIR

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

               DO END

               QUIT 

 +8        IF $DATA(DUOUT)

               GOTO FISYR

 +9        SET ACHSSER=Y

 +10      ;

SELPAT    ;Patient Selection

 +1        KILL DIR,ACHSPAT

 +2        SET DIR(0)="Y"

           SET DIR("A")="Include ALL PATIENTS"

           SET DIR("B")="YES"

 +3        WRITE !

 +4        DO ^DIR

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

               DO END

               QUIT 

 +6        IF $DATA(DUOUT)

               GOTO SELSER

 +7        IF Y=1

               SET ACHSPAT(0)=""

               GOTO REPTYP

 +8        WRITE !

DIR2      ;

 +1        WRITE !

 +2        KILL DIC

 +3        SET DIC="^AUPNPAT("

           SET DIC(0)="AEQM"

 +4        DO ^DIC

 +5        IF +Y<1

               IF '$DATA(ACHSPAT)

                   GOTO END

 +6        IF +Y<1

               IF $DATA(ACHSPAT)

                   GOTO REPTYP

 +7        IF +Y>0

               SET ACHSPAT(+Y)=""

 +8        GOTO DIR2

 +9       ;

REPTYP    ;

 +1        KILL DIR

 +2       ;ACHS*3.1*16 IHS.OIT.FCJ ADDED D AND T TO NXT SECTION

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

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

 +5        IF $DATA(ACHSPAT(0))

               SET DIR(0)=DIR(0)_";T:THIRD PARTY;P:THIRD PARTY DETAILED"

 +6        SET DIR("B")="Summary"

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

 +7        SET DIR("?",1)="Enter 'S' or <RETURN> for a 'SUMMARY' report with Totals and Percentages Only."

 +8        IF $DATA(ACHSPAT(0))

               SET DIR("?",2)="Enter 'D' for a detailed report which contains a list of PO information."

 +9        IF $DATA(ACHSPAT(0))

               SET DIR("?",3)="Enter 'T' for a Report that contains Totals by Third Party payor."

 +10       SET DIR("?")="Enter 'P' for a report that contains PO information by Third Party Payor."

 +11       DO ^DIR

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

               DO END

               QUIT 

 +13       IF $DATA(DUOUT)

               GOTO SELPAT

 +14       SET ACHSRTYP=Y

DEVICE    ;Device Selection

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

 +2        KILL DIR

 +3       ;PRINT OR BROWSE PROMPT

           SET %=$$PB^ACHS

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

               DO END

               QUIT 

 +5       ;

 +6       ;         DISPLAY PRINTOUT OF RTN? ,  KILL VALM* NAMESPACE VARS

 +7        IF %="B"

               DO VIEWR^XBLM("^ACHS3PPC")

               DO EN^XBVK("VALM")

               DO END

               QUIT 

 +8       ;

 +9       ;

 +10       SET %ZIS="PQ"

 +11       DO ^%ZIS

 +12       IF POP

               WRITE !,"NO DEVICE SELECTED - REQUEST ABORTED"

               DO HOME^%ZIS

               IF '$$DIR^XBDIR("E")

                   GOTO END

               GOTO FISYR

 +13      ;

 +14      ;                               ;IF SLAVE COMPILE CHS THIRD PARTY

 +15      ;                               ;PAYMENT (ALL PATIENTS)

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

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

                   WRITE !

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

                   DO WAIT^DICD

               GOTO ^ACHS3PPC

 +17      ;

ZTLOAD    ;Loads Taskman

 +1        SET ZTRTN="^ACHS3PPC"

           SET ZTIO=""

           SET ZTDESC="3RD PARTY PAYMENT REPORT"

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

 +2        FOR %="ACHSPAT(","ACHSFY","ACHSUSR","ACHSQIO","ACHSSER","ACHSFAC","ACHSCFY","ACHSFYWK","ACHSRTYP"

               SET ZTSAVE(%)=""

 +3        DO ^%ZTLOAD

 +4        KILL IO("Q")

 +5        DO HOME^%ZIS

END       ;

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

 +2        DO EN^XBVK("ACHS")

           DO ^ACHSVAR

           DO HOME^%ZIS

 +3        QUIT 

 +4       ;