ACHSVUR2 ; IHS/OIT/FCJ - VENDOR USAGE REPORT FOR One Vendor; [ 10/31/2003 12:12 PM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**26**;JUN 11, 2001;Build 43
;3.1*26 IHS/OIT/FCJ NEW RTN
;Allows selection of one vendor and data to be saved to a file.
;
;
S ACHSIO=IO
K ^TMP($J),^TMP("ACHSVUR2",$J)
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"",""ACHSVUR2"")",2)
G EDT:$D(DUOUT),K:$D(DTOUT)
G DOCS:$D(DUOUT),K:$D(DTOUT)
VEND ; Select one vendor.
S DIC(0)="AEQMZ",DIC="^AUTTVNDR(",DIC("A")="Enter Provider/Vendor: "
S:DIC(0)["L" DLAYGO=9999999.11
D ^DIC
K DIC,DLAYGO
G DOCS:Y=-1
S ACHSVIEN=+Y
S ACHSVNAM=$P(^AUTTVNDR(ACHSVIEN,0),U)
FILE ;CREATE A FILE
S %=$$DIR^XBDIR("Y","Create a file","N","","","^D HELP^ACHS(""H2"",""ACHSVUR2"")",2)
G VEND:$D(DUOUT),K:$D(DTOUT)
S ACHSFIL=$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^ACHSVUR2"),EN^XBVK("VALM") G KILL
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
I '$D(IO("Q")) D CALC G KILL
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^ACHSVUR2",ZTDESC="CHS Vendor Report, "_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT)
F %="ACHSVIEN","ACHSVNAM","ACHSHRN","ACHSDOB","ACHSQIO","ACHSBDT","ACHSRPT","ACHSEDT" S ZTSAVE(%)=""
D ^%ZTLOAD
G:'$D(ZTSK) DEV
KILL ; Kill vars, close device, quit.
I ACHSFIL="Y" D FILSAV
X:$D(IO("S")) ACHSPPC
K DA,DFN,ZTSK,^TMP($J,"ACHSVUR2")
K ^TMP("ACHSVUR2",$J)
D ERPT^ACHS,EN^XBVK("ACHS"),^ACHSVAR:'$D(ZTQUEUED)
K ; Kill vars, close device, quit.
K ACHSAMT,ACHSVIEN,ACHSVNAM,ACHSHRN,ACHSDOB,ACHSBDT,ACHSEDT,ACHSIO,ACHSQIO,ACHSRPT,DTOUT,DUOUT,ZTSK
D ^%ZISC
Q
;
CALC ;EP - TaskMan.
D FC^ACHSUF
I $D(ACHSERR),ACHSERR=1 G K
S ACHSTRDT=ACHSBDT-1
K ^TMP($J,"ACHSVUR2")
;
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 (ACHSDOCN,ACHSVPTR,ACHSFY,ACHSSTS,DFN,ACHSSCPT,ACHSSC,ACHSCLRK,ACHSDOC,ACHSBLNK)=""
;
S DA=$O(^ACHSF(DUZ(2),"TB",ACHSTRDT,ACHSTYPE,DA))
G TRDT:+DA=0,TRDT:'$D(^ACHSF(DUZ(2),"D",DA,0))
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)
;
I ACHSVPTR'=ACHSVIEN G TRANS ;SINGLE PROVIDER
;
;Amount either adjusted amount or payment amount, or, if that doesn't exist, the
;obligated amount
;
D
. 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")),ACHS("$")=+ACHS("$")_"*" Q
. S ACHS("$")=$P($G(^ACHSF(DUZ(2),"D",DA,0)),U,9)
;
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
;
I $D(DFN),(DFN'="") S ACHSSSN=$P($G(^DPT(DFN,0)),"^",9),ACHSHRN=$P(^AUPNPAT(DFN,41,DUZ(2),0),"^",2)
;
S ACHSSCPT=$P($G(^ACHSF(DUZ(2),"D",DA,0)),U,7)
S ACHSSC=$P($G(^ACHS(3,DUZ(2),1,+ACHSSCPT,0)),"^",1)
S ACHSCLRK=$P(^ACHSF(DUZ(2),"D",DA,0),U,18)
S ACHSCLRK=$P($G(^VA(200,ACHSCLRK,0)),"^",2)
;
;
S ACHSDOC=ACHSFY_"-"_ACHSFC_"-"_ACHSDOCN
S ^TMP("ACHSVUR2",$J,ACHSVNDR,ACHSVPTR,ACHSDOC,DA)=$S(ACHSBLNK=0:$P(^DPT(DFN,0),U),ACHSBLNK=1:"* BLANKET",ACHSBLNK=2:"* SPECIAL TRANS",1:"")_U_ACHS("$")_U_$G(ACHSSSN)_U_$G(ACHSHRN)_U_$G(ACHSSC)_U_$G(ACHSCLRK)
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
S ACHSV=$$C^XBFUNC("Provider: "_ACHSVNAM)
D BRPT^ACHSFU
X:$D(IO("S")) ACHSPPO
D HDR
K ACHSHDR
A ;
S ACHSVNDR=$O(^TMP("ACHSVUR2",$J,ACHSVNDR))
G ENDPRNT:ACHSVNDR=""
S ACHSVPTR=0
B ;
S ACHSVPTR=$O(^TMP("ACHSVUR2",$J,ACHSVNDR,ACHSVPTR))
G A:+ACHSVPTR=0,B:'$D(^AUTTVNDR(ACHSVPTR))
S ACHSHDR=""
S ACHSDOC="",(ACHSVDOC,ACHSVDOC("$"))=0
;
C ;
S ACHSDOC=$O(^TMP("ACHSVUR2",$J,ACHSVNDR,ACHSVPTR,ACHSDOC)) G F:ACHSDOC="" S DA=$O(^(ACHSDOC,0)),ACHSNAME=$P(^(DA),U),ACHS("$")=$P(^(DA),U,2),ACHSSSN=$P(^(DA),U,3),ACHSHRN=$P(^(DA),U,4),ACHSSC=$P(^(DA),U,5),ACHSCLRK=$P(^(DA),U,6)
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,ACHSAMT)=""
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,$E(ACHSNAME,1,25),?42,ACHSHRN,?53,ACHSTOS,?58,ACHSDOS
W !,?3,ACHSCLRK,?16,$E(ACHSSSN,6,9),?52,ACHSSC
;
S ACHSBLNK=$P(^ACHSF(DUZ(2),"D",DA,0),U,3)
;
S X=$FN(+ACHS("$"),",",2)
I $D(ACHSSTAR) S X=X_ACHSSTAR K ACHSSTAR
W ?78-$L(X),X S ACHSAMT=X
I ACHS("$")["*" W "*" S ACHSPD=ACHSPD+1,ACHSPD("$")=ACHSPD("$")+ACHS("$"),ACHSAMT=ACHSAMT_"*"
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("$")
I ACHSFIL="Y" S ^TMP($J,"ACHSVUR2","REC"_ACHSVDOC)=ACHSDOC_"^"_ACHSNAME_"^"_ACHSHRN_"^"_ACHSTOS_"^"_ACHSDOS_"^"_ACHSCLRK_"^"_$E(ACHSSSN,6,9)_"^"_ACHSSC_"^"_ACHSAMT
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 ;
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,!
I ACHSFIL="Y" S ^TMP($J,"ACHSVUR2","TOT1")="TOTAL PAID DOCUMENTS: ^"_$J(ACHSPD,5)_"^DOLLARS: ^"_X
S X=ACHSTOT("$")-ACHSPD("$")
D COMMA^%DTC
W "TOTAL OUTSTANDING",?21,"DOCUMENTS:",$J(ACHSTOT-ACHSPD,5),?42,"DOLLARS:",X,!,$$REPEAT^XLFSTR("-",79),!
I ACHSFIL="Y" S ^TMP($J,"ACHSVUR2","TOT2")="TOTAL OUTSTANDING DOCUMENTS: ^"_$J(ACHSTOT-ACHSPD,5)_"^DOLLARS: ^"_X
S X=ACHSTOT("$")
D COMMA^%DTC
W "GRAND TOTALS",?21,"DOCUMENTS:",$J(ACHSTOT,5),?42,"DOLLARS:",X
I ACHSFIL="Y" S ^TMP($J,"ACHSVUR2","TOT3")="GRAND TOTALS DOCUMENTS: ^"_$J(ACHSTOT,5)_"^DOLLARS: ^"_X
D RTRN^ACHS:'$D(IO("S"))
W @IOF
Q
;
HDR ; Paginate.
S ACHSPG=ACHSPG+1
W @IOF,!!?19,"*** CONTRACT HEALTH MANAGEMENT SYSTEM ***",!,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,ACHSLOC,!,ACHST1,!,ACHSV,!,ACHSTIME,!,ACHST2
W !!?3,"DOCUMENT # PATIENT NAME",?43,"HRN",?52,"TYPE DOS",?70,"DOLLARS"
W !,?3,"STAFF",?17,"LAST 4SSN",?53,"OC",?69,"(* = PAID)"
W !,$$REPEAT^XLFSTR("=",79),!
I ACHSFIL="Y" D
.S ^TMP($J,"ACHSVUR2",1)="*** CONTRACT HEALTH MANAGEMENT SYSTEM ***"
.S ^TMP($J,"ACHSVUR2",2)=ACHSLOC
.S ^TMP($J,"ACHSVUR2",3)= ACHST1
.S ^TMP($J,"ACHSVUR2",4)=ACHSV
.S ^TMP($J,"ACHSVUR2","HDR4")=ACHSTIME
.S ^TMP($J,"ACHSVUR2","HDR5")=ACHST2
.S ^TMP($J,"ACHSVUR2","HDR6")= "DOCUMENT #^PATIENT NAME^HRN^TYPE^DOS^STAFF^LAST-4SSN^OC^DOLLARS *=PAID"
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 create a file to be transferred into excel.
;;@;!!
;;###
;
FILSAV ;SAVE FILE
;
N XBFN,XBE,XBJ,XBUF,XBQ,XBMED,XBFLT,XBS1,XBIO,XBF,XBGL
S X=$E(DT,4,7)_$E(DT,2,3)
D NOW^%DTC S X=(%I(3)+1700)_$E(%,4,7)_"_"_$P(%,".",2)
S:$L(X)'=15 X=X_0
S X1=$$ASF^ACHS(DUZ(2)),XBE=$J
S XBFN="CHS-"_$TR(ACHSVNAM," ","")_"-"_X1_"."_X
S XBMED="F",XBFLT=1
S XBQ="N"
S XBUF=$$PARM^ACHS(1,5)
I XBUF="" S XBUF=$P(^AUTTSITE(1,1),U,2)
S XBS1="ACHS REPORTS"
S XBIO=51,XBF=$J,XBGL="^TMP(" D ^ZIBGSVEM
;S XBGL="TMP("_$J_",""ACHSVUR2"","D ^XBGSAVE
Q
;
ACHSVUR2 ; IHS/OIT/FCJ - VENDOR USAGE REPORT FOR One Vendor; [ 10/31/2003 12:12 PM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**26**;JUN 11, 2001;Build 43
+2 ;3.1*26 IHS/OIT/FCJ NEW RTN
+3 ;Allows selection of one vendor and data to be saved to a file.
+4 ;
+5 ;
+6 SET ACHSIO=IO
+7 KILL ^TMP($JOB),^TMP("ACHSVUR2",$JOB)
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"",""ACHSVUR2"")",2)
+2 IF $DATA(DUOUT)
GOTO EDT
IF $DATA(DTOUT)
GOTO K
+3 IF $DATA(DUOUT)
GOTO DOCS
IF $DATA(DTOUT)
GOTO K
VEND ; Select one vendor.
+1 SET DIC(0)="AEQMZ"
SET DIC="^AUTTVNDR("
SET DIC("A")="Enter Provider/Vendor: "
+2 IF DIC(0)["L"
SET DLAYGO=9999999.11
+3 DO ^DIC
+4 KILL DIC,DLAYGO
+5 IF Y=-1
GOTO DOCS
+6 SET ACHSVIEN=+Y
+7 SET ACHSVNAM=$PIECE(^AUTTVNDR(ACHSVIEN,0),U)
FILE ;CREATE A FILE
+1 SET %=$$DIR^XBDIR("Y","Create a file","N","","","^D HELP^ACHS(""H2"",""ACHSVUR2"")",2)
+2 IF $DATA(DUOUT)
GOTO VEND
IF $DATA(DTOUT)
GOTO K
+3 SET ACHSFIL=$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^ACHSVUR2")
DO EN^XBVK("VALM")
GOTO KILL
+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"))
DO CALC
GOTO KILL
+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^ACHSVUR2"
SET ZTDESC="CHS Vendor Report, "_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT)
+14 FOR %="ACHSVIEN","ACHSVNAM","ACHSHRN","ACHSDOB","ACHSQIO","ACHSBDT","ACHSRPT","ACHSEDT"
SET ZTSAVE(%)=""
+15 DO ^%ZTLOAD
+16 IF '$DATA(ZTSK)
GOTO DEV
KILL ; Kill vars, close device, quit.
+1 IF ACHSFIL="Y"
DO FILSAV
+2 IF $DATA(IO("S"))
XECUTE ACHSPPC
+3 KILL DA,DFN,ZTSK,^TMP($JOB,"ACHSVUR2")
+4 KILL ^TMP("ACHSVUR2",$JOB)
+5 DO ERPT^ACHS
DO EN^XBVK("ACHS")
IF '$DATA(ZTQUEUED)
DO ^ACHSVAR
K ; Kill vars, close device, quit.
+1 KILL ACHSAMT,ACHSVIEN,ACHSVNAM,ACHSHRN,ACHSDOB,ACHSBDT,ACHSEDT,ACHSIO,ACHSQIO,ACHSRPT,DTOUT,DUOUT,ZTSK
+2 DO ^%ZISC
+3 QUIT
+4 ;
CALC ;EP - TaskMan.
+1 DO FC^ACHSUF
+2 IF $DATA(ACHSERR)
IF ACHSERR=1
GOTO K
+3 SET ACHSTRDT=ACHSBDT-1
+4 KILL ^TMP($JOB,"ACHSVUR2")
+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 (ACHSDOCN,ACHSVPTR,ACHSFY,ACHSSTS,DFN,ACHSSCPT,ACHSSC,ACHSCLRK,ACHSDOC,ACHSBLNK)=""
+2 ;
+3 SET DA=$ORDER(^ACHSF(DUZ(2),"TB",ACHSTRDT,ACHSTYPE,DA))
+4 IF +DA=0
GOTO TRDT
IF '$DATA(^ACHSF(DUZ(2),"D",DA,0))
GOTO TRDT
+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 ;SINGLE PROVIDER
IF ACHSVPTR'=ACHSVIEN
GOTO TRANS
+8 ;
+9 ;Amount either adjusted amount or payment amount, or, if that doesn't exist, the
+10 ;obligated amount
+11 ;
+12 Begin DoDot:1
+13 IF $DATA(^ACHSF(DUZ(2),"D",DA,"ZA"))
SET ACHS("$")=$GET(^ACHSF(DUZ(2),"D",DA,"ZA"))
SET ACHS("$")=+ACHS("$")_"*"
QUIT
+14 IF $DATA(^ACHSF(DUZ(2),"D",DA,"PA"))
SET ACHS("$")=$GET(^ACHSF(DUZ(2),"D",DA,"PA"))
SET ACHS("$")=+ACHS("$")_"*"
QUIT
+15 SET ACHS("$")=$PIECE($GET(^ACHSF(DUZ(2),"D",DA,0)),U,9)
End DoDot:1
+16 ;
+17 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)
+18 IF 'ACHSBLNK
IF '$DATA(^DPT(DFN,0))
GOTO TRANS
+19 ;
+20 IF $DATA(DFN)
IF (DFN'="")
SET ACHSSSN=$PIECE($GET(^DPT(DFN,0)),"^",9)
SET ACHSHRN=$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),"^",2)
+21 ;
+22 SET ACHSSCPT=$PIECE($GET(^ACHSF(DUZ(2),"D",DA,0)),U,7)
+23 SET ACHSSC=$PIECE($GET(^ACHS(3,DUZ(2),1,+ACHSSCPT,0)),"^",1)
+24 SET ACHSCLRK=$PIECE(^ACHSF(DUZ(2),"D",DA,0),U,18)
+25 SET ACHSCLRK=$PIECE($GET(^VA(200,ACHSCLRK,0)),"^",2)
+26 ;
+27 ;
+28 SET ACHSDOC=ACHSFY_"-"_ACHSFC_"-"_ACHSDOCN
+29 SET ^TMP("ACHSVUR2",$JOB,ACHSVNDR,ACHSVPTR,ACHSDOC,DA)=$SELECT(ACHSBLNK=0:$PIECE(^DPT(DFN,0),U),ACHSBLNK=1:"* BLANKET",ACHSBLNK=2:"* SPECIAL TRANS",1:"")_U_ACHS("$")_U_$GET(ACHSSSN)_U_$GET(ACHSHRN)_U_$GET(ACHSSC)_U_$GET(ACHSCLRK)
+30 GOTO TRANS
+31 ;
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 SET ACHSV=$$C^XBFUNC("Provider: "_ACHSVNAM)
+6 DO BRPT^ACHSFU
+7 IF $DATA(IO("S"))
XECUTE ACHSPPO
+8 DO HDR
+9 KILL ACHSHDR
A ;
+1 SET ACHSVNDR=$ORDER(^TMP("ACHSVUR2",$JOB,ACHSVNDR))
+2 IF ACHSVNDR=""
GOTO ENDPRNT
+3 SET ACHSVPTR=0
B ;
+1 SET ACHSVPTR=$ORDER(^TMP("ACHSVUR2",$JOB,ACHSVNDR,ACHSVPTR))
+2 IF +ACHSVPTR=0
GOTO A
IF '$DATA(^AUTTVNDR(ACHSVPTR))
GOTO B
+3 SET ACHSHDR=""
+4 SET ACHSDOC=""
SET (ACHSVUR2_source.html#xC">CHSVDOCHSVUR2_source.html#xC">C,ACHSVUR2_source.html#xC">CHSVDOCHSVUR2_source.html#xC">C("$"))=0
+5 ;
C ;
+1 SET ACHSVUR2_source.html#xC">CHSDOCHSVUR2_source.html#xC">C=$ORDER(^TMP("ACHSVUR2_source.html#xC">CHSVUR2",$JOB,ACHSVUR2_source.html#xC">CHSVNDR,ACHSVUR2_source.html#xC">CHSVPTR,ACHSVUR2_source.html#xC">CHSDOCHSVUR2_source.html#xC">C))
IF ACHSDOC=""
GOTO F
SET DA=$ORDER(^(ACHSDOC,0))
SET ACHSNAME=$PIECE(^(DA),U)
SET ACHS("$")=$PIECE(^(DA),U,2)
SET ACHSSSN=$PIECE(^(DA),U,3)
SET ACHSHRN=$PIECE(^(DA),U,4)
SET ACHSSC=$PIECE(^(DA),U,5)
SET ACHSCLRK=$PIECE(^(DA),U,6)
+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,ACHSAMT)=""
+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,$EXTRACT(ACHSNAME,1,25),?42,ACHSHRN,?53,ACHSTOS,?58,ACHSDOS
+2 WRITE !,?3,ACHSCLRK,?16,$EXTRACT(ACHSSSN,6,9),?52,ACHSSC
+3 ;
+4 SET ACHSBLNK=$PIECE(^ACHSF(DUZ(2),"D",DA,0),U,3)
+5 ;
+6 SET X=$FNUMBER(+ACHS("$"),",",2)
+7 IF $DATA(ACHSSTAR)
SET X=X_ACHSSTAR
KILL ACHSSTAR
+8 WRITE ?78-$LENGTH(X),X
SET ACHSAMT=X
+9 IF ACHS("$")["*"
WRITE "*"
SET ACHSPD=ACHSPD+1
SET ACHSPD("$")=ACHSPD("$")+ACHS("$")
SET ACHSAMT=ACHSAMT_"*"
+10 IF $Y>ACHSBM
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO KILL
DO HDR
IF $DATA(ACHSVNDR)
WRITE ACHSVNDR," (continued)"
+11 ;
E ;
+1 SET ACHSVUR2_source.html#xC">CHSVDOCHSVUR2_source.html#xC">C=ACHSVUR2_source.html#xC">CHSVDOCHSVUR2_source.html#xC">C+1
SET ACHSVUR2_source.html#xC">CHSVDOCHSVUR2_source.html#xC">C("$")=ACHSVUR2_source.html#xC">CHSVDOCHSVUR2_source.html#xC">C("$")+ACHSVUR2_source.html#xC">CHS("$")
SET ACHSTOT=ACHSTOT+1
SET ACHSTOT("$")=ACHSTOT("$")+ACHS("$")
+2 IF ACHSFIL="Y"
SET ^TMP($JOB,"ACHSVUR2_source.html#xC">CHSVUR2","RECHSVUR2_source.html#xC">C"_ACHSVUR2_source.html#xC">CHSVDOCHSVUR2_source.html#xC">C)=ACHSVUR2_source.html#xC">CHSDOCHSVUR2_source.html#xC">C_"^"_ACHSVUR2_source.html#xC">CHSNAME_"^"_ACHSVUR2_source.html#xC">CHSHRN_"^"_ACHSVUR2_source.html#xC">CHSTOS_"^"_ACHSVUR2_source.html#xC">CHSDOS_"^"_ACHSVUR2_source.html#xC">CHSCHSVUR2_source.html#xC">CLRK_"^"_$EXTRACHSVUR2_source.html#xC">CT(ACHSVUR2_source.html#xC">CHSSSN,6,9)_"^"_ACHSVUR2_source.html#xC">CHSSCHSVUR2_source.html#xC">C_"^"_ACHSVUR2_source.html#xC">CHSAMT
+3 GOTO C
+4 ;
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 WRITE !,$$REPEAT^XLFSTR("=",79),!
+2 SET X2="2$"
SET X3=16
SET X=ACHSPD("$")
+3 DO COMMA^%DTC
+4 WRITE "TOTAL PAID",?21,"DOCUMENTS:",$JUSTIFY(ACHSPD,5),?42,"DOLLARS:",X,!
+5 IF ACHSFIL="Y"
SET ^TMP($JOB,"ACHSVUR2","TOT1")="TOTAL PAID DOCUMENTS: ^"_$JUSTIFY(ACHSPD,5)_"^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 IF ACHSFIL="Y"
SET ^TMP($JOB,"ACHSVUR2","TOT2")="TOTAL OUTSTANDING DOCUMENTS: ^"_$JUSTIFY(ACHSTOT-ACHSPD,5)_"^DOLLARS: ^"_X
+10 SET X=ACHSTOT("$")
+11 DO COMMA^%DTC
+12 WRITE "GRAND TOTALS",?21,"DOCUMENTS:",$JUSTIFY(ACHSTOT,5),?42,"DOLLARS:",X
+13 IF ACHSFIL="Y"
SET ^TMP($JOB,"ACHSVUR2","TOT3")="GRAND TOTALS DOCUMENTS: ^"_$JUSTIFY(ACHSTOT,5)_"^DOLLARS: ^"_X
+14 IF '$DATA(IO("S"))
DO RTRN^ACHS
+15 WRITE @IOF
+16 QUIT
+17 ;
HDR ; Paginate.
+1 SET ACHSPG=ACHSPG+1
+2 WRITE @IOF,!!?19,"*** CONTRACT HEALTH MANAGEMENT SYSTEM ***",!,ACHSUSR,?71,"Page",$JUSTIFY(ACHSPG,3),!,ACHSLOC,!,ACHST1,!,ACHSV,!,ACHSTIME,!,ACHST2
+3 WRITE !!?3,"DOCUMENT # PATIENT NAME",?43,"HRN",?52,"TYPE DOS",?70,"DOLLARS"
+4 WRITE !,?3,"STAFF",?17,"LAST 4SSN",?53,"OC",?69,"(* = PAID)"
+5 WRITE !,$$REPEAT^XLFSTR("=",79),!
+6 IF ACHSFIL="Y"
Begin DoDot:1
+7 SET ^TMP($JOB,"ACHSVUR2",1)="*** CONTRACT HEALTH MANAGEMENT SYSTEM ***"
+8 SET ^TMP($JOB,"ACHSVUR2",2)=ACHSLOC
+9 SET ^TMP($JOB,"ACHSVUR2",3)=
