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

ACHSVDV.m

Go to the documentation of this file. 
  1. ACHSVDV ; IHS/ITSC/PMF - 1/2 VIEW/EDIT PROVIDER-VENDOR FILE ;
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**6,11,13,19,23,24**;JUN 11, 2001;Build 43
  1.  ;ITSC/SET/JVK ACHS*3.1*6 MODIFIED TO DISPLAY ACTUAL CONTENT OF FIELD
  1.  ;ITSC/SET/JVK ACHS*3.1*11 MODIFIED TO DISPLAY MEDICARE PROVIDER
  1.  ;ACHS*3.1*13 11/29/06 IHS/OIT/FCJ FORMAT CHANGES AND ADDED DUNS NUMBER OPTION 11
  1.  ;
  1. A1 ;EP
  1.  D LINES^ACHSFU,HDR
  1.  S DIC(0)="AEQMZ"_$S($D(^XUSEC("ACHSZMGR",DUZ)):"L",1:""),DIC="^AUTTVNDR(",DIC("A")="Enter Provider/Vendor:  "
  1.  S:DIC(0)["L" DLAYGO=9999999.11
  1.  D ^DIC
  1.  K DIC,DLAYGO
  1.  G END:Y=-1
  1.  S ACHSPROV=+Y
  1.  G ^ACHSVDVD
  1.  ;
  1. A1A ;EP
  1.  S:'$D(^AUTTVNDR(ACHSPROV,11))#2 ^AUTTVNDR(ACHSPROV,11)=""
  1.  S:'$D(^AUTTVNDR(ACHSPROV,13))#2 ^AUTTVNDR(ACHSPROV,13)=""
  1. A2 ;EP
  1.  Q:'$D(ACHSPROV)
  1.  S ACHS0=$G(^AUTTVNDR(ACHSPROV,0)),ACHS11=$S($D(^AUTTVNDR(ACHSPROV,11)):^(11),1:""),ACHS13=$S($D(^AUTTVNDR(ACHSPROV,13)):^(13),1:""),ACHS17=$S($D(^AUTTVNDR(ACHSPROV,17)):^(17),1:"")
  1.  I $D(^AUTTVNDR(ACHSPROV,11)),$P($G(^AUTTVNDR(ACHSPROV,11)),U)="" G MESSAGE^ACHSVDVD
  1.  D HDR
  1.  S ACHSVT=$P(ACHS11,U,3),(ACHSDAP,ACHSLAD,ACHSDISP)=""
  1.  S %=$O(^ACHSVPMT(DUZ(2),1,"B",ACHSPROV,0))
  1.  I %,$D(^ACHSVPMT(DUZ(2),1,%,1,ACHSCFY,0)) S ACHSDAP=$P(^(0),U,2),ACHSLAD=$P(^(0),U,3)
  1.  I ACHSVT]"",ACHSVT?1N.N S ACHSVT=$P(^AUTTVTYP(+ACHSVT,0),U,2)
  1.  S ACHSEDOS=DT
  1.  K ACHSRT,ACHSCTNA
  1.  D A1^ACHSURT
  1.  S ACHSLAD=$$FMTE^XLFDT(ACHSLAD),ACHSACO="",P=ACHSPROV
  1.  D ^ACHSUCN
  1.  K ACHSRT,ACHSCTNA
  1.  D A1^ACHSURT
  1.  S ACHSMS=$P(ACHS13,U,3)
  1.  I ACHSMS?1N.N S ACHSMS=$P(^DIC(5,ACHSMS,0),U)
  1.  S ACHSBS=$P(ACHS13,U,8)
  1.  I ACHSBS?1N.N S ACHSBS=$P(^DIC(5,ACHSBS,0),U)
  1.  ;ACHS*3.1*13 11/29/06 IHS/OIT/FCJ FORMAT CHANGES AND ADDED DUNS NUMBER OPTION 11
  1.  W !," 1) ",$P(^AUTTVNDR(ACHSPROV,0),U),?46," 2) EIN No: ",$P(ACHS11,U),$S($P(ACHS11,U,2)]"":"-"_$P(ACHS11,U,2),1:"")
  1.  W !," 3) Status: ",$S(+$P(ACHS0,U,5):"IN",1:""),"ACTIVE"
  1.  W ?46," 4) Contracts: ",$S(ACHSACO="N":"NONE ACTIVE",+C>0:"ACTIVE="_+C,1:"NONE")
  1.  I '$D(ACHSRT("RQ")) S ACHSRT("RQ")=-1
  1.  W !," 5) UPIN: ",$P(ACHS17,U),?46," 6) Rate Quotation: ",$S('$D(ACHSRT("RQ")):"NONE",'$D(ACHSRT("RQ","ACTIVE")):"NONE ACTIVE",ACHSRT("RQ","ACTIVE")>0:"ACTIVE="_+$P(ACHSRT("RQ","ACTIVE"),U,1),1:"")
  1.  W !," 7) Type of Business: "
  1.  S X=$P(ACHS11,U,26)
  1.  I X W $P($G(^AUTTTOB(X,0)),U)
  1.  W ?46," 8) Agreement: ",$S('$D(ACHSRT("PA")):"NONE",'$D(ACHSRT("PA","ACTIVE")):"NONE ACTIVE",ACHSRT("PA","ACTIVE")>0:"ACTIVE="_+$P(ACHSRT("PA","ACTIVE"),U,1),1:"")
  1.  ;IHS/SET/JVK ACHS*3.1*11 ADD MEDICARE PROVIDER FIELD NUMBER 9
  1.  I $D(^AUTTVNDR(ACHSPROV,23)) S ACHSMP=$P($G(^(23)),U) S ACHMP=$$EXTSET^XBFUNC(9999999.11,2301,ACHSMP)
  1.  I '$D(^AUTTVNDR(ACHSPROV,23)) S ACHSMP=""
  1.  W !," 9) Medicare Provider: ",$S(ACHSMP="":"No entry",ACHSMP'="":ACHSMP,1:"")
  1.  W ?46,"10) BPA: ",$S('$D(ACHSRT("BPA")):"NONE",'$D(ACHSRT("BPA","ACTIVE")):"NONE ACTIVE",ACHSRT("BPA","ACTIVE")>0:"ACTIVE="_+$P(ACHSRT("BPA","ACTIVE"),U,1),1:"")
  1.  W !,"11) E-Mail: ",$$VAL^XBDIQ1(9999999.11,ACHSPROV,2103)  ;ACHS*3.1*19
  1.  W ?46,"12) DUNS: ",$$VAL^XBDIQ1(9999999.11,ACHSPROV,.07)
  1.  W !,"13) Direct Participant: ",$$VAL^XBDIQ1(9999999.11,ACHSPROV,2104)   ;ACHS*3.1*23 IHS.OIT.FCJ
  1.  W !,"14) Direct E-Mail: ",$$VAL^XBDIQ1(9999999.11,ACHSPROV,2105)   ;ACHS*3.1*23 IHS.OIT.FCJ
  1.  W !!,"**** MAILING/BILLING ADDRESS ****",?44,"**** PROVIDER LOCATION ADDRESS ****"
  1.  W !,"15) Street: ",$P(ACHS13,U),?46,"16) Street: ",$E($P(ACHS13,U,6),1,17)
  1.  ;ACHS*3.1*19 CHANGES TO NXT 2 LINES TO DISPLAY FAX NUM
  1.  W !?6,"City: ",$P(ACHS13,U,2),?52,"City: ",$P(ACHS13,U,7),!?5,"State: ",ACHSMS,?26,"Zip: ",$P(ACHS13,U,4),?51,"State: ",ACHSBS
  1.  W !?5,"Phone: ",$P(ACHS11,U,9),?26,"Fax: ",$P(ACHS11,U,14),?48,"Zip Code: ",$P(ACHS13,U,9),!?6,"Attn: ",$P(ACHS13,U,5)
  1.  W !,"17) Vendor Type: ",ACHSVT
  1.  ;IHS/SET/JVK ACHS*3.1*6 MODIFIED TO DISPLAY ACTUAL CONTENT OF FIELD
  1.  ;W ?48,"(13).  Fed/Non-Fed: ",$S($P(ACHS11,U,10)=1:"NON-",$P(ACHS11,U,10)=2:"",1:"NON-"),"FED"
  1.  W ?46,"18) Fed/Non-Fed: ",$S($P(ACHS11,U,10)=1:"NON-FED",$P(ACHS11,U,10)=2:"FED",$P(ACHS11,U,10)="":"")
  1.  W !,"19) Specialty: ",$S($P(ACHS11,U,4):$P(^DIC(7,$P(ACHS11,U,4),0),U),1:"")
  1.  ;IHS/SET/JVK ACHS*3.1*6 ADD GEOGRAPHICAL LOCATION 4/15/2003     
  1.  W ?46,"20) Geographic Loc: ",$S($P(ACHS11,U,25)="":"",$P(ACHS11,U,25):$P(^AUTTGL($P(ACHS11,U,25),0),U))
  1.  W !?2,"Last Payment Date: ",ACHSLAD,?45,"Current FYTD Paid: "
  1.  I ACHSDAP]"" S X=ACHSDAP,X2="2$" D FMT^ACHS
  1.  W !,$$REPEAT^XLFSTR("*",79)
  1.  G:'$D(^XUSEC("ACHSZMGR",DUZ)) A4^ACHSVDV1
  1.  ;ITSC/SET/JVK ACHS*3.1*11 ENTRY POINT 13 ;ACHS*3.1*13 IHS/OIT/FCJ IS NOW 14;ACHS*3.1*22 IS NOW 15;ACHS*3.1*24 IS NOW 17;
  1.  ;I ACHSVT="" W *7,!!,"MUST HAVE VENDOR TYPE." D 12^ACHSVDVA G A2:'$D(Y),A1
  1.  I ACHSVT="" W *7,!!,"MUST HAVE VENDOR TYPE." D 17^ACHSVDVA G A2:'$D(Y),A1
  1. A3 ;
  1.  K ACHSCTFL,ACHSRQFL,ACHSPAFL,ACHSBPFL
  1.  S Y=$$DIR^XBDIR("Y","Want to Edit","NO","","","",1)
  1.  G END:$D(DTOUT),A1:$D(DUOUT),A4^ACHSVDV1:('Y),EDIT^ACHSVDVA:Y
  1.  G A3
  1.  ;
  1. END ;EP
  1.  K X,P,S,C,L,D,D0,DA,DI,DIC,DR
  1.  D EN^XBVK("ACHS"),^ACHSVAR
  1.  Q
  1.  ;
  1. HDR ;
  1.  S X="PROVIDER/VENDOR UPDATE",Y="ACHS"
  1.  D SHDR^ACHS
  1.  W $$REPEAT^XLFSTR("*",79)  ;ACHS 3.1*13 11/29/06 IHS/OIT/FCJ REMOVED !
  1.  Q
  1.  ;