ACHSVUR ; IHS/ITSC/PMF - VENDOR USAGE REPORT ; [ 10/31/2003 12:12 PM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**6,18**;JUN 11, 2001
;
;9/11/00 added verification of eligbility dates. Changes
; are courtesy of Jeanette Kompkoff, presently
; of the Portland office
;ACHS*3.1*6 5/2/2003 /ITSC/SET/JVK ADDED FIX FOR PAID DOCUMENTS
;
S ACHSIO=IO
BDT ; Enter beginning date.
S ACHSBDT=$$DATE^ACHS("B","Vendor Usage","ISSUE")
G K:$D(DUOUT)!$D(DTOUT)!(ACHSBDT<1)
EDT ; Enter the ending date.
S ACHSEDT=$$DATE^ACHS("E","Vendor Usage","ISSUE")
G BDT:$D(DUOUT),K:$D(DTOUT)!(ACHSEDT<1),EDT:$$EBB^ACHS(ACHSBDT,ACHSEDT)
DOCS ; Select type of docs to print.
S ACHSRPT=$$DIR^XBDIR("S^1:ALL documents;2:OPEN documents only","Print which documents","1","","","^D HELP^ACHS(""H1"",""ACHSVUR"")",2)
G EDT:$D(DUOUT),K:$D(DTOUT)
S %=$$DIR^XBDIR("Y","Print ONE vendor per page","N","","","^D HELP^ACHS(""H2"",""ACHSVUR"")",2)
G DOCS:$D(DUOUT),K:$D(DTOUT)
S ACHSVND=$S(%:"Y",1:"N")
DEV ; Select device for report.
W !
S %=$$PB^ACHS
I %=U!$D(DTOUT)!$D(DUOUT) D K Q
I %="B" D VIEWR^XBLM("CALC^ACHSVUR"),EN^XBVK("VALM") D K Q
K IOP,%ZIS
S %ZIS="PQ"
D ^%ZIS,SLV^ACHSFU:$D(IO("S"))
K %ZIS
I POP W !,*7,"No device specified." D HOME^%ZIS G K
G:'$D(IO("Q")) CALC
K IO("Q")
I $E(IOST)'="P" W *7,!,"Please queue to printers only." G DEV
S ZTIO="",ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL,ZTRTN="CALC^ACHSVUR",ZTDESC="CHS Vendor Report, "_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT)_" for "_ACHSVND
F %="ACHSQIO","ACHSVND","ACHSBDT","ACHSRPT","ACHSEDT" S ZTSAVE(%)=""
D ^%ZTLOAD
G:'$D(ZTSK) DEV
K ; Kill vars, close device, quit.
K ACHSBDT,ACHSEDT,ACHSIO,ACHSQIO,ACHSRPT,ACHSVND,DTOUT,DUOUT,ZTSK
D ^%ZISC
Q
;
;end of interactive portion. The rest performed by Taskman
;
;
CALC ;EP - TaskMan.
D FC^ACHSUF
I $D(ACHSERR),ACHSERR=1 G K
S ACHSTRDT=ACHSBDT-1
K ^TMP("ACHSVUR",$J)
;
TRDT ; Loop thru transaction date x-ref.
S ACHSTRDT=$O(^ACHSF(DUZ(2),"TB",ACHSTRDT))
G PRINT:+ACHSTRDT=0!(+ACHSTRDT>ACHSEDT)
S ACHSTYPE=""
;
TRTYPE ; Loop thru transaction type.
S ACHSTYPE=$O(^ACHSF(DUZ(2),"TB",ACHSTRDT,ACHSTYPE))
G TRDT:ACHSTYPE="",TRTYPE:ACHSTYPE'="I"
S DA=0
;
TRANS ; Loop thru transactions, compile report data.
S DA=$O(^ACHSF(DUZ(2),"TB",ACHSTRDT,ACHSTYPE,DA))
G TRDT:+DA=0,TRDT:'$D(^ACHSF(DUZ(2),"D",DA,0))
;ACHS*3.1*18 06.08.2010 IHS.OIT.FCJ CHANGED NXT LINE TO PRINT 2 DIG FY
;S ACHSDOCN=$P(^ACHSF(DUZ(2),"D",DA,0),U),ACHSVPTR=$P(^(0),U,8),ACHSFY=$P(^(0),U,14),ACHSSTS=$P(^(0),U,12),DFN=$P(^(0),U,22),ACHSBLNK=+$P(^(0),U,3)
S ACHSDOCN=$P(^ACHSF(DUZ(2),"D",DA,0),U),ACHSVPTR=$P(^(0),U,8),ACHSFY=$E($P(^(0),U,27),3,4),ACHSSTS=$P(^(0),U,12),DFN=$P(^(0),U,22),ACHSBLNK=+$P(^(0),U,3)
;
;get the amount. either the adjusted amount, or, if that doesn't
;exist, the payment amount, or, if that doesn't exist, the
;obligated amount
;pmf 6/26/01 fix bug. add $p to third line
D
. ;/ITSC/JVK/SET ACHS*3.1*6 LN BLEOW
.; I $D(^ACHSF(DUZ(2),"D",DA,"ZA")) S ACHS("$")=$G(^ACHSF(DUZ(2),"D",DA,"ZA")) Q
. I $D(^ACHSF(DUZ(2),"D",DA,"ZA")) S ACHS("$")=$G(^ACHSF(DUZ(2),"D",DA,"ZA")),ACHS("$")=+ACHS("$")_"*" Q
. ;I $D(^ACHSF(DUZ(2),"D",DA,"PA")) S ACHS("$")=$G(^ACHSF(DUZ(2),"D",DA,"PA"))_"*" Q
. I $D(^ACHSF(DUZ(2),"D",DA,"PA")) S ACHS("$")=$G(^ACHSF(DUZ(2),"D",DA,"PA")),ACHS("$")=+ACHS("$")_"*" Q
. ;S ACHS("$")=$G(^ACHSF(DUZ(2),"D",DA,0))
. S ACHS("$")=$P($G(^ACHSF(DUZ(2),"D",DA,0)),U,9)
. Q
;
G TRANS:(DFN'=+DFN)&('ACHSBLNK),TRANS:ACHSSTS=4!(ACHSRPT=2&(ACHSSTS>2))!(ACHSVPTR']""),TRANS:'$D(^AUTTVNDR(ACHSVPTR,0)) S ACHSVNDR=$P(^(0),U)
I 'ACHSBLNK,'$D(^DPT(DFN,0)) G TRANS
S ACHSDOC=ACHSFY_"-"_ACHSFC_"-"_ACHSDOCN,^TMP("ACHSVUR",$J,ACHSVNDR,ACHSVPTR,ACHSDOC,DA)=$S(ACHSBLNK=0:$P(^DPT(DFN,0),U),ACHSBLNK=1:"* BLANKET",ACHSBLNK=2:"* SPECIAL TRANS",1:"")_U_ACHS("$")
G TRANS
;
PRINT ; Kill calc vars, print.
K ACHSBLNK,ACHSDOCN,ACHSFY,ACHSSTS,ACHSTRDT,ACHSTYPE
;
S ACHSVNDR="",(ACHSTOT,ACHSTOT("$"),ACHSPD,ACHSPD("$"))=0,ACHST1=$$C^XBFUNC("VENDOR USAGE REPORT - "_$S(ACHSRPT=2:"OPEN DOCUMENTS ONLY",1:"OPEN AND PAID DOCUMENTS"))
S ACHST2=$$C^XBFUNC("For the period "_$$FMTE^XLFDT(ACHSBDT)_" through "_$$FMTE^XLFDT(ACHSEDT)),X3=0
D BRPT^ACHSFU
X:$D(IO("S")) ACHSPPO
D HDR
K ACHSHDR
A ;
S ACHSVNDR=$O(^TMP("ACHSVUR",$J,ACHSVNDR))
G ENDPRNT:ACHSVNDR=""
S ACHSVPTR=0
B ;
S ACHSVPTR=$O(^TMP("ACHSVUR",$J,ACHSVNDR,ACHSVPTR))
G A:+ACHSVPTR=0,B:'$D(^AUTTVNDR(ACHSVPTR))
I ACHSVND="Y",$D(ACHSHDR) D RTRN^ACHS G KILL:$D(DUOUT)!$D(DTOUT) D HDR
W ACHSVNDR
S ACHSHDR=""
I $D(^AUTTVNDR(ACHSVPTR,13)) W ?37,$E($P(^(13),U,2),1,17) S X=$P(^(13),U,3) I X]"",$D(^DIC(5,X,0)) W $S($X>38:", ",1:""),$P(^(0),U,2)
S ACHSDOC="",(ACHSVDOC,ACHSVDOC("$"))=0
;
C ;
S ACHSDOC=$O(^TMP("ACHSVUR",$J,ACHSVNDR,ACHSVPTR,ACHSDOC)) G F:ACHSDOC="" S DA=$O(^(ACHSDOC,0)),ACHSNAME=$P(^(DA),U),ACHS("$")=$P(^(DA),U,2)
G C:'$D(^ACHSF(DUZ(2),"D",DA,0)) S ACHSTOS=$P(^(0),U,4),DFN=$P(^(0),U,22)
I +ACHSTOS>0 S ACHSTOS=$P($P($P($P(^DD(9002080.01,3,0),U,3),";",ACHSTOS),":",2)," ")
S (Y,ACHSDOS)=""
I $D(^ACHSF(DUZ(2),"D",DA,3)),+$P(^(3),U)>0 S Y=+$P(^(3),U),ACHSDOS=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
;
D ;
W !?3,ACHSDOC,?16,ACHSNAME,?49,ACHSTOS,?54,ACHSDOS
;
;start of jeanette's changes
S ACHSBLNK=$P(^ACHSF(DUZ(2),"D",DA,0),U,3)
I DFN S INSTYP=$S($D(^AUPNMCR(DFN)):"MCR",$D(^AUPNMCD("B",DFN)):"MCD",$D(^AUPNRRE(DFN)):"RRE",$D(^AUPNPRVT(DFN)):"PRVT",1:"")
;
I 'DFN S INSTYP=""
;
I (INSTYP="PRVT")&('ACHSBLNK) D PRVTST^ACHSVUR1
I (INSTYP="MCR")&('ACHSBLNK) D MCRTST^ACHSVUR1
I (INSTYP="MCD")&('ACHSBLNK) D MCDTST^ACHSVUR1
I (INSTYP="RRE")&('ACHSBLNK) D RRETST^ACHSVUR1
;
;end of jeanette's changes in this tag
;
;
S X=$FN(+ACHS("$"),",",2)
I $D(ACHSSTAR) S X=X_ACHSSTAR K ACHSSTAR
W ?78-$L(X),X
I ACHS("$")["*" W "*" S ACHSPD=ACHSPD+1,ACHSPD("$")=ACHSPD("$")+ACHS("$")
I $Y>ACHSBM D RTRN^ACHS G KILL:$D(DUOUT)!$D(DTOUT) D HDR W:$D(ACHSVNDR) ACHSVNDR," (continued)"
;
E ;
S ACHSVDOC=ACHSVDOC+1,ACHSVDOC("$")=ACHSVDOC("$")+ACHS("$"),ACHSTOT=ACHSTOT+1,ACHSTOT("$")=ACHSTOT("$")+ACHS("$")
G C
;
F ;
S X2="2$",X3=16,X=ACHSVDOC("$")
D COMMA^%DTC
W !?10,$$REPEAT^XLFSTR("-",55),!?10,"TOTALS DOCUMENTS:",$J(ACHSVDOC,5),?42,"DOLLARS:",X,!,$$REPEAT^XLFSTR("-",79),!
G B
;
ENDPRNT ;
I ACHSVND="Y" D RTRN^ACHS G KILL:$D(DUOUT)!$D(DTOUT) D HDR
W !,$$REPEAT^XLFSTR("=",79),!
S X2="2$",X3=16,X=ACHSPD("$")
D COMMA^%DTC
W "TOTAL PAID",?21,"DOCUMENTS:",$J(ACHSPD,5),?42,"DOLLARS:",X,!
S X=ACHSTOT("$")-ACHSPD("$")
D COMMA^%DTC
W "TOTAL OUTSTANDING",?21,"DOCUMENTS:",$J(ACHSTOT-ACHSPD,5),?42,"DOLLARS:",X,!,$$REPEAT^XLFSTR("-",79),!
S X=ACHSTOT("$")
D COMMA^%DTC
W "GRAND TOTALS",?21,"DOCUMENTS:",$J(ACHSTOT,5),?42,"DOLLARS:",X
D RTRN^ACHS:'$D(IO("S"))
W @IOF
KILL ; Kill vars, close device, quit.
X:$D(IO("S")) ACHSPPC
K DA,DFN,ZTSK,^TMP("ACHSVUR",$J)
D ERPT^ACHS,EN^XBVK("ACHS"),^ACHSVAR:'$D(ZTQUEUED)
Q
;
HDR ; Paginate.
S ACHSPG=ACHSPG+1
W @IOF,!!?19,"*** CONTRACT HEALTH MANAGEMENT SYSTEM ***",!,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,ACHSLOC,!,ACHST1,!,ACHSTIME,!,ACHST2
W !!,"VENDOR",?70,"DOLLARS",!?3,"DOCUMENT # PATIENT NAME",?48,"TYPE DOS",?64,"INS (* = PAID)"
W !,$$REPEAT^XLFSTR("=",79),!
Q
;
H1 ;EP - From HELP^ACHS() via ^DIR.
;;@;!
;;Enter a '1' if you want to list all documents.
;;Enter a '2' if you want only OPEN documents to be listed.
;;###
;
H2 ;EP - From HELP^ACHS() via ^DIR.
;;@;!
;;Enter 'Y' to print one vendor per page.
;;'N' to print more than one vendor per page.
;;@;!!
;;###
;
ACHSVUR ; IHS/ITSC/PMF - VENDOR USAGE REPORT ; [ 10/31/2003 12:12 PM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**6,18**;JUN 11, 2001
+2 ;
+3 ;9/11/00 added verification of eligbility dates. Changes
+4 ; are courtesy of Jeanette Kompkoff, presently
+5 ; of the Portland office
+6 ;ACHS*3.1*6 5/2/2003 /ITSC/SET/JVK ADDED FIX FOR PAID DOCUMENTS
+7 ;
+8 SET ACHSIO=IO
BDT ; Enter beginning date.
+1 SET ACHSBDT=$$DATE^ACHS("B","Vendor Usage","ISSUE")
+2 IF $DATA(DUOUT)!$DATA(DTOUT)!(ACHSBDT<1)
GOTO K
EDT ; Enter the ending date.
+1 SET ACHSEDT=$$DATE^ACHS("E","Vendor Usage","ISSUE")
+2 IF $DATA(DUOUT)
GOTO BDT
IF $DATA(DTOUT)!(ACHSEDT<1)
GOTO K
IF $$EBB^ACHS(ACHSBDT,ACHSEDT)
GOTO EDT
DOCS ; Select type of docs to print.
+1 SET ACHSRPT=$$DIR^XBDIR("S^1:ALL documents;2:OPEN documents only","Print which documents","1","","","^D HELP^ACHS(""H1"",""ACHSVUR"")",2)
+2 IF $DATA(DUOUT)
GOTO EDT
IF $DATA(DTOUT)
GOTO K
+3 SET %=$$DIR^XBDIR("Y","Print ONE vendor per page","N","","","^D HELP^ACHS(""H2"",""ACHSVUR"")",2)
+4 IF $DATA(DUOUT)
GOTO DOCS
IF $DATA(DTOUT)
GOTO K
+5 SET ACHSVND=$SELECT(%:"Y",1:"N")
DEV ; Select device for report.
+1 WRITE !
+2 SET %=$$PB^ACHS
+3 IF %=U!$DATA(DTOUT)!$DATA(DUOUT)
DO K
QUIT
+4 IF %="B"
DO VIEWR^XBLM("CALC^ACHSVUR")
DO EN^XBVK("VALM")
DO K
QUIT
+5 KILL IOP,%ZIS
+6 SET %ZIS="PQ"
+7 DO ^%ZIS
IF $DATA(IO("S"))
DO SLV^ACHSFU
+8 KILL %ZIS
+9 IF POP
WRITE !,*7,"No device specified."
DO HOME^%ZIS
GOTO K
+10 IF '$DATA(IO("Q"))
GOTO CALC
+11 KILL IO("Q")
+12 IF $EXTRACT(IOST)'="P"
WRITE *7,!,"Please queue to printers only."
GOTO DEV
+13 SET ZTIO=""
SET ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
SET ZTRTN="CALC^ACHSVUR"
SET ZTDESC="CHS Vendor Report, "_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT)_" for "_ACHSVND
+14 FOR %="ACHSQIO","ACHSVND","ACHSBDT","ACHSRPT","ACHSEDT"
SET ZTSAVE(%)=""
+15 DO ^%ZTLOAD
+16 IF '$DATA(ZTSK)
GOTO DEV
K ; Kill vars, close device, quit.
+1 KILL ACHSBDT,ACHSEDT,ACHSIO,ACHSQIO,ACHSRPT,ACHSVND,DTOUT,DUOUT,ZTSK
+2 DO ^%ZISC
+3 QUIT
+4 ;
+5 ;end of interactive portion. The rest performed by Taskman
+6 ;
+7 ;
CALC ;EP - TaskMan.
+1 DO FC^ACHSUF
+2 IF $DATA(ACHSERR)
IF ACHSERR=1
GOTO K
+3 SET ACHSTRDT=ACHSBDT-1
+4 KILL ^TMP("ACHSVUR",$JOB)
+5 ;
TRDT ; Loop thru transaction date x-ref.
+1 SET ACHSTRDT=$ORDER(^ACHSF(DUZ(2),"TB",ACHSTRDT))
+2 IF +ACHSTRDT=0!(+ACHSTRDT>ACHSEDT)
GOTO PRINT
+3 SET ACHSTYPE=""
+4 ;
TRTYPE ; Loop thru transaction type.
+1 SET ACHSTYPE=$ORDER(^ACHSF(DUZ(2),"TB",ACHSTRDT,ACHSTYPE))
+2 IF ACHSTYPE=""
GOTO TRDT
IF ACHSTYPE'="I"
GOTO TRTYPE
+3 SET DA=0
+4 ;
TRANS ; Loop thru transactions, compile report data.
+1 SET DA=$ORDER(^ACHSF(DUZ(2),"TB",ACHSTRDT,ACHSTYPE,DA))
+2 IF +DA=0
GOTO TRDT
IF '$DATA(^ACHSF(DUZ(2),"D",DA,0))
GOTO TRDT
+3 ;ACHS*3.1*18 06.08.2010 IHS.OIT.FCJ CHANGED NXT LINE TO PRINT 2 DIG FY
+4 ;S ACHSDOCN=$P(^ACHSF(DUZ(2),"D",DA,0),U),ACHSVPTR=$P(^(0),U,8),ACHSFY=$P(^(0),U,14),ACHSSTS=$P(^(0),U,12),DFN=$P(^(0),U,22),ACHSBLNK=+$P(^(0),U,3)
+5 SET ACHSDOCN=$PIECE(^ACHSF(DUZ(2),"D",DA,0),U)
SET ACHSVPTR=$PIECE(^(0),U,8)
SET ACHSFY=$EXTRACT($PIECE(^(0),U,27),3,4)
SET ACHSSTS=$PIECE(^(0),U,12)
SET DFN=$PIECE(^(0),U,22)
SET ACHSBLNK=+$PIECE(^(0),U,3)
+6 ;
+7 ;get the amount. either the adjusted amount, or, if that doesn't
+8 ;exist, the payment amount, or, if that doesn't exist, the
+9 ;obligated amount
+10 ;pmf 6/26/01 fix bug. add $p to third line
+11 Begin DoDot:1
+12 ;/ITSC/JVK/SET ACHS*3.1*6 LN BLEOW
+13 ; I $D(^ACHSF(DUZ(2),"D",DA,"ZA")) S ACHS("$")=$G(^ACHSF(DUZ(2),"D",DA,"ZA")) Q
+14 IF $DATA(^ACHSF(DUZ(2),"D",DA,"ZA"))
SET ACHS("$")=$GET(^ACHSF(DUZ(2),"D",DA,"ZA"))
SET ACHS("$")=+ACHS("$")_"*"
QUIT
+15 ;I $D(^ACHSF(DUZ(2),"D",DA,"PA")) S ACHS("$")=$G(^ACHSF(DUZ(2),"D",DA,"PA"))_"*" Q
+16 IF $DATA(^ACHSF(DUZ(2),"D",DA,"PA"))
SET ACHS("$")=$GET(^ACHSF(DUZ(2),"D",DA,"PA"))
SET ACHS("$")=+ACHS("$")_"*"
QUIT
+17 ;S ACHS("$")=$G(^ACHSF(DUZ(2),"D",DA,0))
+18 SET ACHS("$")=$PIECE($GET(^ACHSF(DUZ(2),"D",DA,0)),U,9)
+19 QUIT
End DoDot:1
+20 ;
+21 IF (DFN'=+DFN)&('ACHSBLNK)
GOTO TRANS
IF ACHSSTS=4!(ACHSRPT=2&(ACHSSTS>2))!(ACHSVPTR']"")
GOTO TRANS
IF '$DATA(^AUTTVNDR(ACHSVPTR,0))
GOTO TRANS
SET ACHSVNDR=$PIECE(^(0),U)
+22 IF 'ACHSBLNK
IF '$DATA(^DPT(DFN,0))
GOTO TRANS
+23 SET ACHSDOC=ACHSFY_"-"_ACHSFC_"-"_ACHSDOCN
SET ^TMP("ACHSVUR",$JOB,ACHSVNDR,ACHSVPTR,ACHSDOC,DA)=$SELECT(ACHSBLNK=0:$PIECE(^DPT(DFN,0),U),ACHSBLNK=1:"* BLANKET",ACHSBLNK=2:"* SPECIAL TRANS",1:"")_U_ACHS("$")
+24 GOTO TRANS
+25 ;
PRINT ; Kill calc vars, print.
+1 KILL ACHSBLNK,ACHSDOCN,ACHSFY,ACHSSTS,ACHSTRDT,ACHSTYPE
+2 ;
+3 SET ACHSVNDR=""
SET (ACHSTOT,ACHSTOT("$"),ACHSPD,ACHSPD("$"))=0
SET ACHST1=$$C^XBFUNC("VENDOR USAGE REPORT - "_$SELECT(ACHSRPT=2:"OPEN DOCUMENTS ONLY",1:"OPEN AND PAID DOCUMENTS"))
+4 SET ACHST2=$$C^XBFUNC("For the period "_$$FMTE^XLFDT(ACHSBDT)_" through "_$$FMTE^XLFDT(ACHSEDT))
SET X3=0
+5 DO BRPT^ACHSFU
+6 IF $DATA(IO("S"))
XECUTE ACHSPPO
+7 DO HDR
+8 KILL ACHSHDR
A ;
+1 SET ACHSVNDR=$ORDER(^TMP("ACHSVUR",$JOB,ACHSVNDR))
+2 IF ACHSVNDR=""
GOTO ENDPRNT
+3 SET ACHSVPTR=0
B ;
+1 SET ACHSVPTR=$ORDER(^TMP("ACHSVUR",$JOB,ACHSVNDR,ACHSVPTR))
+2 IF +ACHSVPTR=0
GOTO A
IF '$DATA(^AUTTVNDR(ACHSVPTR))
GOTO B
+3 IF ACHSVND="Y"
IF $DATA(ACHSHDR)
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO KILL
DO HDR
+4 WRITE ACHSVNDR
+5 SET ACHSHDR=""
+6 IF $DATA(^AUTTVNDR(ACHSVPTR,13))
WRITE ?37,$EXTRACT($PIECE(^(13),U,2),1,17)
SET X=$PIECE(^(13),U,3)
IF X]""
IF $DATA(^DIC(5,X,0))
WRITE $SELECT($X>38:", ",1:""),$PIECE(^(0),U,2)
+7 SET ACHSDOC=""
SET (ACHSVUR_source.html#xC">CHSVDOCHSVUR_source.html#xC">C,ACHSVUR_source.html#xC">CHSVDOCHSVUR_source.html#xC">C("$"))=0
+8 ;
C ;
+1 SET ACHSVUR_source.html#xC">CHSDOCHSVUR_source.html#xC">C=$ORDER(^TMP("ACHSVUR_source.html#xC">CHSVUR",$JOB,ACHSVUR_source.html#xC">CHSVNDR,ACHSVUR_source.html#xC">CHSVPTR,ACHSVUR_source.html#xC">CHSDOCHSVUR_source.html#xC">C))
IF ACHSDOC=""
GOTO F
SET DA=$ORDER(^(ACHSDOC,0))
SET ACHSNAME=$PIECE(^(DA),U)
SET ACHS("$")=$PIECE(^(DA),U,2)
+2 IF '$DATA(^ACHSF(DUZ(2),"D",DA,0))
GOTO C
SET ACHSTOS=$PIECE(^(0),U,4)
SET DFN=$PIECE(^(0),U,22)
+3 IF +ACHSTOS>0
SET ACHSTOS=$PIECE($PIECE($PIECE($PIECE(^DD(9002080.01,3,0),U,3),";",ACHSTOS),":",2)," ")
+4 SET (Y,ACHSDOS)=""
+5 IF $DATA(^ACHSF(DUZ(2),"D",DA,3))
IF +$PIECE(^(3),U)>0
SET Y=+$PIECE(^(3),U)
SET ACHSDOS=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
+6 ;
D ;
+1 WRITE !?3,ACHSDOC,?16,ACHSNAME,?49,ACHSTOS,?54,ACHSDOS
+2 ;
+3 ;start of jeanette's changes
+4 SET ACHSBLNK=$PIECE(^ACHSF(DUZ(2),"D",DA,0),U,3)
+5 IF DFN
SET INSTYP=$SELECT($DATA(^AUPNMCR(DFN)):"MCR",$DATA(^AUPNMCD("B",DFN)):"MCD",$DATA(^AUPNRRE(DFN)):"RRE",$DATA(^AUPNPRVT(DFN)):"PRVT",1:"")
+6 ;
+7 IF 'DFN
SET INSTYP=""
+8 ;
+9 IF (INSTYP="PRVT")&('ACHSBLNK)
DO PRVTST^ACHSVUR1
+10 IF (INSTYP="MCR")&('ACHSBLNK)
DO MCRTST^ACHSVUR1
+11 IF (INSTYP="MCD")&('ACHSBLNK)
DO MCDTST^ACHSVUR1
+12 IF (INSTYP="RRE")&('ACHSBLNK)
DO RRETST^ACHSVUR1
+13 ;
+14 ;end of jeanette's changes in this tag
+15 ;
+16 ;
+17 SET X=$FNUMBER(+ACHS("$"),",",2)
+18 IF $DATA(ACHSSTAR)
SET X=X_ACHSSTAR
KILL ACHSSTAR
+19 WRITE ?78-$LENGTH(X),X
+20 IF ACHS("$")["*"
WRITE "*"
SET ACHSPD=ACHSPD+1
SET ACHSPD("$")=ACHSPD("$")+ACHS("$")
+21 IF $Y>ACHSBM
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO KILL
DO HDR
IF $DATA(ACHSVNDR)
WRITE ACHSVNDR," (continued)"
+22 ;
E ;
+1 SET ACHSVUR_source.html#xC">CHSVDOCHSVUR_source.html#xC">C=ACHSVUR_source.html#xC">CHSVDOCHSVUR_source.html#xC">C+1
SET ACHSVUR_source.html#xC">CHSVDOCHSVUR_source.html#xC">C("$")=ACHSVUR_source.html#xC">CHSVDOCHSVUR_source.html#xC">C("$")+ACHSVUR_source.html#xC">CHS("$")
SET ACHSTOT=ACHSTOT+1
SET ACHSTOT("$")=ACHSTOT("$")+ACHS("$")
+2 GOTO C
+3 ;
F ;
+1 SET X2="2$"
SET X3=16
SET X=ACHSVDOC("$")
+2 DO COMMA^%DTC
+3 WRITE !?10,$$REPEAT^XLFSTR("-",55),!?10,"TOTALS DOCUMENTS:",$JUSTIFY(ACHSVDOC,5),?42,"DOLLARS:",X,!,$$REPEAT^XLFSTR("-",79),!
+4 GOTO B
+5 ;
ENDPRNT ;
+1 IF ACHSVND="Y"
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO KILL
DO HDR
+2 WRITE !,$$REPEAT^XLFSTR("=",79),!
+3 SET X2="2$"
SET X3=16
SET X=ACHSPD("$")
+4 DO COMMA^%DTC
+5 WRITE "TOTAL PAID",?21,"DOCUMENTS:",$JUSTIFY(ACHSPD,5),?42,"DOLLARS:",X,!
+6 SET X=ACHSTOT("$")-ACHSPD("$")
+7 DO COMMA^%DTC
+8 WRITE "TOTAL OUTSTANDING",?21,"DOCUMENTS:",$JUSTIFY(ACHSTOT-ACHSPD,5),?42,"DOLLARS:",X,!,$$REPEAT^XLFSTR("-",79),!
+9 SET X=ACHSTOT("$")
+10 DO COMMA^%DTC
+11 WRITE "GRAND TOTALS",?21,"DOCUMENTS:",$JUSTIFY(ACHSTOT,5),?42,"DOLLARS:",X
+12 IF '$DATA(IO("S"))
DO RTRN^ACHS
+13 WRITE @IOF
KILL ; Kill vars, close device, quit.
+1 IF $DATA(IO("S"))
XECUTE ACHSPPC
+2 KILL DA,DFN,ZTSK,^TMP("ACHSVUR",$JOB)
+3 DO ERPT^ACHS
DO EN^XBVK("ACHS")
IF '$DATA(ZTQUEUED)
DO ^ACHSVAR
+4 QUIT
+5 ;
HDR ; Paginate.
+1 SET ACHSPG=ACHSPG+1
+2 WRITE @IOF,!!?19,"*** CONTRACT HEALTH MANAGEMENT SYSTEM ***",!,ACHSUSR,?71,"Page",$JUSTIFY(ACHSPG,3),!,ACHSLOC,!,ACHST1,!,ACHSTIME,!,ACHST2
+3 WRITE !!,"VENDOR",?70,"DOLLARS",!?3,"DOCUMENT # PATIENT NAME",?48,"TYPE DOS",?64,"INS (* = PAID)"
+4 WRITE !,$$REPEAT^XLFSTR("=",79),!
+5 QUIT
+6 ;
H1 ;EP - From HELP^ACHS() via ^DIR.
+1 ;;@;!
+2 ;;Enter a '1' if you want to list all documents.
+3 ;;Enter a '2' if you want only OPEN documents to be listed.
+4 ;;###
+5 ;
H2 ;EP - From HELP^ACHS() via ^DIR.
+1 ;;@;!
+2 ;;Enter 'Y' to print one vendor per page.
+3 ;;'N' to print more than one vendor per page.
+4 ;;@;!!
+5 ;;###
+6 ;
