Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSVUR2

ACHSVUR2.m

Go to the documentation of this file. 
  1. 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
  1.  ;3.1*26  IHS/OIT/FCJ NEW RTN
  1.  ;Allows selection of one vendor and data to be saved to a file.
  1.  ;
  1.  ;
  1.  S ACHSIO=IO
  1.  K ^TMP($J),^TMP("ACHSVUR2",$J)
  1. BDT ; Enter beginning date.
  1.  S ACHSBDT=$$DATE^ACHS("B","Vendor Usage","ISSUE")
  1.  G K:$D(DUOUT)!$D(DTOUT)!(ACHSBDT<1)
  1. EDT ; Enter the ending date.
  1.  S ACHSEDT=$$DATE^ACHS("E","Vendor Usage","ISSUE")
  1.  G BDT:$D(DUOUT),K:$D(DTOUT)!(ACHSEDT<1),EDT:$$EBB^ACHS(ACHSBDT,ACHSEDT)
  1. DOCS ; Select type of docs to print.
  1.  S ACHSRPT=$$DIR^XBDIR("S^1:ALL documents;2:OPEN documents only","Print which documents","1","","","^D HELP^ACHS(""H1"",""ACHSVUR2"")",2)
  1.  G EDT:$D(DUOUT),K:$D(DTOUT)
  1.  G DOCS:$D(DUOUT),K:$D(DTOUT)
  1. VEND ;  Select one vendor.
  1.  S DIC(0)="AEQMZ",DIC="^AUTTVNDR(",DIC("A")="Enter Provider/Vendor:  "
  1.  S:DIC(0)["L" DLAYGO=9999999.11
  1.  D ^DIC
  1.  K DIC,DLAYGO
  1.  G DOCS:Y=-1
  1.  S ACHSVIEN=+Y
  1.  S ACHSVNAM=$P(^AUTTVNDR(ACHSVIEN,0),U)
  1. FILE ;CREATE A FILE
  1.  S %=$$DIR^XBDIR("Y","Create a file","N","","","^D HELP^ACHS(""H2"",""ACHSVUR2"")",2)
  1.  G VEND:$D(DUOUT),K:$D(DTOUT)
  1.  S ACHSFIL=$S(%:"Y",1:"N")
  1. DEV ; Select device for report.
  1.  W !
  1.  S %=$$PB^ACHS
  1.  I %=U!$D(DTOUT)!$D(DUOUT) D K Q
  1.  I %="B" D VIEWR^XBLM("CALC^ACHSVUR2"),EN^XBVK("VALM") G KILL
  1.  K IOP,%ZIS
  1.  S %ZIS="PQ"
  1.  D ^%ZIS,SLV^ACHSFU:$D(IO("S"))
  1.  K %ZIS
  1.  I POP W !,*7,"No device specified." D HOME^%ZIS G K
  1.  I '$D(IO("Q")) D CALC G KILL
  1.  K IO("Q")
  1.  I $E(IOST)'="P" W *7,!,"Please queue to printers only." G DEV
  1.  S ZTIO="",ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL,ZTRTN="CALC^ACHSVUR2",ZTDESC="CHS Vendor Report, "_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT)
  1.  F %="ACHSVIEN","ACHSVNAM","ACHSHRN","ACHSDOB","ACHSQIO","ACHSBDT","ACHSRPT","ACHSEDT" S ZTSAVE(%)=""
  1.  D ^%ZTLOAD
  1.  G:'$D(ZTSK) DEV
  1. KILL ; Kill vars, close device, quit.
  1.  I ACHSFIL="Y" D FILSAV
  1.  X:$D(IO("S")) ACHSPPC
  1.  K DA,DFN,ZTSK,^TMP($J,"ACHSVUR2")
  1.  K ^TMP("ACHSVUR2",$J)
  1.  D ERPT^ACHS,EN^XBVK("ACHS"),^ACHSVAR:'$D(ZTQUEUED)
  1. K ; Kill vars, close device, quit.
  1.  K ACHSAMT,ACHSVIEN,ACHSVNAM,ACHSHRN,ACHSDOB,ACHSBDT,ACHSEDT,ACHSIO,ACHSQIO,ACHSRPT,DTOUT,DUOUT,ZTSK
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1. CALC ;EP - TaskMan.
  1.  D FC^ACHSUF
  1.  I $D(ACHSERR),ACHSERR=1 G K
  1.  S ACHSTRDT=ACHSBDT-1
  1.  K ^TMP($J,"ACHSVUR2")
  1.  ;
  1. TRDT ; Loop thru transaction date x-ref.
  1.  S ACHSTRDT=$O(^ACHSF(DUZ(2),"TB",ACHSTRDT))
  1.  G PRINT:+ACHSTRDT=0!(+ACHSTRDT>ACHSEDT)
  1.  S ACHSTYPE=""
  1.  ;
  1. TRTYPE ; Loop thru transaction type.
  1.  S ACHSTYPE=$O(^ACHSF(DUZ(2),"TB",ACHSTRDT,ACHSTYPE))
  1.  G TRDT:ACHSTYPE="",TRTYPE:ACHSTYPE'="I"
  1.  S DA=0
  1.  ;
  1. TRANS ; Loop thru transactions, compile report data.
  1.  S (ACHSDOCN,ACHSVPTR,ACHSFY,ACHSSTS,DFN,ACHSSCPT,ACHSSC,ACHSCLRK,ACHSDOC,ACHSBLNK)=""
  1.  ;
  1.  S DA=$O(^ACHSF(DUZ(2),"TB",ACHSTRDT,ACHSTYPE,DA))
  1.  G TRDT:+DA=0,TRDT:'$D(^ACHSF(DUZ(2),"D",DA,0))
  1.  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)
  1.  ;
  1.  I ACHSVPTR'=ACHSVIEN G TRANS   ;SINGLE PROVIDER
  1.  ;
  1.  ;Amount either adjusted amount or payment amount, or, if that doesn't exist, the
  1.  ;obligated amount
  1.  ;
  1.  D
  1.  . I $D(^ACHSF(DUZ(2),"D",DA,"ZA")) S ACHS("$")=$G(^ACHSF(DUZ(2),"D",DA,"ZA")),ACHS("$")=+ACHS("$")_"*" Q
  1.  . I $D(^ACHSF(DUZ(2),"D",DA,"PA")) S ACHS("$")=$G(^ACHSF(DUZ(2),"D",DA,"PA")),ACHS("$")=+ACHS("$")_"*" Q
  1.  . S ACHS("$")=$P($G(^ACHSF(DUZ(2),"D",DA,0)),U,9)
  1.  ;
  1.  G TRANS:(DFN'=+DFN)&('ACHSBLNK),TRANS:ACHSSTS=4!(ACHSRPT=2&(ACHSSTS>2))!(ACHSVPTR']""),TRANS:'$D(^AUTTVNDR(ACHSVPTR,0)) S ACHSVNDR=$P(^(0),U)
  1.  I 'ACHSBLNK,'$D(^DPT(DFN,0)) G TRANS
  1.  ;
  1.  I $D(DFN),(DFN'="") S ACHSSSN=$P($G(^DPT(DFN,0)),"^",9),ACHSHRN=$P(^AUPNPAT(DFN,41,DUZ(2),0),"^",2)
  1.  ;
  1.  S ACHSSCPT=$P($G(^ACHSF(DUZ(2),"D",DA,0)),U,7)
  1.  S ACHSSC=$P($G(^ACHS(3,DUZ(2),1,+ACHSSCPT,0)),"^",1)
  1.  S ACHSCLRK=$P(^ACHSF(DUZ(2),"D",DA,0),U,18)
  1.  S ACHSCLRK=$P($G(^VA(200,ACHSCLRK,0)),"^",2)
  1.  ;
  1.  ;
  1.  S ACHSDOC=ACHSFY_"-"_ACHSFC_"-"_ACHSDOCN
  1.  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)
  1.  G TRANS
  1.  ;
  1. PRINT ; Kill calc vars, print.
  1.  K ACHSBLNK,ACHSDOCN,ACHSFY,ACHSSTS,ACHSTRDT,ACHSTYPE
  1.  ;
  1.  S ACHSVNDR="",(ACHSTOT,ACHSTOT("$"),ACHSPD,ACHSPD("$"))=0,ACHST1=$$C^XBFUNC("VENDOR USAGE REPORT - "_$S(ACHSRPT=2:"OPEN DOCUMENTS ONLY",1:"OPEN AND PAID DOCUMENTS"))
  1.  S ACHST2=$$C^XBFUNC("For the period "_$$FMTE^XLFDT(ACHSBDT)_" through "_$$FMTE^XLFDT(ACHSEDT)),X3=0
  1.  S ACHSV=$$C^XBFUNC("Provider: "_ACHSVNAM)
  1.  D BRPT^ACHSFU
  1.  X:$D(IO("S")) ACHSPPO
  1.  D HDR
  1.  K ACHSHDR
  1. A ;
  1.  S ACHSVNDR=$O(^TMP("ACHSVUR2",$J,ACHSVNDR))
  1.  G ENDPRNT:ACHSVNDR=""
  1.  S ACHSVPTR=0
  1. B ;
  1.  S ACHSVPTR=$O(^TMP("ACHSVUR2",$J,ACHSVNDR,ACHSVPTR))
  1.  G A:+ACHSVPTR=0,B:'$D(^AUTTVNDR(ACHSVPTR))
  1.  S ACHSHDR=""
  1.  S ACHSDOC="",(ACHSVDOC,ACHSVDOC("$"))=0
  1.  ;
  1. C ;
  1.  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)
  1.  G C:'$D(^ACHSF(DUZ(2),"D",DA,0)) S ACHSTOS=$P(^(0),U,4),DFN=$P(^(0),U,22)
  1.  I +ACHSTOS>0 S ACHSTOS=$P($P($P($P(^DD(9002080.01,3,0),U,3),";",ACHSTOS),":",2)," ")
  1.  S (Y,ACHSDOS,ACHSAMT)=""
  1.  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)
  1.  ;
  1. D ;
  1.  W !?3,ACHSDOC,?16,$E(ACHSNAME,1,25),?42,ACHSHRN,?53,ACHSTOS,?58,ACHSDOS
  1.  W !,?3,ACHSCLRK,?16,$E(ACHSSSN,6,9),?52,ACHSSC
  1.  ;
  1.  S ACHSBLNK=$P(^ACHSF(DUZ(2),"D",DA,0),U,3)
  1.  ;
  1.  S X=$FN(+ACHS("$"),",",2)
  1.  I $D(ACHSSTAR) S X=X_ACHSSTAR K ACHSSTAR
  1.  W ?78-$L(X),X S ACHSAMT=X
  1.  I ACHS("$")["*" W "*" S ACHSPD=ACHSPD+1,ACHSPD("$")=ACHSPD("$")+ACHS("$"),ACHSAMT=ACHSAMT_"*"
  1.  I $Y>ACHSBM D RTRN^ACHS G KILL:$D(DUOUT)!$D(DTOUT) D HDR W:$D(ACHSVNDR) ACHSVNDR," (continued)"
  1.  ;
  1. E ;
  1.  S ACHSVDOC=ACHSVDOC+1,ACHSVDOC("$")=ACHSVDOC("$")+ACHS("$"),ACHSTOT=ACHSTOT+1,ACHSTOT("$")=ACHSTOT("$")+ACHS("$")
  1.  I ACHSFIL="Y" S ^TMP($J,"ACHSVUR2","REC"_ACHSVDOC)=ACHSDOC_"^"_ACHSNAME_"^"_ACHSHRN_"^"_ACHSTOS_"^"_ACHSDOS_"^"_ACHSCLRK_"^"_$E(ACHSSSN,6,9)_"^"_ACHSSC_"^"_ACHSAMT
  1.  G C
  1.  ;
  1. F ;
  1.  S X2="2$",X3=16,X=ACHSVDOC("$")
  1.  D COMMA^%DTC
  1.  W !?10,$$REPEAT^XLFSTR("-",55),!?10,"TOTALS     DOCUMENTS:",$J(ACHSVDOC,5),?42,"DOLLARS:",X,!,$$REPEAT^XLFSTR("-",79),!
  1.  G B
  1.  ;
  1. ENDPRNT ;
  1.  W !,$$REPEAT^XLFSTR("=",79),!
  1.  S X2="2$",X3=16,X=ACHSPD("$")
  1.  D COMMA^%DTC
  1.  W "TOTAL PAID",?21,"DOCUMENTS:",$J(ACHSPD,5),?42,"DOLLARS:",X,!
  1.  I ACHSFIL="Y" S ^TMP($J,"ACHSVUR2","TOT1")="TOTAL PAID DOCUMENTS: ^"_$J(ACHSPD,5)_"^DOLLARS: ^"_X
  1.  S X=ACHSTOT("$")-ACHSPD("$")
  1.  D COMMA^%DTC
  1.  W "TOTAL OUTSTANDING",?21,"DOCUMENTS:",$J(ACHSTOT-ACHSPD,5),?42,"DOLLARS:",X,!,$$REPEAT^XLFSTR("-",79),!
  1.  I ACHSFIL="Y" S ^TMP($J,"ACHSVUR2","TOT2")="TOTAL OUTSTANDING DOCUMENTS: ^"_$J(ACHSTOT-ACHSPD,5)_"^DOLLARS: ^"_X
  1.  S X=ACHSTOT("$")
  1.  D COMMA^%DTC
  1.  W "GRAND TOTALS",?21,"DOCUMENTS:",$J(ACHSTOT,5),?42,"DOLLARS:",X
  1.  I ACHSFIL="Y" S ^TMP($J,"ACHSVUR2","TOT3")="GRAND TOTALS DOCUMENTS: ^"_$J(ACHSTOT,5)_"^DOLLARS: ^"_X
  1.  D RTRN^ACHS:'$D(IO("S"))
  1.  W @IOF
  1.  Q
  1.  ;
  1. HDR ; Paginate.
  1.  S ACHSPG=ACHSPG+1
  1.  W @IOF,!!?19,"***  CONTRACT HEALTH MANAGEMENT SYSTEM  ***",!,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,ACHSLOC,!,ACHST1,!,ACHSV,!,ACHSTIME,!,ACHST2
  1.  W !!?3,"DOCUMENT #   PATIENT NAME",?43,"HRN",?52,"TYPE    DOS",?70,"DOLLARS"
  1.  W !,?3,"STAFF",?17,"LAST 4SSN",?53,"OC",?69,"(* = PAID)"
  1.  W !,$$REPEAT^XLFSTR("=",79),!
  1.  I ACHSFIL="Y" D
  1.  .S ^TMP($J,"ACHSVUR2",1)="***  CONTRACT HEALTH MANAGEMENT SYSTEM  ***"
  1.  .S ^TMP($J,"ACHSVUR2",2)=ACHSLOC
  1.  .S ^TMP($J,"ACHSVUR2",3)= ACHST1
  1.  .S ^TMP($J,"ACHSVUR2",4)=ACHSV
  1.  .S ^TMP($J,"ACHSVUR2","HDR4")=ACHSTIME
  1.  .S ^TMP($J,"ACHSVUR2","HDR5")=ACHST2
  1.  .S ^TMP($J,"ACHSVUR2","HDR6")= "DOCUMENT #^PATIENT NAME^HRN^TYPE^DOS^STAFF^LAST-4SSN^OC^DOLLARS *=PAID"
  1.  Q
  1.  ;
  1. H1 ;EP - From HELP^ACHS() via ^DIR.
  1.  ;;@;!
  1.  ;;Enter a '1' if you want to list all documents.
  1.  ;;Enter a '2' if you want only OPEN documents to be listed.
  1.  ;;###
  1.  ;
  1. H2 ;EP - From HELP^ACHS() via ^DIR.
  1.  ;;@;!
  1.  ;;Enter 'Y' to create a file to be transferred into excel.
  1.  ;;@;!!
  1.  ;;###
  1.  ;
  1. FILSAV ;SAVE FILE
  1.  ;
  1.  N XBFN,XBE,XBJ,XBUF,XBQ,XBMED,XBFLT,XBS1,XBIO,XBF,XBGL
  1.  S X=$E(DT,4,7)_$E(DT,2,3)
  1.  D NOW^%DTC S X=(%I(3)+1700)_$E(%,4,7)_"_"_$P(%,".",2)
  1.  S:$L(X)'=15 X=X_0
  1.  S X1=$$ASF^ACHS(DUZ(2)),XBE=$J
  1.  S XBFN="CHS-"_$TR(ACHSVNAM," ","")_"-"_X1_"."_X
  1.  S XBMED="F",XBFLT=1
  1.  S XBQ="N"
  1.  S XBUF=$$PARM^ACHS(1,5)
  1.  I XBUF="" S XBUF=$P(^AUTTSITE(1,1),U,2)
  1.  S XBS1="ACHS REPORTS"
  1.  S XBIO=51,XBF=$J,XBGL="^TMP(" D ^ZIBGSVEM
  1.  ;S XBGL="TMP("_$J_",""ACHSVUR2"","D ^XBGSAVE
  1.  Q
  1.  ;