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

PREAPO3.m

Go to the documentation of this file. 
  1. PREAPO3 ;BIR/RTR - Identify AMPL users for patch PREA*1*3; OCT 16, 2020
  1.  ;;1.0;ADVANCED MEDICATION PLATFORM;**3**;9/1/20;Build 19
  1.  ; Reference to ^VA(200 in ICR #7209
  1.  ;
  1. EN ;Identify AMPL Users - called from the PREA AMPL GUI ACCESS option
  1.  N PREAPROD,PREARUN,PREAPRG,PREAFNL,PREAWHO,PREAWHO1,PREAWHO2,PREAPIN1,PREAPIN2,PREAPIN3,X,X1,X2,DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  I $D(^XTMP("PREAUSID","RUNNING")) D  Q
  1.  .S PREAWHO=+^XTMP("PREAUSID","RUNNING")_","
  1.  .D GETS^DIQ(200,PREAWHO,".01","E","PREAWHO2")
  1.  .S PREAWHO1=$G(PREAWHO2(200,PREAWHO,.01,"E"))
  1.  .W !!,"This job is currently running or tasked from another process by:",!
  1.  .W $S($G(PREAWHO1)'="":"   "_PREAWHO1,1:"   Unknown User."),!
  1.  .S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR W !
  1.  S PREAPIN1=DUZ_","
  1.  D GETS^DIQ(200,PREAPIN1,"205.5","E","PREAPIN2")
  1.  S PREAPIN3=$G(PREAPIN2(200,PREAPIN1,205.5,"E"))
  1.  I PREAPIN3="" D  Q
  1.  .W !!,"You must have data in the ADUPN Field (#205.5) of the NEW PERSON File (#200)",!,"to run this option.",!
  1.  .S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR W !
  1.  D CLEAN
  1.  I '$G(DT) S DT=$$DT^XLFDT
  1.  S X1=DT,X2=30 D C^%DTC S PREAPRG=$G(X)
  1.  S ^XTMP("PREAUSID",0)=PREAPRG_"^"_DT_"^"_"Identify AMPL users for patch PREA*1*3."
  1.  S ^XTMP("PREAUSID","RUNNING")=$G(DUZ)
  1.  S PREAPROD=+$$PROD^XUPROD,(PREARUN,PREAFNL)=0
  1.  D ASK
  1.  I 'PREARUN W !,"Nothing run, exiting option.",! D CLEAN Q
  1.  D TASK
  1.  Q
  1.  ;
  1.  ;
  1. RUN ;Run job
  1.  I PREAFNL D OUT^XPDMENU("PREA AMPL GUI ACCESS","Out of order, AMPL access already submitted.")
  1.  N PREASITE,PREASTRT,PREASTOP
  1.  S PREASTRT=$$DATE
  1.  S PREASITE=$$SITE^VASITE
  1.  D USER,MAIL I PREAFNL D MAILF
  1.  D CLEAN
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1.  ;
  1. TASK ;Task Job
  1.  N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKILL,ZTSYNC
  1.  S ZTRTN="RUN^PREAPO3"
  1.  S ZTDESC="Identify AMPL Users for access."
  1.  S ZTSAVE("PREAPROD")="",ZTSAVE("PREAFNL")="",ZTSAVE("PREAPIN3")=""
  1.  S ZTIO=""
  1.  D ^%ZTLOAD
  1.  I $D(ZTSK)[0 W !!,"Job not tasked to run.",! D CLEAN
  1.  E  W !!,"Job tasked to run.",!
  1.  D HOME^%ZIS
  1.  Q
  1.  ;
  1.  ;
  1. CLEAN ;Kill TMP Globals
  1.  K ^TMP($J,"PREACHK"),^TMP($J,"PREAUSER"),^TMP($J,"PREANONM"),^TMP($J,"PREANET"),^XTMP("PREAUSID")
  1.  Q
  1.  ;
  1.  ;
  1. ASK ;User prompts
  1.  N DIR,X,Y,DTOUT,DUOUT,DIRUT
  1.  W !!,"This option generates the initial list of users that will be submitted for"
  1.  w !,"Advanced Medication Platform (AMPL) access, based on Security Keys and"
  1.  W !,"Person Class. Individual access can subsequently be granted or taken away by"
  1.  W !,"following the procedures outlined in Appendix A of the PREA Technical Manual.",!
  1.  ;
  1.  I 'PREAPROD D TEST Q
  1.  ;
  1.  W !,"Since this is a production account, you can elect to:"
  1.  W !,"   1. Only send this list to your Outlook and VistA emails, the"
  1.  W !,"   list will not be submitted to grant AMPL access."
  1.  W !,"   2. At the request of the Implementation Manager, send the list to"
  1.  W !,"   yourself and the people who will submit AMPL access requests for"
  1.  W !,"   all users on the list. If you elect to send the list to the team"
  1.  W !,"   who submits AMPL access requests, the option will then be disabled."
  1.  W !!,"           ********************NOTE********************"
  1.  W !,"   Option 2 should only be done when requested by the Implementation"
  1.  W !,"   Manager, AMPL will be a phased rollout.",!
  1.  K DIR,Y S DIR(0)="Y",DIR("B")="Y",DIR("A")="Only send list to my Outlook and Vista emails"
  1.  S DIR("?")=" ",DIR("?",1)="Enter 'Y' to only send the AMPL access user request list to yourself in"
  1.  S DIR("?",2)="Outlook and VistA emails. Enter 'N' to submit the list for access granting."
  1.  s DIR("?",3)="Enter '^' to exit." D ^DIR K DIR W !
  1.  I $D(DTOUT)!($D(DUOUT)) Q
  1.  I 'Y D  I $D(DTOUT)!($D(DUOUT)) Q
  1.  .K DIR,Y S DIR(0)="Y",DIR("B")="N",DIR("A")="Are you sure you want to submit the final AMPL User request list"
  1.  .S DIR("?")=" ",DIR("?",1)="Enter 'Y' to officially submit the AMPL access user request list."
  1.  .S DIR("?",2)="Doing so will disable this option, since the list can be sent only once."
  1.  .S DIR("?",3)="Enter '^' to exit." D ^DIR K DIR W !
  1.  .I Y S PREAFNL=1
  1.  S PREARUN=1
  1.  Q
  1.  ;
  1.  ;
  1. TEST ;Test account
  1.  W !,"Since this is a test account, the list will only be sent to you at your Outlook"
  1.  W !,"and VistA emails and will not be submitted to grant AMPL access. Submitting"
  1.  W !,"for AMPL access can only happen when running this option in production.",!
  1.  K DIR,Y S DIR(0)="Y",DIR("B")="Y",DIR("A")="Generate AMPL access user list"
  1.  S DIR("?")=" ",DIR("?",1)="Enter 'Y' to generate the AMPL access user request list. This"
  1.  S DIR("?",2)="list will only be sent to you at your Outlook and VistA emails." D ^DIR K DIR W !
  1.  I Y'=1!($D(DTOUT))!($D(DUOUT)) Q
  1.  S PREARUN=1
  1.  Q
  1.  ;
  1.  ;
  1. MAIL ;Send mail message
  1.  N XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMYBLOB,XMZ
  1.  K ^TMP($J,"PREATEXT")
  1.  S XMDUZ="PREA*1*3 AMPL User Identification"
  1.  S XMSUB="AMPL access list-PREA*1*3 "_$P(PREASITE,"^",2)_" "_$P(PREASITE,"^",3)
  1.  D SETTMP
  1.  S XMTEXT="^TMP($J,""PREATEXT"","
  1.  S XMY(DUZ)=""
  1.  S XMY(PREAPIN3)=""
  1.  N DIFROM,DUZ D ^XMD
  1.  K ^TMP($J,"PREATEXT")
  1.  Q
  1.  ;
  1.  ;
  1. SETTMP ;Set TMP global data
  1.  N PREALP1,PREALP2,PREALP3,PREALP4,PREALP5
  1.  S PREALP1="",PREALP3=3
  1.  F  S PREALP1=$O(^TMP($J,"PREAUSER",PREALP1)) Q:PREALP1=""  D
  1.  .F PREALP2=0:0 S PREALP2=$O(^TMP($J,"PREAUSER",PREALP1,PREALP2)) Q:'PREALP2  D
  1.  ..S ^TMP($J,"PREATEXT",PREALP3)=PREALP1,PREALP3=PREALP3+1
  1.  S PREALP4=PREALP3-3
  1.  S ^TMP($J,"PREATEXT",2)="Name ("_$S($G(PREAPROD):"PRODUCTION ACCOUNT",1:"TEST ACCOUNT")_")    Total: "_PREALP4
  1.  S ^TMP($J,"PREATEXT",PREALP3)="",PREALP3=PREALP3+1
  1.  S PREALP4=PREALP3,PREALP1="",PREALP3=PREALP3+1,PREALP5=0
  1.  F  S PREALP1=$O(^TMP($J,"PREANONM",PREALP1)) Q:PREALP1=""  D
  1.  .F PREALP2=0:0 S PREALP2=$O(^TMP($J,"PREANONM",PREALP1,PREALP2)) Q:'PREALP2  D
  1.  ..S ^TMP($J,"PREATEXT",PREALP3)=PREALP1,PREALP3=PREALP3+1,PREALP5=PREALP5+1
  1.  S ^TMP($J,"PREATEXT",PREALP4)="Users Missing Network UserName    Total: "_PREALP5
  1.  I 'PREALP5 D
  1.  .S PREALP3=PREALP3+1,^TMP($J,"PREATEXT",PREALP3)=""
  1.  .S PREALP3=PREALP3+1,^TMP($J,"PREATEXT",PREALP3)="No entries found."
  1.  S PREASTOP=$$DATE
  1.  S ^TMP($J,"PREATEXT",1)="AMPL User ID job began: "_PREASTRT_"  ended: "_PREASTOP
  1.  Q
  1.  ;
  1.  ;
  1. USER ;Find users to get AMPL access
  1.  ;^TMP($J,"PREACHK",DUZ)="" - User already identified as an AMPL user with/without vausername or uneligible
  1.  ;^TMP($J,"PREAUSER",NAME,DUZ)=vausername - User identified as an AMPL User with vausername
  1.  ;^TMP($J,"PREANONM",NAME,DUZ)="" - User identified as an AMPL User without vausername
  1.  N PREAKEY,PREAVAUS,PREANAME,PREADATA,PREAVALU,PREADUZ
  1.  F PREAKEY="PSORPH","PSO TECH ADV","PSD TECH","PSD TECH ADV","PSDRPH","PSDMGR","PSJ PHARM TECH","PSJ RPHARM","PSJI MGR","PSJI PHARM TECH","PSJU MGR","PSJU RPH" D
  1.  .F PREADUZ=0:0 S PREADUZ=$O(^XUSEC(PREAKEY,PREADUZ)) Q:'PREADUZ  D
  1.  ..I $D(^TMP($J,"PREACHK",PREADUZ)) Q
  1.  ..S ^TMP($J,"PREACHK",PREADUZ)=""
  1.  ..I $$ACTIVE(PREADUZ) D ADD(PREADUZ)
  1.  ;Must loop through File 200 since there are no cross-references that gives all person of a Person Class:
  1.  F PREADUZ=0:0 S PREADUZ=$O(^VA(200,PREADUZ)) Q:'PREADUZ  D
  1.  .I $D(^TMP($J,"PREACHK",PREADUZ)) Q
  1.  .I $$ACTIVE(PREADUZ),$$PER(PREADUZ) D ADD(PREADUZ)
  1.  Q
  1.  ;
  1.  ;
  1. ADD(PREAUSE1) ;User gets access, add to TMP global
  1.  S PREAVALU=PREAUSE1_","
  1.  D GETS^DIQ(200,PREAVALU,".01;501.1","E","PREADATA")
  1.  S PREANAME=$G(PREADATA(200,PREAVALU,.01,"E")) I PREANAME="" Q
  1.  S PREAVAUS=$G(PREADATA(200,PREAVALU,501.1,"E"))
  1.  I PREAVAUS'="" S ^TMP($J,"PREAUSER",PREANAME,PREAUSE1)="" D:PREAFNL  Q
  1.  .S ^TMP($J,"PREANET",PREAVAUS)=""
  1.  S ^TMP($J,"PREANONM",PREANAME,PREAUSE1)=""
  1.  Q
  1.  ;
  1.  ;
  1. ACTIVE(PREAINAC) ;Check if user is inactive
  1.  Q $$ACTIVE^XUSER(PREAINAC)
  1.  ;
  1.  ;
  1. PER(PREAUSE2) ;Person Class check
  1.  N PREAPCLS
  1.  S PREAPCLS=$$GET^XUA4A72(PREAUSE2) I PREAPCLS'>0 Q 0
  1.  I $$UP^XLFSTR($P(PREAPCLS,"^",2,3))'["PHARM" Q 0
  1.  Q 1
  1.  ;
  1.  ;
  1. MAILF ;Send final mail message
  1.  N XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMYBLOB,XMZ,PREANT,PREANTC
  1.  K ^TMP($J,"PREATEXT") S PREANTC=1
  1.  S XMDUZ="PREA*1*3 AMPL User Identification"
  1.  S XMSUB="AMPL access list-PREA*1*3 "_$P(PREASITE,"^",2)_" "_$P(PREASITE,"^",3)
  1.  S PREANT="" F  S PREANT=$O(^TMP($J,"PREANET",PREANT)) Q:PREANT=""  D
  1.  .S ^TMP($J,"PREATEXT",PREANTC)=PREANT,PREANTC=PREANTC+1
  1.  I PREANTC=1 S ^TMP($J,"PREATEXT",1)="No users found."
  1.  S XMTEXT="^TMP($J,""PREATEXT"","
  1.  S XMY("VAITEPMOEPMDPREPHARMGUISSOI@domain.ext")=""
  1.  S XMY(PREAPIN3)=""
  1.  N DIFROM,DUZ D ^XMD
  1.  K ^TMP($J,"PREATEXT")
  1.  Q
  1.  ;
  1.  ;
  1. DATE() ;Returns Date/Time
  1.  N X,Y,%,%H,%I,PREADATE
  1.  D NOW^%DTC
  1.  D YX^%DTC S PREADATE=Y
  1.  Q PREADATE