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

AVA200.m

Go to the documentation of this file. 
  1. AVA200 ; IHS/OIT/FBD - ADD/ EDIT PERSONS TO VA(200 ;30-Sep-2010 17:29;fbd
  1.  ;;93.2;VA SUPPORT FILES;**1,4,7,8,13,19,21,22,24**;SEP 30, 2010;Build 6
  1.  ;PATCH #8 -- Added Service/Section field to Add New Person-IHS/ADC/CRG
  1.  ;PATCH #19 Added Trigger to fire Protocol to generate MFN-M02 Hl7 message IHS/OIT/FJE
  1.  ;PATCH #21 Added Fax, Email Addr, SPI field edits to Add Provider - IHS/OIT/FBD
  1.  ;PATCH #24 Conditionalized DEA#, DEA Expiration Date field edits in Add Provider - IHS/OIT/FBD
  1.  ;
  1.  Q
  1. PERADD ;EP; ENTRY POINT to add or edit persons in ^va(200
  1.  W @IOF,!!?22,"ADD/EDIT NEW PERSONS",!!
  1.  W !!?10,"Use this option to enter names of employees, contractors, "
  1.  W !?5,"and volunteers who will be referenced by other software.  If"
  1.  W !?5,"the person is also a provider, you do NOT need to use this "
  1.  W !?5,"option as the ADD/EDIT PROVIDERS option includes the data"
  1.  W !?5,"fields asked for here.",!!
  1.  ;
  1. PER1 S AVAX=$$PERSON G PER1:AVAX>0
  1.  K AVAX Q
  1.  ;
  1.  ;
  1. PRVADD ;EP;ENTRY POINT to add or edit providers in ^va(200
  1.  W @IOF,!!?22,"ADD/EDIT PROVIDERS",!!
  1.  W !!?10,"Use this option to add new providers to your system OR to"
  1.  W !?5,"edit those already in the system.  You do NOT need to enter the"
  1.  W !?5,"provider as a person first.  Just use this option.",!
  1.  ;
  1. PRV1 S AVAX=$$PROVIDER G PRV1:AVAX>0
  1.  K AVAX Q
  1.  ;
  1.  ;
  1. INACTIVE ;PEP;ENTRY POINT to inactivate a person and/or provider
  1.  W @IOF,!!?20,"INACTIVATE/REACTIVATE A PERSON/PROVIDER",!!
  1.  W !!?10,"Use this option to enter an INACTIVE DATE for a Person" ;PATCH #7
  1.  W !?5,"or Provider.  To deactivate a user, please use the option on"
  1.  W !?5,"the USER EDIT menu.  To REACTIVATE a person or provider, enter"
  1.  W !?5,"an ""@"" at the Inactive Date prompt.  Then proceed to the" ;PATCH #7
  1.  W !?5,"ADD/EDIT PROVIDERS option to insure all the data is current."
  1.  W !!
  1.  ;
  1. ASK W !! K DIC S DIC=200,DIC(0)="AEMZQ" D ^DIC G INEXIT:Y=-1
  1.  W ! S DIE=200,(DA,AVADA)=+Y,DR="53.4" D ^DIE ;PATCH #7
  1.  ;Added for support of Dental project  fje 8/5/08
  1.  I +AVADA>0,$P($G(^VA(200,+AVADA,"PS")),U,5)>0 D
  1.  . S X="AVA PROVIDER UPDATE MFN_M02",DIC=101,INDA=+AVADA
  1.  . D EN^XQOR
  1.  G ASK
  1.  ;
  1. INEXIT K DIC,DIE,DR,DA,X,Y Q
  1.  ;
  1.  ;
  1.  ;
  1. PERSON(AVADR,AVADR1) ;PEP;EXTR FUNC called to perform add or edit on one person
  1.  ;AVADR can be set to fields to add as identifiers
  1.  ;AVADR1 can be set to additional fields for DIE call
  1.  ;to call, set variable to $$PERSON(with optional parameters)
  1.  ;Identifiers already included:  by VA: Initials, SSN, Sex
  1.  ;DR string below includes: VA Identifiers plus those you sent
  1.  ;   Plus those stated below: DOB, Address fields, Phone, Office Phone
  1.  ;
  1.  N DIE,DA,DR,AVADA S AVADR=$G(AVADR)
  1.  W ! S AVADA=$$ADD^XUSERNEW(AVADR) G EXIT1:AVADA'>0
  1.  I $P(AVADA,U,3)=1 W !,"Identifiers Completed. Now for other data fields"
  1.  I $P($G(^VA(200,+AVADA,"PS")),U,4)]"" W !!,$P(AVADA,U,2)," has been INACTIVATED.  Please use the INACTIVATE/REACTIVATE option.",!! G EXIT1 ;PATCH #7
  1.  W ! S DIE=200,DA=+AVADA
  1.  ;S DR=".01;1;4;5;8;9;.111:.116;.131;.132" S:$D(AVADR1) DR=DR_";"_AVADR1 ;PATCH #7
  1.  S DR=".01;1;4;5;8;9;29;.111:.116;.131;.132" S:$D(AVADR1) DR=DR_";"_AVADR1 ;PATCH #7,8 ;IHS/ADC/CRG 12/4/96
  1.  D ^DIE
  1. EXIT1 Q AVADA
  1.  ;
  1.  ;
  1. PROVIDER(AVADR,AVADR1) ;PEP;EXTR FUNC add/edit one provider
  1.  ;AVADR (opt) = fields to add as identifiers
  1.  ;AVADR1(opt) = additional fields for DR for ^DIE call
  1.  ;to call, set variable to $$PROVIDER(with optional parameters)
  1.  ;Identifiers already included:  by VA: Initials, SSN, Sex
  1.  ;  By variable X set below: Affiliation, Provider Class, Code
  1.  ;DR string includes: VA Identifiers plus those you sent to $$PROVIDER
  1.  ;   Plus identifiers stated below in X
  1.  ;   Plus those stated in $$PERSON: DOB, Address, Phone #
  1.  ;   Plus those set into Y below: IHS Local Code, Medicare & Medicaid #,
  1.  ;         UPIN #, and all VA provider fields except VA #
  1.  ;
  1.  N Y,X
  1.  S X="53.5R;9999999.01;9999999.02" S:$D(AVADR) X=X_";"_AVADR ;IHS/ORDC/LJF 12/3/93 PATCH #4
  1.  ;S Y=X_";9999999.05:9999999.08;53.1;53.2;53.6:53.9" ;PATCH #7  ;IHS/OIT/FBD - 9/30/2010 - COMMENTED OUT - SUPERCEDED BY AVA*93.2*21
  1.  ;S Y=".136;.151;"_X_";9999999.05:9999999.08;53.1;53.2;747.44;43.99;53.6:53.9" ;IHS/OIT/FBD - 9/30/2010 - AVA*93.2*21 - AVA*93.2*22 ADDED DEA EXPIRATION DATE - 5/16/2018 - SUPERCEDED BY AVA*93.2*24
  1.  S Y=".136;.151;"_X_";9999999.05:9999999.08;53.1;43.99;53.6:53.9" ;IHS/OIT/FBD - 8/1/2018 - AVA*93.2*24
  1.  S:$D(AVADR1) Y=Y_";"_AVADR1
  1.  S AVADA=$$PERSON(X,Y)
  1.  D EPCSEDIT^AVA200E(AVADA)  ;IHS/OIT/FBD - 8/1/2018 - AVA*93.2*24
  1.  I $P($G(^VA(200,+AVADA,"PS")),U,5)]"" D  ;IHS/ORDC/LJF 9/13/93 PATCH #1
  1.  .S DA=$P(^DIC(3,+AVADA,0),U,16) ;IHS/ORDC/LJF 9/13/93 PATCH #1
  1.  .I DA S DIE=6,DR="9999999.21" D ^DIE ;IHS/ORDC/LJF 9/13/93 PATCH #1
  1.  I +AVADA>0,$P($G(^VA(200,+AVADA,"PS")),U,5)="" W !!,*7,"MUST HAVE PROVIDER CLASS TO BE DESIGNATED AS A PROVIDER!!",!
  1.  ;Added for support of Dental project  fje 8/5/08
  1.  I +AVADA>0,$P($G(^VA(200,+AVADA,"PS")),U,5)>0 D
  1.  . S X="AVA PROVIDER UPDATE MFN_M02",DIC=101,INDA=+AVADA
  1.  . D EN^XQOR
  1.  Q AVADA
  1.  ;Begin New Code;IHS/SET/GTH AVA*93.2*13 09/12/2002
  1. CERTS ;EP - Edit CERTIFICATIONS.
  1.  NEW DA,DIC,DIE,DR
  1.  S DIC="^VA(200,",DIC(0)="AE"
  1.  D ^DIC
  1.  Q:+Y<1
  1.  S DIC(0)="AEL",DA(1)=+Y,DIC=DIC_+Y_",90002,",DIC("W")="D CERTSID^AVA200(^(0))",DIC("P")=$P(^DD(200,90002,0),U,2)
  1.  D ^DIC
  1.  Q:+Y<1
  1.  S DDSFILE=200,DDSFILE(1)=200.90002,DA=+Y,DR="[AVA CERTS]"
  1.  D ^DDS
  1.  S DIE="^VA(200,"_DA(1)_",90002,",DR=".05////"_DT_";.06////"_DUZ
  1.  D ^DIE
  1.  Q
  1.  ;
  1. CERTSID(AVA) ;EP - From DIC("W")
  1.  W "  ",$S($P(AVA,U,2):$E($P(^AUTTACF($P(AVA,U,2),0),U),1,30),1:$J("",30)),"   ",$S($P(AVA,U,3):$E($P(^AUTTACE($P(AVA,U,3),0),U,1),1,30),1:$J("",30)),"   ",$S($P(AVA,U,4):$$CERTDT($P(AVA,U,4)),1:"")
  1.  Q
  1.  ;
  1. CERTDT(X) ;
  1.  Q $E(X,4,5)_"-"_$E(X,6,7)_"-"_($E(X,1,3)+1700)
  1.  ;End New Code;IHS/SET/GTH AVA*93.2*13 09/12/2002