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

AGMPCHK.m

Go to the documentation of this file. 
  1. AGMPCHK ;GDIT/HS/SWH-Site ID Check; NOV 11, 2016
  1.  ;;7.2;IHS PATIENT REGISTRATION;**5**;NOV 30, 2016 ;Build 20
  1.  Q
  1.  ;
  1.  ; 
  1. BUILD ;Create the Institution - Site Information globals entries
  1.  N INST,SID
  1.  I $G(^AGMPCHK(0))'="" W !,"The Build process for the AGMPCHK global is already completed, please use the Update option!" Q  ;The CHK global entries have already been created, run the Update routine if you need to change their values
  1.  S ^AGMPCHK(0)=0 ;Set the initial count to zero
  1.  S INST=0 ;Set the Institution to zero
  1.  F  S INST=$O(^AGFAC(INST)) Q:INST=""  D  ;Loop through the Institution numbers from the AGFAC global
  1.  .I $P($G(^AGFAC(INST,0)),U,21)'="Y" Q  ;If the the Institution isn't an Ordering Facility don't process
  1.  .S SID=$P($G(^DIC(4,INST,99)),U,1) ;Pull the SiteID from the Institution file
  1.  .D CENTRY(SID,INST,"VALID")
  1.  Q
  1.  ;
  1.  ;
  1. UENTRY(INST,VAL,ID1) ;Update an entry within the ^AGMPCHK global
  1.  S ^AGMPCHK(INST,1)=VAL
  1.  S ^AGMPCHK(INST)=ID1
  1.  I (VAL="INVALID") D  Q
  1.  .S ^AGMPCHK(INST,"NT")=$H
  1.  .D NOTIF^AGMPIHLO("","The "_INST_" / "_ID1_" site is now disabled.")
  1.  S ^AGMPCHK(INST,0)=ID1
  1.  Q
  1.  ;
  1.  ;
  1. CENTRY(ID1,INST,VAL) ;Create an entry within the ^AGMPCHK global
  1.  S ^AGMPCHK(INST)=ID1
  1.  S ^AGMPCHK(INST,0)=ID1
  1.  S ^AGMPCHK(INST,1)=VAL
  1.  S ^AGMPCHK(0)=$G(^AGMPCHK(0))+1 ;Add one to to total number of entries
  1.  Q
  1.  ;
  1.  ;
  1. RENTRY(INST) ;Remove an entry within the ^AGMPCHK global
  1.  K ^AGMPCHK(INST)
  1.  S ^AGMPCHK(0)=$G(^AGMPCHK(0))-1 ; Subtract one from the total number of entries
  1.  Q
  1.  ;
  1.  ;
  1. GETINST(ID1,INST) ;Retrieve the institution associated with the Site from the ^AGMPCHK global
  1.  N TINST
  1.  S TINST=0
  1.  S INST=""
  1.  F  S TINST=$O(^AGMPCHK(TINST)) Q:TINST=""  D
  1.  .I $G(^AGMPCHK(TINST))=ID1 S INST=TINST
  1.  Q
  1.  ;
  1.  ;
  1. SITELST ;Print out the current site information within the ^AGMPCHK global
  1.  N INTS,TB
  1.  I '($G(^AGMPCHK(0))) W !,"There is no site information to display"  Q
  1.  S INST=0
  1.  S TB="     "
  1.  W !,"Inst",TB,"Site ID",TB,"OLD Site ID",TB,"Status"
  1.  F  S INST=$O(^AGMPCHK(INST)) Q:INST=""  D
  1.  .W !,INST
  1.  .W $J(^AGMPCHK(INST),11)
  1.  .W $J(^AGMPCHK(INST,0),14)
  1.  .W $J(^AGMPCHK(INST,1),14)
  1.  Q
  1.  ;
  1.  ;
  1. ISITERST ;Interactive Reset, user option
  1.  L +^AGMPCHK:3
  1.  I '$T D  Q
  1.  .W !,"Please run the Site Reset option again, currently there is a lock on the ^AGMPCHK global.  If this notification continues please contact the OIT HelpDesk."
  1.  L -^AGMPCHK
  1.  N INST,TC,DIR,TID,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  S INST=0
  1.  S TC=1
  1.  S DIR(0)=""
  1.  S DIR("A")="Site"
  1.  S DIR(0)="SO^1:ALL"
  1.  F  S INST=$O(^AGMPCHK(INST)) Q:INST=""  D
  1.  .S TC=TC+1
  1.  .S TID=$G(^AGMPCHK(INST))
  1.  .S DIR(0)=DIR(0)_";"_TC_":"_TID_" - "_$G(^AGMPCHK(INST,1))
  1.  D ^DIR
  1.  I Y D SITERST(Y(0))
  1.  Q
  1.  ;
  1.  ;
  1. SITERST(RSID) ;Site Reset, mark Valid the SiteID that is sent in, 'ALL' is sent in then we loop through the AGMPCHK global marking all Valid
  1.  L +^AGMPCHK:5 ;Attempt to lock the AGMPCHK global.
  1.  I '$T D  Q  ;if no lock quit the update process.
  1.  .W !,"Please run the Site Reset option again, currently there is a lock on the ^AGMPCHK global.  If this notification continues please contact the OIT HelpDesk."
  1.  N INST,RESULT
  1.  S RSID=$p(RSID," ",1)
  1.  I RSID="ALL" D  L -^AGMPCHK Q  ;If we're to update all entries within the AGMPCHK global
  1.  .S INST=0 ;The Institution variable we use to loop through the sites within the global
  1.  .S RESULT="ALL Sites are marked valid"
  1.  .F  S INST=$O(^AGMPCHK(INST)) Q:INST=""  D  ;Loop while there's an Institution
  1.  ..I '(^AGMPCHK(INST,1)="VALID")  D
  1.  ...D SNDMSGQ(INST)
  1.  ...D UENTRY(INST,"VALID",$P($G(^DIC(4,INST,99)),U,1))
  1.  .W !,RESULT
  1.  D GETINST(RSID,.INST)
  1.  I (INST="") D  L -^AGMPCHK Q
  1.  .S RESULT="The "_RSID_" wasn't found in the SiteId List"
  1.  .W !,RESULT
  1.  I ^AGMPCHK(INST,1)="VALID" D  L -^AGMPCHK Q
  1.  .S RESULT="The "_RSID_" site is already marked valid"
  1.  .W !,RESULT
  1.  D SNDMSGQ(INST)
  1.  D UENTRY(INST,"VALID",RSID)
  1.  S RESULT="Site "_RSID_" was marked valid."
  1.  W !,RESULT
  1.  L -^AGMPCHK ;Unlock the AGMPCHK global
  1.  Q
  1.  ;
  1.  ;
  1. UPDATE ;Check to see if the information stored is the same as the information in the AGFAC and Institution Globals
  1.  N INST,USID,$ESTACK,$ETRAP
  1.  S $ETRAP="D UNWIND^%ZTER"
  1.  I '($G(^AGMPCHK(0))) Q  ;The CHK global isn't built we need to create it before the Check routine is ran
  1.  L +^AGMPCHK:5 I '$T Q  ;Attempt to lock the AGMPCHK global, if no lock quit the update process.
  1.  S INST=0 ;Set the Institution to zero
  1.  F  S INST=$O(^AGFAC(INST)) Q:INST=""  D  ;Loop through the Institution numbers from the AGFAC global
  1.  .I '($P($G(^AGFAC(INST,0)),U,21)="Y") D  Q  ;If the the Institution isn't an Ordering Facility we do not check or store this information
  1.  ..I '($G(^AGMPCHK(INST))="") D RENTRY(INST)  Q
  1.  .S USID=$P($G(^DIC(4,INST,99)),U,1) ;Pull the SiteID from the Institution file
  1.  .I ($G(^AGMPCHK(INST))="") D CENTRY(USID,INST,"INVALID")  Q
  1.  .I '($G(^AGMPCHK(INST,0))=USID) D  Q
  1.  ..I ($G(^AGMPCHK(INST,1))="VALID") D UENTRY(INST,"INVALID",USID)  Q
  1.  L -^AGMPCHK ;Unlock the AGMPCHK global
  1.  Q
  1.  ;
  1.  ;
  1. UPDMSGQ(PDFN,PDFN2,PMSGTYPE,PSITE) ;Add the needed entries to the AGMPCHKQ global
  1.  L +^AGMPCHKQ(PSITE,PDFN):5 I '$T Q  ;Attempt to lock the AGMPCHKQ(SITE,Patient) global node, if no lock quit the update process.
  1.  I ($G(PMSGTYPE)="A40") D  L -^AGMPCHKQ(PSITE,PDFN) Q  ;if this is a merge message do some checks and then set the Queue entry as needed.
  1.  .I '($G(PDFN2)) D NOTIF^AGMPIHLO(PDFN,"Unable to ADD merge entry to the AGMPCHKQ.  No DFN2")  Q
  1.  .I '($G(PDFN)) D NOTIF^AGMPIHLO(PDFN,"Unable to ADD merge entry to the AGMPCHKQ. No DFN")  Q
  1.  .I ($D(^DPT(PDFN,0))),'($D(^DPT(PDFN2,0))),'($D(^AGMPCHKQ(PSITE,PDFN2,0))="1") D NOTIF^AGMPIHLO(PDFN,"Missing DFN2 information not ADDing the merge entry to the AGMPCHKQ.")  Q
  1.  .I ($D(^DPT(PDFN2,0))),'($D(^DPT(PDFN,0))),'($D(^AGMPCHKQ(PSITE,PDFN,0))="1") D NOTIF^AGMPIHLO(PDFN,"Missing DFN information not ADDing the merge entry to the AGMPCHKQ.")  Q
  1.  .I '($D(^AGMPCHKQ(PSITE,PDFN,1))) D  Q
  1.  ..I '($D(^AGMPCHKQ(PSITE,PDFN))) S ^AGMPCHKQ(PSITE,0)=$G(^AGMPCHKQ(PSITE,0))+1
  1.  ..S ^AGMPCHKQ(PSITE,PDFN,1)=PDFN2
  1.  I '($D(^AGMPCHKQ(PSITE,PDFN,0))) D  L -^AGMPCHKQ(PSITE,PDFN) Q
  1.  .I '($D(^AGMPCHKQ(PSITE,PDFN))) S ^AGMPCHKQ(PSITE,0)=$G(^AGMPCHKQ(PSITE,0))+1
  1.  .S ^AGMPCHKQ(PSITE,PDFN,0)=""
  1.  L -^AGMPCHKQ(PSITE,PDFN)
  1.  Q
  1.  ;
  1.  ;
  1. SNDMSGQ(PSITE) ;Send the messages for the instituiton/site ID that is now VALID
  1.  N AGMPCHKFLG,SUCCESS,SDUZ2,SNDC,DEXEC,TDFN,TDFN2
  1.  I $D(^AGMPCHKQ(PSITE)) D  Q
  1.  .S AGMPCHKFLG=1
  1.  .S SUCCESS=1
  1.  .S SDUZ2=DUZ(2)
  1.  .S DUZ(2)=PSITE ; SAC 2009 2.2.3.3
  1.  .S SNDC=1
  1.  .S TDFN=""
  1.  .F  S TDFN=$O(^AGMPCHKQ(PSITE,TDFN),-1) Q:'TDFN  D
  1.  ..L +^AGMPCHKQ(PSITE,TDFN):5 I '$T S SNDC=0 Q  ;Attempt to lock the AGMPCHKQ(SITE,Patient) global node, if we can't lock go to the next patient.
  1.  ..I $D(^AGMPCHKQ(PSITE,TDFN,0)) D
  1.  ...D CREATMSG^AGMPIHLO(TDFN,"A08",,.SUCCESS)
  1.  ..I SUCCESS,$G(^AGMPCHKQ(PSITE,TDFN,1)) D
  1.  ...S TDFN2=$G(^AGMPCHKQ(PSITE,TDFN,1))
  1.  ...I $D(^AGMPCHKQ(PSITE,TDFN2,0)) D
  1.  ....D CREATMSG^AGMPIHLO(TDFN2,"A08",,.SUCCESS)
  1.  ....I SUCCESS K ^AGMPCHKQ(PSITE,TDFN2)
  1.  ...I SUCCESS D CREATMSG^AGMPIHLO(TDFN,"A40",TDFN2,.SUCCESS)
  1.  ..I SNDC S SNDC=SUCCESS
  1.  ..L -^AGMPCHKQ(PSITE,TDFN)
  1.  ..Q:'SUCCESS
  1.  ..K ^AGMPCHKQ(PSITE,TDFN)
  1.  .I SNDC  D
  1.  ..K ^AGMPCHKQ(PSITE)
  1.  ..W !,"Messages sent for Site "_PSITE
  1.  .I 'SNDC  W !,"There was an Error in processing the messages for Site "_PSITE
  1.  .K AGMPCHKFLG
  1.  .S DUZ(2)=SDUZ2 ; SAC 2009 2.2.3.3
  1.  Q