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

BMCVDV1.m

Go to the documentation of this file. 
  1. BMCVDV1 ; IHS/OIT/FCJ - SELECT CONTRACT NUMBER ; [ 10/15/2004  3:02 PM ]
  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 ACHSVDV1
  1.  ;
  1. A4 ;EP
  1.  G A6:'$D(^AUTTVNDR(BMCPROV,"CN"))
  1.  K BMCCTFL,BMCRQFL,BMCPAFL,BMCBPFL
  1.  ;
  1.  S Y=$$DIR^XBDIR("Y","Want to see Vendor Contract Information","NO","","","",2)
  1.  G END^BMCVDV:$D(DTOUT),A1^BMCVDV:$D(DUOUT),A6:'Y
  1.  S BMCACO="L",P=BMCPROV,A("DISPLAY")=1,BMCCTFL=""
  1.  D L^BMCVDV1
  1. A6 ;
  1.  G:BMCRT("RQ")<0 A7
  1.  S Y=$$DIR^XBDIR("Y","Want to see Vendor Rate Quotation Information","NO","","","",2)
  1.  G END^BMCVDV:$D(DTOUT),A1^BMCVDV:$D(DUOUT),A7:'Y
  1.  S BMCAGTP="RQ",BMCRQFL=""
  1.  D AGRDSP^BMCVDV2
  1. A7 ;
  1.  G:'$D(BMCRT("PA")) A8
  1.  S Y=$$DIR^XBDIR("Y","Want to see Vendor Agreement Information","NO","","","",2)
  1.  G END^BMCVDV:$D(DTOUT),A1^BMCVDV:$D(DUOUT),A8:'Y
  1.  S BMCAGTP="PA",BMCPAFL=""
  1.  D AGRDSP^BMCVDV2
  1. A8 ;
  1.  G:'$D(BMCRT("BPA")) A9
  1.  S Y=$$DIR^XBDIR("Y","Want to see Vendor BPA Information","NO","","","",2)
  1.  G END^BMCVDV:$D(DTOUT),A1^BMCVDV:$D(DUOUT),A9:'Y
  1.  S BMCAGTP="BPA",BMCBPFL=""
  1.  D AGRDSP^BMCVDV2
  1. A9 ;
  1.  I '$D(^XUSEC("BMCZVEN",DUZ)) G END^BMCVDV:'$$DIR^XBDIR("E")
  1.  G A1^BMCVDV
  1.  ;
  1. L ;EP
  1.  S E=9999999-DT,(S,C,L)=""
  1.  I '$D(BMCACO) S BMCACO=""
  1. L1 ;
  1.  S S=$O(^AUTTVNDR(BMCPROV,"E",S))
  1.  G L3:S=""
  1.  S N=""
  1. L2 ;
  1.  S N=$O(^AUTTVNDR(BMCPROV,"E",S,N))
  1.  G L1:N="",L2:'$D(^AUTTVNDR(BMCPROV,"CN",N,0))
  1.  S I=$P(^AUTTVNDR(BMCPROV,"CN",N,0),U),C=C+1,L=N_U_S_U_I I BMCACO["L" D SBT:C=1 W !,$J(C,2),?3,$J($P(^(0),U),18) S D=$P(^(0),U,2,3) D SBD S C(C)=N
  1.  I BMCACO["F",C=F G L3
  1.  I $Y>24 K DIR S DIR(0)="E" D ^DIR Q:Y=0  K DIR D SBT
  1.  G L2
  1.  ;
  1. L3 ;
  1.  G END:'$D(^XUSEC("BMCZVEN",DUZ)),NEW:'$D(^AUTTVNDR(BMCPROV,"CN")),NEW:$P(^AUTTVNDR(BMCPROV,"CN",0),U,4)<1!(A("DISPLAY"))!(+C<1)
  1.  W !!,"Which one: "
  1.  D READ^BMC
  1.  G END:$D(DUOUT)
  1.  I Y?1"?".E W !!?3,"Enter 1 thru ",C G L3
  1.  I Y="" G NEW
  1.  I Y'?1N.N!(Y>C) W !!,"Enter 1 thru ",C G L3
  1.  S DA=C(Y)
  1. END ;
  1.  K C,N,S,BMCCTFL,BMCRQFL,BMCPAFL,BMCBPFL
  1.  Q
  1.  ;
  1. SBD ;
  1.  W ?22,$$FMTE^XLFDT($P(D,U)),?35,$$FMTE^XLFDT($P(D,U,2)),?49,$E($P(^AUTTVNDR(BMCPROV,"CN",N,0),U,5),1,30)
  1.  Q
  1.  ;
  1. SBT ;EP
  1.  W @IOF,!!?5,"Contract Number",?22,"Begin Date",?35,"Ending Date",?49,"Description of Service",!?5,"---------------",?22,"------------",?35,"------------",?49,"-------------------------"
  1.  Q
  1.  ;
  1. NEW ;
  1.  W:+C<1 !!,"No Contracts on file."
  1.  I $D(BMCCTFL) S DA="" G END
  1.  W !!,"Want to Enter a New Contract?  NO// "
  1.  D READ^BMC
  1.  G END:$D(DUOUT)
  1.  S Y=$E(Y_"N"),Y=$$UP^XLFSTR(Y)
  1.  I Y?1"?".E D YN^BMC G NEW
  1.  I Y=""!(Y?1"N".E) S DA="" G END
  1.  I Y'?1"Y".E D YN^BMC G NEW
  1. NEW1 ;
  1.  W !!,"Enter CONTRACT NUMBER: "
  1.  D READ^BMC
  1.  G NEW:$D(DUOUT)
  1.  I Y?1"?".E W !!,"Enter New Contract Number " G NEW1
  1.  G NEW:Y=""
  1.  S:'$D(^AUTTVNDR(BMCPROV,"CN",0)) ^(0)="^9999999.1112^"
  1.  S DA(1)=BMCPROV,X=Y,DIC="^AUTTVNDR("_BMCPROV_",""CN"",",DIC(0)="ELMQZ"
  1.  D ^DIC
  1.  G NEW:Y=-1
  1.  S DA=+Y
  1.  W !
  1.  S DIE("NO^")="",DIE="^AUTTVNDR("_BMCPROV_",""CN"",",DA(1)=BMCPROV,DR="1;2;4;3"
  1.  D ^DIE
  1.  K DIE,DA
  1.  G END
  1.  ;
  1. MP ;EP
  1.  W @IOF D MPDSP
  1.  S (BMCMP,CT)=0
  1.  F I=1:1  S BMCMP=$O(^AUTTVNDR(BMCPROV,"MP",BMCMP)) Q:BMCMP'>0  D
  1.  .S BMCDSP(I)=^AUTTVNDR(BMCPROV,"MP",BMCMP,0)
  1.  .I BMCDSP(I)'="" S CT=CT+1 S BMCMPN=$P(BMCDSP(I),U),BMCBDT=$P(BMCDSP(I),U,3),BMCEDT=$P(BMCDSP(I),U,4),BMCDES=$P(BMCDSP(I),U,2)
  1.  .I $D(BMCDES) S BMCDES=$$EXTSET^XBFUNC(9999999.112303,2,BMCDES)
  1.  .W ?2,CT,?6,$G(BMCMPN),?23,$$FMTE^XLFDT($G(BMCBDT)),?37,$$FMTE^XLFDT($G(BMCEDT)),?51,$G(BMCDES),!
  1.  W:CT=0 !!,?6,"No Medicare Numbers listed.",! G ASK1
  1.  I CT>0 G ASK1
  1.  Q
  1.  ;
  1. MPDSP ;DISPLAY MEDICARE PROVIDER INFO
  1.  W !!,"Item",?6,"Medicare Number",?23,"Begin Date",?37,"End Date",?51,"Description",!,"----",?6,"---------------",?23,"------------",?37,"------------",?51,"-------------------------",!
  1.  Q
  1.  ;
  1. ASK1 ;     
  1.  S Y=$$DIR^XBDIR("Y","Want to add Medicare Information","NO","","","",2)
  1.  G END:$D(DUOUT),ASK2:'Y
  1.  I Y G MPADD
  1. ASK2 ;
  1.  S Y=$$DIR^XBDIR("Y","Want to edit Medicare Information","NO","","","",2)
  1.  G END:$D(DUOUT),END:'Y
  1.  I Y G MPEDIT
  1. MPADD ;
  1.  W !!,"Enter the Medicare NUMBER: "
  1.  D READ^BMC
  1.  G END:$D(DUOUT)
  1.  I Y?1"?".E W !!,"Enter New Number " G MPADD
  1.  S:'$D(^AUTTVNDR(BMCPROV,"MP",0)) ^(0)="^9999999.112303^"
  1.  S DA(1)=BMCPROV,X=Y,DIC="^AUTTVNDR("_BMCPROV_",""MP"",",DIC(0)="ELMQZ"
  1.  D ^DIC
  1.  G MPADD:Y=-1
  1.  S DA=+Y
  1.  W !
  1.  S DIE("NO^")="",DIE="^AUTTVNDR("_BMCPROV_",""MP"",",DA(1)=BMCPROV,DR="2;3;4"
  1.  D ^DIE
  1.  K DIE,DA
  1.  G END
  1.  ;
  1. MPEDIT ;
  1.  W !!,"Which item: "
  1.  D READ^BMC
  1.  G END:$D(DUOUT)
  1.  I Y?1"?".E W !!?3,"Enter 1 thru ",CT G MPEDIT
  1.  I Y="" G MPEDIT
  1.  I Y'?1N.N!(Y>CT) W !!,"Enter 1 thru ",CT G MPEDIT
  1.  S X=$P(BMCDSP(Y),U)
  1.  S DA(1)=BMCPROV,DIC="^AUTTVNDR("_BMCPROV_",""MP"",",DIC(0)="ELMQZ"
  1.  D ^DIC
  1.  G MPADD:Y=-1
  1.  S DA=+Y
  1.  W !
  1.  S DIE("NO^")="",DIE="^AUTTVNDR("_BMCPROV_",""MP"",",DA(1)=BMCPROV,DR=".01;2;3;4"
  1.  D ^DIE
  1.  K DIE,DA
  1.  G END
  1.  G END:'Y