- 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 ;
