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

ACHSVDF.m

Go to the documentation of this file. 
  1. ACHSVDF ; DSD/GTH - DOCUMENTS BY PROVIDER/VENDOR BY FY ; [ 05/16/2002  10:01 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**26**;JUN 11, 2001;Build 43
  1.  ;3.1*26 NEW ROUTINE
  1.  ;
  1. A ;
  1.  W !!
  1.  S DIC="^AUTTVNDR("
  1.  S DIC(0)="AEZQM"
  1.  S DIC("A")="Enter Provider/Vendor: "
  1.  D ^DIC K DIC
  1.  I +Y<1 G EXIT
  1.  ;
  1.  S ACHSVDOR=+Y,ACHSIO=IO
  1.  I '$D(^ACHSF(DUZ(2),"VB",ACHSVDOR)) W *7,!!,"This vendor has no CHS documents on file.",! W:$$DIR^XBDIR("E","Press <RETURN> To Continue....") "" G A
  1.  ;
  1. SELFY ;  -----  Display FYs, ask FY.
  1.  ;
  1.  D SB1^ACHSFU      ;DISPLAY VALID FISCAL YEARS
  1.  F %=0:0 S %=$O(ACHSFYWK(DUZ(2),%)) Q:'%  S ACHSMIN=$S('$D(ACHSMIN):%,1:ACHSMIN),ACHSMAX=%
  1.  S ACHSSFY=$$DIR^XBDIR("N^"_ACHSMIN_":"_ACHSMAX_":0","ENTER FISCAL YEAR",ACHSMAX,"","ENTER FISCAL YEAR WITH ALL FOUR DIGITS","^D SB1^ACHSFU",1)
  1.  Q:$D(DUOUT)!$D(DTOUT)
  1.  I '$D(ACHSFYWK(DUZ(2),ACHSSFY)) W !,"FY DOES NOT EXIST." G SELFY
  1.  ;
  1. B ;
  1.  W !!,"TYPE of service:"
  1.  S ACHS("A")=$P($G(^DD(9002080.01,3,0)),U,3)
  1.  F ACHS=1:1 S ACHS(ACHS)=$P(ACHS("A"),";",ACHS) Q:ACHS(ACHS)=""  W ?20,$P(ACHS(ACHS),":"),"   ",$P(ACHS(ACHS),":",2),!
  1.  W !,"Select TYPE of service (1 - ",ACHS-1,"  'A' = 'ALL') ALL // "
  1.  D READ^ACHSFU
  1.  G SELFY:$D(DUOUT)
  1.  I $G(ACHSQUIT) G EXIT
  1.  S:(Y="") Y="A"
  1.  G B3:Y="A"
  1.  I ($E(Y)="?")!(Y<1)!(Y>(ACHS-1)) W !!,"Enter an 'A' to view documents for all type of service,",!,"otherwise, enter a number from 1 to ",ACHS-1,".",! G B
  1. B3 ;
  1.  K ACHSTYPE
  1.  S:Y="A" ACHSTYPE="ALL"
  1.  I '$D(ACHSTYPE) S ACHSTYPE=+Y
  1.  ;
  1. D ;
  1.  W !!,"Type of Report:"
  1.  W !!,"1  list only PAID documents"
  1.  W !,"2  list only OPEN documents"
  1.  W !,"3  list only CANCELLED documents"
  1.  W !,"4  list ALL documents"
  1.  W !,"5  print TOTALS ONLY (no specific documents)",!!
  1.  W "list ALL documents// "
  1.  D READ^ACHSFU
  1.  G B:$D(DUOUT)
  1.  I $G(ACHSQUIT) G EXIT
  1.  S:(Y="") Y=4
  1.  I ($E(Y)="?")!(+Y<1)!(+Y>5) W !!,*7,"Enter only '1' through '5'." G D
  1.  S ACHSRPT=+Y
  1. SORT ;SORT BY PATIENT OR PO
  1.  G:ACHSRPT=5 DEV
  1.  S DIR(0)="S^1:Purchase Order;2:Patient",DIR("A")="Sort by",DIR("B")=2
  1.  D ^DIR K DIR
  1.  I $D(DUOUT)!$D(DTOUT) G EXIT
  1.  S ACHSSRT=Y
  1. DEV ;
  1.  S %=$$PB^ACHS
  1.  I %=U!$D(DTOUT)!$D(DUOUT) G EXIT
  1.  I %="B" D VIEWR^XBLM("PRINT^ACHSVDF"),EN^XBVK("VALM"),EXIT Q
  1.  S %ZIS="OPQ"
  1.  D ^%ZIS
  1.  I POP D HOME^%ZIS G EXIT
  1.  G:'$D(IO("Q")) PRINT
  1.  K IO("Q")
  1.  I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
  1.  S ZTRTN="PRINT^ACHSVDF",ZTDESC="CHS VENDOR Document Summary, for Fiscal Year"_ACHSSFY_" for "_ACHSVDOR
  1.  F ACHS="ACHSSRT","ACHSVDOR","ACHSSFY","ACHSRPT","ACHSTYPE" S ZTSAVE(ACHS)=""
  1.  D ^%ZTLOAD
  1.  G:'$D(ZTSK) DEV
  1.  G EXIT
  1.  ;
  1. PRINT ;EP - TaskMan.
  1.  Q:'$D(^AUTTVNDR(ACHSVDOR))
  1.  D FC^ACHSUF
  1.  I $D(ACHSERR),ACHSERR=1 G KILL
  1.  S (ACHSDOC,ACHSOPEN,ACHSOPEN("$"),ACHSPD,ACHSPD("$"),ACHSCNX,ACHSCNX("$"))=0
  1.  S ACHST3=$$C^XBFUNC($S(ACHSRPT=1:"PAID documents only",ACHSRPT=2:"OPEN documents only",ACHSRPT=3:"CANCELLED documents only",1:""),80)
  1.  S ACHST1=$$C^XBFUNC($P(^AUTTVNDR(ACHSVDOR,0),U)_"    EIN #: "_$P(^AUTTVNDR(ACHSVDOR,11),U),80)_"-"_$P(^AUTTVNDR(ACHSVDOR,11),U,2)
  1.  S ACHST2=$$C^XBFUNC("For Fiscal Year "_ACHSSFY,80)
  1.  D BRPT^ACHSFU,HDR
  1.  I ACHSRPT<5 S ACHSTOS=$P(^DD(9002080.01,3,0),U,3),ACHSSTS=$P(^DD(9002080.01,11,0),U,3)
  1. DOC ;
  1.  S ACHSDOC=$O(^ACHSF(DUZ(2),"VB",ACHSVDOR,ACHSDOC))
  1.  I ACHSDOC="",ACHSRPT=5 D END Q
  1.  I ACHSDOC="" G DOC1
  1.  S ACHSDOC0=$G(^ACHSF(DUZ(2),"D",ACHSDOC,0))
  1.  I ACHSDOC0="" W !!,"NO DOCUMENT ZERO NODE FOR X-REF VB FOR FACILITY: "_DUZ(2)_" DOCUMENT IEN: "_ACHSDOC D KILL Q
  1.  G DOC:$P(ACHSDOC0,U,14)'=$E(ACHSSFY,4)
  1.  G DOC:(ACHSTYPE'="ALL")&(ACHSTYPE'=$P(ACHSDOC0,U,4))
  1.  I ACHSRPT<4 S C=$P(ACHSDOC0,U,12) G DOC:ACHSRPT=1&(C'=3),DOC:ACHSRPT=2&(C>2),DOC:ACHSRPT=3&(C'=4)
  1.  G RPT5:ACHSRPT=5
  1.  S ACHSTYP=$P(ACHSDOC0,U,3)
  1.  S X=$S(ACHSTYP=1:"* BLANKET",ACHSTYP=2:"* SPECIAL TRANS",ACHSTYP=0:$P(^DPT($P(^ACHSF(DUZ(2),"D",ACHSDOC,"T",1,0),U,3),0),U),1:"")
  1.  S ^TMP("ACHSVDF",$J,ACHSDOC)=X
  1.  S ^TMP("ACHSVDF",$J,"B",X,ACHSDOC)=""
  1.  G DOC
  1. DOC1 ;
  1.  S ACHSDOC=0,ACHSPAT=0
  1.  I ACHSSRT=1 F  S ACHSDOC=$O(^TMP("ACHSVDF",$J,ACHSDOC)) Q:ACHSDOC'?1N.N  D DOC2  Q:$G(ACHSQUIT)
  1.  I ACHSSRT'=1 F  S ACHSPAT=$O(^TMP("ACHSVDF",$J,"B",ACHSPAT)) Q:ACHSPAT=""  D  Q:$G(ACHSQUIT)
  1.  .S ACHSDOC=0
  1.  .F  S ACHSDOC=$O(^TMP("ACHSVDF",$J,"B",ACHSPAT,ACHSDOC)) Q:ACHSDOC'?1N.N  D DOC2 Q:$G(ACHSQUIT)
  1.  I $G(ACHSQUIT) G EXIT
  1.  D END Q
  1. DOC2 ;
  1.  S ACHSDOC0=$G(^ACHSF(DUZ(2),"D",ACHSDOC,0))
  1.  W !,"DOC. #: ",$P(ACHSDOC0,U,14),"-",ACHSFC,"-",$P(ACHSDOC0,U),"  ("
  1.  K Y
  1.  I $D(^ACHSF(DUZ(2),"D",ACHSDOC,3)),+$P(^(3),U)>0 S Y=+$P(^(3),U)
  1.  S:'$D(Y) Y=+$P(ACHSDOC0,U,2)
  1.  W $$FMTE^XLFDT(Y),")",?45,"SERVICE: ",$P($P(ACHSTOS,";",$P(ACHSDOC0,U,4)),":",2)
  1.  W !?2
  1.  S DFN=$P(^ACHSF(DUZ(2),"D",ACHSDOC,"T",1,0),U,3)
  1.  I +DFN,$D(^DPT(DFN)) W $P(^DPT(DFN,0),U)
  1.  I $P(ACHSDOC0,U,3) W $S($P(ACHSDOC0,U,3)=1:"* BLANKET",$P(ACHSDOC0,U,3)=2:"* SPECIAL TRANS",1:"")
  1. RPT5 ;
  1.  W:ACHSRPT<5 ?45
  1.  I '$D(^ACHSF(DUZ(2),"D",ACHSDOC,"PA")) G P5
  1.  ;
  1.  S ACHS("$")=$S($D(^ACHSF(DUZ(2),"D",ACHSDOC,"ZA")):+^ACHSF(DUZ(2),"D",ACHSDOC,"ZA"),1:+^ACHSF(DUZ(2),"D",ACHSDOC,"PA"))
  1.  I ACHSRPT<5 W "(PAID: " S X=ACHS("$"),X2="2$" D FMT^ACHS W ")"
  1.  S ACHSPD=ACHSPD+1,ACHSPD("$")=ACHSPD("$")+ACHS("$")
  1.  G P6
  1.  ;
  1. P5 ;
  1.  I $P(ACHSDOC0,U,12)]"",ACHSRPT<5 W "(",$P($P(ACHSSTS,";",$P(ACHSDOC0,U,12)+1),":",2),": "
  1.  S ACHS("$")=$S($D(^ACHSF(DUZ(2),"D",ACHSDOC,"ZA")):+^("ZA"),1:$P(ACHSDOC0,U,9))
  1.  I $P(ACHSDOC0,U,12)=4 S ACHS("$")=0,A(1)=$O(^ACHSF(DUZ(2),"D",ACHSDOC,"T",0)) F ACHS=0:0 Q:+A(1)=0  S ACHS("$")=+$P(^(A(1),0),U,4),A(1)=$O(^ACHSF(DUZ(2),"D",ACHSDOC,"T",A(1)))
  1.  I ACHSRPT<5 S X=ACHS("$"),X2="2$" D FMT^ACHS W ")"
  1.  I $P(ACHSDOC0,U,12)=4 S ACHSCNX=ACHSCNX+1,ACHSCNX("$")=ACHSCNX("$")+ACHS("$") G P6
  1.  I $P(ACHSDOC0,U,12)<4 S ACHSOPEN=ACHSOPEN+1,ACHSOPEN("$")=ACHSOPEN("$")+ACHS("$")
  1. P6 ;
  1.  I ACHSRPT<5 W !,$$REPEAT^XLFSTR("-",79)
  1.  I ACHSRPT<5,IOST["C-",$Y>ACHSBM D RTRN^ACHS D:'(ACHSQUIT) HDR
  1.  I ACHSRPT=5 G DOC
  1.  Q
  1.  ;
  1. END ;
  1.  W !,"Total documents: ",ACHSPD+ACHSCNX+ACHSOPEN,!!
  1.  I ACHSPD W "TOTAL PAID DOCUMENTS:",$J(ACHSPD,12),?40,"TOTAL DOLLARS PAID:     " S X=ACHSPD("$"),X2="2$",X3=16 D FMT^ACHS W !
  1.  I ACHSCNX W "TOTAL CANCELLED DOCUMENTS:",$J(ACHSCNX,7),?40,"TOTAL DOLLARS CANCELLED:" S X=ACHSCNX("$"),X2="2$",X3=16 D FMT^ACHS W !
  1.  I ACHSOPEN W "TOTAL OPEN DOCUMENTS:",$J(ACHSOPEN,12),?40,"TOTAL DOLLARS OPEN:     " S X=ACHSOPEN("$"),X3=16 D FMT^ACHS W !
  1.  D RTRN^ACHS
  1.  W @IOF
  1. KILL ;
  1.  K A,ACHSCNX,ACHSDOC0,ACHSDOC,ACHSOPEN,ACHSPD,ACHSSTS,ACHSTOS,ACHSTYPE,ACHSVDOR
  1.  K ACHSQUIT,ACHSPAT,ACHSSRT
  1.  D ERPT^ACHS
  1. EXIT ;
  1.  K A,ACHS,ACHSIO,ACHSVDOR,ACHSBDT,DTOUT,DUOUT,ACHSEDT,ACHSRPT,ACHSTYPE,ZTSK,ACHSSFY,^TMP("ACHSVDF",$J)
  1.  K ACHSMAX,ACHSMIN,ACHSTYP,DFN
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1. HDR ;
  1.  S ACHSPG=ACHSPG+1
  1.  W @IOF,!,$$REPEAT^XLFSTR("*",79)
  1.  W !,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,$$C^XBFUNC("PROVIDER-SPECIFIC CHS ACTIVITIES SUMMARY",80),!,ACHST1,!,ACHST2
  1.  W:ACHST3]"" !,ACHST3
  1.  W !,$$REPEAT^XLFSTR("*",79)
  1.  Q
  1.  ;