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

ACHSVDV1.m

Go to the documentation of this file. 
  1. ACHSVDV1 ; IHS/ITSC/JVK - SELECT CONTRACT NUMBER ; [ 10/15/2004  3:02 PM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**11,15**;JUNE 11, 2001
  1.  ;ITSC/SET/JVK ACHS*3.1*11 MODIFIED TO DISPLAY MEDICARE PROVIDER INFO
  1.  ;ACHS*3.1*15 OIT.IHS.FCJ CHANGED TO ACCOMODATE THE 18 CHAR CONTRACT NUMBER
  1.  ;
  1. A4 ;EP
  1.  G A6:'$D(^AUTTVNDR(ACHSPROV,"CN"))
  1.  K ACHSCTFL,ACHSRQFL,ACHSPAFL,ACHSBPFL
  1.  ;
  1.  S Y=$$DIR^XBDIR("Y","Want to see Vendor Contract Information","NO","","","",2)
  1.  G END^ACHSVDV:$D(DTOUT),A1^ACHSVDV:$D(DUOUT),A6:'Y
  1.  S ACHSACO="L",P=ACHSPROV,A("DISPLAY")=1,ACHSCTFL=""
  1.  D L^ACHSVDV1
  1. A6 ;
  1.  G:ACHSRT("RQ")<0 A7
  1.  S Y=$$DIR^XBDIR("Y","Want to see Vendor Rate Quotation Information","NO","","","",2)
  1.  G END^ACHSVDV:$D(DTOUT),A1^ACHSVDV:$D(DUOUT),A7:'Y
  1.  S ACHSAGTP="RQ",ACHSRQFL=""
  1.  D AGRDSP^ACHSVDV2
  1. A7 ;
  1.  G:'$D(ACHSRT("PA")) A8
  1.  S Y=$$DIR^XBDIR("Y","Want to see Vendor Agreement Information","NO","","","",2)
  1.  G END^ACHSVDV:$D(DTOUT),A1^ACHSVDV:$D(DUOUT),A8:'Y
  1.  S ACHSAGTP="PA",ACHSPAFL=""
  1.  D AGRDSP^ACHSVDV2
  1. A8 ;
  1.  G:'$D(ACHSRT("BPA")) A9
  1.  S Y=$$DIR^XBDIR("Y","Want to see Vendor BPA Information","NO","","","",2)
  1.  G END^ACHSVDV:$D(DTOUT),A1^ACHSVDV:$D(DUOUT),A9:'Y
  1.  S ACHSAGTP="BPA",ACHSBPFL=""
  1.  D AGRDSP^ACHSVDV2
  1. A9 ;
  1.  S Y=$$DIR^XBDIR("Y","Want to see Prior FY Payments for this Vendor","NO","","","",2)
  1.  G A1^ACHSVDV:$D(DTOUT)!$D(DUOUT)!('Y)
  1.  D ^ACHSVDV2
  1.  I $$DIR^XBDIR("E","Press RETURN...","","","","",1)
  1.  G A1^ACHSVDV
  1.  ;
  1. L ;EP
  1.  S E=9999999-DT,(S,C,L)=""
  1.  I '$D(ACHSACO) S ACHSACO=""
  1. L1 ;
  1.  S S=$O(^AUTTVNDR(ACHSPROV,"E",S))
  1.  G L3:S=""
  1.  S N=""
  1. L2 ;
  1.  S N=$O(^AUTTVNDR(ACHSPROV,"E",S,N))
  1.  G L1:N="",L2:'$D(^AUTTVNDR(ACHSPROV,"CN",N,0))
  1.  ;ACHS*3.1*15 OIT.IHS.FCJ CHANGED TO ACCOMODATE THE 18 CHAR CONTRACT NUMBER
  1.  ;S I=$P(^AUTTVNDR(ACHSPROV,"CN",N,0),U),C=C+1,L=N_U_S_U_I I ACHSACO["L" D SBT:C=1 W !,$J(C,4),?4,$J($P(^(0),U),15) S D=$P(^(0),U,2,3) D SBD S C(C)=N
  1.  S I=$P(^AUTTVNDR(ACHSPROV,"CN",N,0),U),C=C+1,L=N_U_S_U_I I ACHSACO["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 ACHSACO["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("ACHSZMGR",DUZ)),NEW:'$D(^AUTTVNDR(ACHSPROV,"CN")),NEW:$P(^AUTTVNDR(ACHSPROV,"CN",0),U,4)<1!(A("DISPLAY"))!(+C<1)
  1.  W !!,"Which one: "
  1.  D READ^ACHSFU
  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,ACHSCTFL,ACHSRQFL,ACHSPAFL,ACHSBPFL
  1.  Q
  1.  ;
  1. SBD ;
  1.  W ?22,$$FMTE^XLFDT($P(D,U)),?35,$$FMTE^XLFDT($P(D,U,2)),?49,$E($P(^AUTTVNDR(ACHSPROV,"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(ACHSCTFL) S DA="" G END
  1.  W !!,"Want to Enter a New Contract?  NO// "
  1.  D READ^ACHSFU
  1.  G END:$D(DUOUT)
  1.  S Y=$E(Y_"N"),Y=$$UP^XLFSTR(Y)
  1.  I Y?1"?".E D YN^ACHS G NEW
  1.  I Y=""!(Y?1"N".E) S DA="" G END
  1.  I Y'?1"Y".E D YN^ACHS G NEW
  1. NEW1 ;
  1.  W !!,"Enter CONTRACT NUMBER: "
  1.  D READ^ACHSFU
  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(ACHSPROV,"CN",0)) ^(0)="^9999999.1112^"
  1.  S DA(1)=ACHSPROV,X=Y,DIC="^AUTTVNDR("_ACHSPROV_",""CN"",",DIC(0)="ELMQZ"
  1.  D ^DIC
  1.  G NEW:Y=-1
  1.  S DA=+Y
  1.  W !
  1.  S DIE("NO^")="",DIE="^AUTTVNDR("_ACHSPROV_",""CN"",",DA(1)=ACHSPROV,DR="1;2;4;3"
  1.  D ^DIE
  1.  K DIE,DA
  1.  G END
  1.  ;
  1. MP ;EP -- ITSC/SET/JVK ACHS*3.1*11 FIND MEDICARE PROVIDER INFO
  1.  W @IOF D MPDSP
  1.  S (ACHSMP,CT)=0
  1.  F I=1:1  S ACHSMP=$O(^AUTTVNDR(ACHSPROV,"MP",ACHSMP)) Q:ACHSMP'>0  D
  1.  .S ACHSDSP(I)=^AUTTVNDR(ACHSPROV,"MP",ACHSMP,0)
  1.  .I ACHSDSP(I)'="" S CT=CT+1 S ACHSMPN=$P(ACHSDSP(I),U),ACHSBDT=$P(ACHSDSP(I),U,3),ACHSEDT=$P(ACHSDSP(I),U,4),ACHSDES=$P(ACHSDSP(I),U,2)
  1.  .I $D(ACHSDES) S ACHSDES=$$EXTSET^XBFUNC(9999999.112303,2,ACHSDES)
  1.  .W ?2,CT,?6,$G(ACHSMPN),?23,$$FMTE^XLFDT($G(ACHSBDT)),?37,$$FMTE^XLFDT($G(ACHSEDT)),?51,$G(ACHSDES),!
  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^ACHSFU
  1.  G END:$D(DUOUT)
  1.  I Y?1"?".E W !!,"Enter New Number " G MPADD
  1.  S:'$D(^AUTTVNDR(ACHSPROV,"MP",0)) ^(0)="^9999999.112303^"
  1.  S DA(1)=ACHSPROV,X=Y,DIC="^AUTTVNDR("_ACHSPROV_",""MP"",",DIC(0)="ELMQZ"
  1.  D ^DIC
  1.  G MPADD:Y=-1
  1.  S DA=+Y
  1.  W !
  1.  S DIE("NO^")="",DIE="^AUTTVNDR("_ACHSPROV_",""MP"",",DA(1)=ACHSPROV,DR="2;3;4"
  1.  D ^DIE
  1.  K DIE,DA
  1.  G END
  1.  ;
  1. MPEDIT ;
  1.  W !!,"Which item: "
  1.  D READ^ACHSFU
  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(ACHSDSP(Y),U)
  1.  S DA(1)=ACHSPROV,DIC="^AUTTVNDR("_ACHSPROV_",""MP"",",DIC(0)="ELMQZ"
  1.  D ^DIC
  1.  G MPADD:Y=-1
  1.  S DA=+Y
  1.  W !
  1.  S DIE("NO^")="",DIE="^AUTTVNDR("_ACHSPROV_",""MP"",",DA(1)=ACHSPROV,DR=".01;2;3;4"
  1.  D ^DIE
  1.  K DIE,DA
  1.  G END
  1.  G END:'Y
  1.  ;ITSC/SET/JVK ACHS*3.1*11 END FOR ADDITIONS FOR MEDICARE PROV. NO.