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 ;
