ACHS3PP5 ; IHS/ITSC/PMF - QUEUE THIRD PARTY PAYMENT REPORT (ALL PATIENTS) ; [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
;TPF COPIED FOR RE-WRITE FROM ACHS3PPQ
;
K ^TMP("ACHS3PP",$J)
S ACHSUSR=$$USR^ACHS
W !!!!,$$C^XBFUNC("****** 3rd PARTY PAYMENT REPORT FOR "_$$LOC^ACHS_" *****",80)
S ACHSFAC=DUZ(2)
;
FISYR ;Select Fiscal Year
S ACHSFY=$$FYSEL^ACHS
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(+Y)="" G REPTYP
W !
DIR2 ;
W !
K DIC
S DIC="^AUPNPAT(",DIC(0)="AEQM"
D ^DIC
I +Y<1,'$D(ACHSPAT) D END Q
I +Y<1,$D(ACHSPAT) G REPTYP ;PATIENT SELECTED
S:+Y>0 ACHSPAT(+Y)=""
G DIR2
;
REPTYP ;
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 which includes"
S DIR("?",2)="TOTALS AND PERCENTAGES ONLY."
S DIR("?",3)="Enter 'D' for a 'DETAILED' report which also includes"
S DIR("?")="LISTING OF INDIVIDUAL DOCUMENTS AND ALL ASSOCIATED DATA."
D ^DIR
G SELPAT:$D(DUOUT)
Q:$D(DTOUT)!$D(DIROUT)
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
I %=U!$D(DTOUT)!$D(DUOUT) D END Q
I %="B" D VIEWR^XBLM("^ACHS3PP3"),EN^XBVK("VALM"),END Q
S %ZIS="PQ"
D ^%ZIS
I POP W !,"NO DEVICE SELECTED - REQUEST ABORTED" D HOME^%ZIS D END:'$$DIR^XBDIR("E") G FISYR
I '$D(IO("Q")) W:'$D(IO("S")) ! D:'$D(IO("S")) WAIT^DICD D ^ACHS3PP3 Q
ZTLOAD ;Loads Taskman
S ZTRTN="^ACHS3PP3",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
Q
END ;
K DIC,DIR,DIROUT,DTOUT,DUOUT,ZTSK
D EN^XBVK("ACHS"),^ACHSVAR,HOME^%ZIS
Q
;
ACHS3PP5 ; IHS/ITSC/PMF - QUEUE THIRD PARTY PAYMENT REPORT (ALL PATIENTS) ; [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 ;TPF COPIED FOR RE-WRITE FROM ACHS3PPQ
+4 ;
+5 KILL ^TMP("ACHS3PP",$JOB)
+6 SET ACHSUSR=$$USR^ACHS
+7 WRITE !!!!,$$C^XBFUNC("****** 3rd PARTY PAYMENT REPORT FOR "_$$LOC^ACHS_" *****",80)
+8 SET ACHSFAC=DUZ(2)
+9 ;
FISYR ;Select Fiscal Year
+1 SET ACHSFY=$$FYSEL^ACHS
+2 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
DO END
QUIT
+3 ;
SELSER ;Select type of service
+1 KILL DIR,DIC,ACHSSER
+2 SET DIR("A")="Service Type"
SET DIR(0)="S^1:43 (HOSPITAL);2:57 (DENTAL);3:64 (OUTPATIENT);4:ALL"
SET DIR("B")="ALL"
+3 WRITE !
+4 DO ^DIR
+5 IF $DATA(DTOUT)!($DATA(DIROUT))
DO END
QUIT
+6 IF $DATA(DUOUT)
GOTO FISYR
+7 SET ACHSSER=Y
+8 ;
+9 ;
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(+Y)=""
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)
DO END
QUIT
+6 ;PATIENT SELECTED
IF +Y<1
IF $DATA(ACHSPAT)
GOTO REPTYP
+7 IF +Y>0
SET ACHSPAT(+Y)=""
+8 GOTO DIR2
+9 ;
REPTYP ;
+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 which includes"
+4 SET DIR("?",2)="TOTALS AND PERCENTAGES ONLY."
+5 SET DIR("?",3)="Enter 'D' for a 'DETAILED' report which also includes"
+6 SET DIR("?")="LISTING OF INDIVIDUAL DOCUMENTS AND ALL ASSOCIATED DATA."
+7 DO ^DIR
+8 IF $DATA(DUOUT)
GOTO SELPAT
+9 IF $DATA(DTOUT)!$DATA(DIROUT)
QUIT
+10 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 SET %=$$PB^ACHS
+4 IF %=U!$DATA(DTOUT)!$DATA(DUOUT)
DO END
QUIT
+5 IF %="B"
DO VIEWR^XBLM("^ACHS3PP3")
DO EN^XBVK("VALM")
DO END
QUIT
+6 SET %ZIS="PQ"
+7 DO ^%ZIS
+8 IF POP
WRITE !,"NO DEVICE SELECTED - REQUEST ABORTED"
DO HOME^%ZIS
IF '$$DIR^XBDIR("E")
DO END
GOTO FISYR
+9 IF '$DATA(IO("Q"))
IF '$DATA(IO("S"))
WRITE !
IF '$DATA(IO("S"))
DO WAIT^DICD
DO ^ACHS3PP3
QUIT
ZTLOAD ;Loads Taskman
+1 SET ZTRTN="^ACHS3PP3"
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
+6 QUIT
END ;
+1 KILL DIC,DIR,DIROUT,DTOUT,DUOUT,ZTSK
+2 DO EN^XBVK("ACHS")
DO ^ACHSVAR
DO HOME^%ZIS
+3 QUIT
+4 ;
