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

BMCVDV2.m

Go to the documentation of this file. 
  1. BMCVDV2 ; IHS/OIT/FCJ - YTD PAID VENDOR INFO BY FY ; 
  1.  ;;4.0;REFERRED CARE INFO SYSTEM;**5**;JAN 09, 2006;Build 101
  1.  ;BMC*4.0*5 5.13.2009 IHS.OIT.FCJ ORIGIAL ROUTINE FR ACHSVDV2
  1.  ;
  1.  N BMCIEN
  1.  S BMCIEN=$O(^BMCVPMT(DUZ(2),1,"B",BMCPROV,0))
  1.  I 'BMCIEN W !!,"None on file." Q
  1.  I '$D(^BMCVPMT(DUZ(2),1,BMCIEN,1,0)) W !!,"None on file." Q
  1.  ;
  1.  W !!,"FISCAL YEAR",?16,"A M O U N T",?30,"LAST PMT DATE",!!
  1.  F BMC=0:0 S BMC=$O(^BMCVPMT(DUZ(2),1,BMCIEN,1,BMC)) Q:'BMC  W ?2,BMC,?14,"$",$J($FN($P(^(BMC,0),U,2),",",2),12),?30,$$FMTE^XLFDT($P(^(0),U,3)),!
  1.  Q
  1.  ;
  1. AGRDSP ;EP
  1.  G:'$D(^AUTTVNDR(BMCPROV,18,"AGR",BMCAGTP)) AGRNEW
  1.  D HDR
  1.  S R="",BMCI=0
  1.  K BMCAGRL
  1. AGRDSP1 ;
  1.  S R=$O(^AUTTVNDR(BMCPROV,18,"AGR",BMCAGTP,R))
  1.  G AGRDSPZ:+R=0
  1. A2A ;
  1.  S BMCI=BMCI+1,BMCAGRL(BMCI)=R
  1.  W !,$J(BMCI,2),?3,BMCAGTP,?9,$E($P(^AUTTVNDR(BMCPROV,18,R,0),U,1),1,2),$S(BMCAGTP="BPA":"-A-",BMCAGTP="PA":"-PA-",BMCAGTP="RQ":"-R-",1:"")
  1.  S X=$E($P(^AUTTVNDR(BMCPROV,18,R,0),U,1),3,6)
  1.  I BMCAGTP="PA" W $E(X,2,4) G A2C
  1.  W $E(X,1,4)
  1. A2C ;
  1.  W ?20,$$MDY($P(^AUTTVNDR(BMCPROV,18,R,0),U,8)),?30,$$MDY($P(^AUTTVNDR(BMCPROV,18,R,0),U,9))
  1.  S X=$P(^AUTTVNDR(BMCPROV,18,R,0),U,4)
  1.  I X="",($P(^AUTTVNDR(BMCPROV,18,R,0),U,2)="") G A2D
  1.  S Y=$S(X="Y":"YES",X="N":" NO",1:"   ")
  1.  I Y="   ",($P(^AUTTVNDR(BMCPROV,18,R,0),U,2)="") G A2D
  1.  S Y=Y_"  INP: "
  1.  S:$P(^AUTTVNDR(BMCPROV,18,R,0),U,2)'="" Y=Y_$P(^(0),U,2)
  1.  W ?40,Y,!
  1. A2D ;
  1.  S X=$P(^AUTTVNDR(BMCPROV,18,R,0),U,5)
  1.  I X="",($P(^AUTTVNDR(BMCPROV,18,R,0),U,3)="") G A2E
  1.  S Y=$S(X="Y":"YES",X="N":" NO",1:"   ")
  1.  I Y="   ",($P(^AUTTVNDR(BMCPROV,18,R,0),U,3)="") G A2E
  1.  S Y=Y_"  OUT: "
  1.  S:$P(^AUTTVNDR(BMCPROV,18,R,0),U,3)'="" Y=Y_$P(^(0),U,3)
  1.  W ?40,Y,!
  1. A2E ;
  1.  W:$P(^AUTTVNDR(BMCPROV,18,R,0),U,7)'="" ?45,"PRO: ",$P(^(0),U,7),!
  1.  G AGRDSP1
  1.  ;
  1. AGRDSPZ ;
  1.  Q:$D(BMCRQFL)!$D(BMCPAFL)!$D(BMCBPFL)
  1. AGRSEL ;
  1.  S DA=""
  1.  S Y=$$DIR^XBDIR("NO^1:"_BMCI,"Enter # to Edit","","","","",2)
  1.  Q:$D(DUOUT)!$D(DTOUT)
  1.  I Y="" G AGRNEW
  1.  S DA=BMCAGRL(+Y)
  1.  Q
  1.  ;
  1. AGRNEW ;ADD NEW AGREEMENT INFORMATION HERE
  1.  Q:'$D(^XUSEC("BMCZVEN",DUZ))
  1.  S Y=$$DIR^XBDIR("Y","Want to enter a new Vendor "_$S(BMCAGTP="RQ":"RATE QUOTATION",BMCAGTP="PA":"PROVIDER AGREEMENT",BMCAGTP="BPA":"BLANKET PURCHASE AGREEMENT",1:" "),"N","","","",2)
  1.  Q:$D(DTOUT)!$D(DUOUT)
  1.  I 'Y S DA="" W @IOF Q
  1.  S:'$D(^AUTTVNDR(BMCPROV,18,0)) ^AUTTVNDR(BMCPROV,18,0)=$$ZEROTH^BMC(9999999.11,1801)
  1.  S DIC="^AUTTVNDR("_BMCPROV_",18,",DIC(0)="QAZEML",DA(1)=BMCPROV,DIC("W")="W ""    "",$P(^(0),U,10)"
  1.  D ^DIC
  1.  Q:+Y<1
  1.  S DA(1)=BMCPROV,DA=+Y
  1.  W !
  1.  K DIE,DR
  1.  S DIE("NO^")="",DIE=DIC,DR=".11///^S X=BMCAGTP;.02;.04;.03;.05;.07;.06;.08;.09"
  1.  D ^DIE
  1.  K DIE
  1.  D AGRDSP
  1.  Q
  1.  ;
  1. HDR ;
  1.  W !!," #",?3,"Type",?9,"Number",?20,"Eff-Date",?30,"Exp-Date",?40,"MCR",?45,"Description",!?3,"----",?9,"---------",?20,"--------",?30,"--------",?40,"---",?45,"----------------------------"
  1.  Q
  1.  ;
  1. MDY(X) ;
  1.  Q $E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
  1.  ;