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

AGMPHLEU.m

Go to the documentation of this file. 
  1. AGMPHLEU ; IHS/SD/TPF - HLO MPI A28 MISSING ICN BACKGROUND TASKS ;    
  1.  ;;7.2;IHS PATIENT REGISTRATION;**1,3,6**;MAY 20, 2010;Build 23
  1.  ;
  1.  ;RTN RUNS IN BACKGROUND AND TRAVERSES VA PATIENT FILE
  1.  ;ANY RECORDS WITH FIELD ANY RECORDS WIH ONLY A LOCAL ICN
  1.  ;OR MISSING AN EUID AN ATTEMPT WILL BE MADE TO DO ANOTHER
  1.  ;EXACT MATCH QUERY A28 IN THE SAME WAY AS DONE IN THE 'ADD; OPTION
  1. START ;EP - START UP MISSING AND LOCAL ID TASK
  1.  D MISSEUID
  1.  Q
  1.  ;
  1. MISSEUID ;EP - PROCESS MISSING EUID
  1.  N DFNIEN,MISSING,ADDED,ERRORS,TMPDUZ2,NONORF,MERGED,LOCKED,NOCHART,QUEUED,PICN,TICN,DELAY,MAX,DA,CNT
  1.  S TMPDUZ2=DUZ(2)
  1.  S (MISSING,ADDED,ERRORS,NONORF,MERGED,LOCKED,NOCHART,QUEUED)=0
  1.  ;05/30/2013 - KJH - TFS8081 - Update the ^XTMP global used to store temporary info about the MISSING ICN TASK.
  1.  S ^XTMP("AGMPICN",0)=$$FMADD^XLFDT(DT,58)_U_DT_U_"AGMP MPI MISSING ICN TSK"
  1.  S DELAY=+$G(^XTMP("AGMPICN","DELAY")) I DELAY=0 S DELAY=14 ;If not set, use 14 day minimum between attempts to get an ICN for a patient.
  1.  S MAX=+$G(^XTMP("AGMPICN","MAX")) I MAX=0 S MAX=5000 ;If not set, use 5000 as the maximum number of attempts.
  1.  ;06/07/2013 - DMB - TFS8081 - If running in foreground, let user pick maximum number of records to extract
  1.  I '$D(ZTQUEUED) D  I MAX=-1 Q
  1.  . N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  . W !!,"Enter the maximum number of messages you would like to create.  If you want to"
  1.  . W !,"send messages for all active charts for all patients who are currently missing"
  1.  . W !,"an ICN, enter 9999999",!
  1.  . S DIR(0)="NA^1:9999999:0",DIR("A")="Maximum number of messages to send? ",DIR("B")=MAX
  1.  . D ^DIR
  1.  . I +Y<1 S MAX=-1 Q
  1.  . S MAX=Y
  1.  S DFNIEN=0
  1.  ;05/30/2013 - KJH - TFS8081 - Update the MISSING ICN TASK to use the TREATING FACILITY LIST.
  1.  F CNT=0:1 S DFNIEN=$O(^DPT(DFNIEN)) Q:'DFNIEN  D
  1.  .I $D(^DPT(DFNIEN,-9)) S MERGED=MERGED+1 Q  ;DON'T ATTEMPT FOR MERGED RECORDS
  1.  .I $$DEMOPAT^AGMPHLU(DFNIEN) Q  ; 9/13/2017 - GCD - CR 7713 - Don't upload demo patients.
  1.  .S PICN=$$GET1^DIQ(2,DFNIEN_",",991.01,"E") ;PATIENT INTEGRATION CONTROL NUMBER
  1.  .;W !,DFNIEN
  1.  .;TRY A LOCK. IF CAN'T LOCK PATIENT, RECORD BEING BUILT??
  1.  .L +^DPT(DFNIEN):5 I '$T S LOCKED=LOCKED+1 Q
  1.  .L -^DPT(DFNIEN)
  1.  .I '$D(ZTQUEUED),CNT#1000=0 W "."
  1.  .I '$O(^AUPNPAT(DFNIEN,41,0)) S NOCHART=NOCHART+1 Q
  1.  .S DUZ(2)=0
  1.  .F  S DUZ(2)=$O(^AUPNPAT(DFNIEN,41,DUZ(2))) Q:DUZ(2)=""  D
  1.  ..;W !,?5,$S($P($G(^AGFAC(DUZ(2),0)),U,21)'="":$P($G(^AGFAC(DUZ(2),0)),U,21),1:"UNDEFINED")
  1.  ..I $P($G(^AGFAC(DUZ(2),0)),U,21)'="Y" D  Q  ;ONLY "OFFICAL REGISTERING FACILITIES"
  1.  ...S NONORF=NONORF+1
  1.  ..S DA=$O(^DGCN(391.91,"AINST",DUZ(2),DFNIEN,"")),TICN=""
  1.  ..I DA S TICN=$$GET1^DIQ(391.91,DA_",",9999999.02,"E")  ;TREATING FACILITY INTEGRATION CONTROL NUMBER
  1.  ..;05/30/2013 - KJH - TFS8081 - Add code to try to prevent system from attempting to resend a request until at least 7 days have passed.
  1.  ..I PICN]"",TICN]"",PICN=TICN K ^XTMP("AGMPICN",DFNIEN,DUZ(2)) Q  ; OK. Does not need to be tracked.
  1.  ..S MISSING=MISSING+1
  1.  ..I $G(^XTMP("AGMPICN",DFNIEN,DUZ(2)))+DELAY>+$H S QUEUED=QUEUED+1 Q  ;Wait at least 'DELAY' days before trying again.
  1.  ..;06/11/2013 - DMB - TFS8081 - Only add to queue if under the maximum number of attempts per execution
  1.  ..I ADDED<MAX D ATTEMPT(DFNIEN,.ADDED,.ERRORS)
  1.  S DUZ(2)=TMPDUZ2  ;RESTORE DUZ(2) TO TASKER
  1.  I '$D(ZTQUEUED) D
  1.  .W !,"PATIENT LOCKED: ",LOCKED
  1.  .W !,"PATIENT MERGED: ",MERGED
  1.  .W !,"NO CHARTS FOR PATIENT: ",NOCHART
  1.  .W !,"ORF IS OFF FOR LOCATION/STATION: ",NONORF
  1.  .W !!,"ICN MISSING FROM PATIENT/STATION: ",MISSING
  1.  .W !,"ALREADY ON QUEUE: ",QUEUED
  1.  .W !,"ERRORS: ",ERRORS
  1.  .W !,"MESSAGES QUEUED: ",ADDED I ADDED>MAX W "   *** Per execution maximum of ",MAX," exceeeded ***"
  1.  Q
  1.  ;
  1. ATTEMPT(DFN,ADDED,ERRORS) ;EP - TRY TO ADD PTS WITH MISSING EUIDs
  1.  D CREATMSG^AGMPIHLO(DFN,"A28","",.SUCCESS)  ;DO THE A28
  1.  I 'SUCCESS D  Q
  1.  .S ERRORS=ERRORS+1
  1.  .S ERR="CANNOT CREATE A28 DURING 'AGMP MPI MISSING ICN TSK'"
  1.  .D NOTIF^AGMPIHLO(DFN,ERR)
  1.  ;06/11/2013 - DMB - TFS8081 - If successful, update counter and add to the temporary global
  1.  S ADDED=ADDED+1
  1.  S ^XTMP("AGMPICN",DFNIEN,DUZ(2))=+$H
  1.  ;05/29/2013 - KJH - TFS8109 - This was causing an extra message to be sent to EDR.
  1.  ;S X="AG REGISTER A PATIENT",DIC=101,INDA=DFN
  1.  ;D EN^XQOR
  1.  Q
  1.  ;CREATE OUTGOING BATCH
  1. BATCHOUT() ;EP - THIS ENTRY POINT WILL COLLECT A28 MESSAGE FOR PTS WITH MISSING ICNS
  1.  N MSG,PARMS,SEG,WHOTO,DFN,QUIT,BATCH,HLMP,HLMSTATE
  1.  S BATCH=1
  1.  S HLPM("MESSAGE TYPE")="ADT"
  1.  S HLPM("EVENT")="A28"
  1.  S HLPM("VERSION")=2.4
  1.  S HLPM("FIELD SEPARATOR")="^"
  1.  S HLPM("ENCODING CHARACTERS")="~|\&"
  1.  S HL1("ECH")=HLPM("ENCODING CHARACTERS")
  1.  S COMP=$E(HL1("ECH"))
  1.  S HL1("FS")=HLPM("FIELD SEPARATOR")
  1.  S HL1("ECH")="~|\&"
  1.  S HL1("FS")="^"
  1.  S HL1("Q")=""
  1.  S HL1("VER")=2.4
  1.  I '$$NEWBATCH^HLOAPI(.HLPM,.HLMSTATE,.ERR) D  Q 0
  1.  .D NOTIF^AGMPIHLO(0,"Unable to create batch."_$S($D(ERR):" ERR:"_$G(ERR),1:""))
  1.  S (DFNIEN,QUIT)=0
  1.  F  S DFNIEN=$O(^DPT(DFNIEN)) Q:'DFNIEN!(QUIT)  D
  1.  .Q:$$GET1^DIQ(2,DFNIEN_",",991.01,"E")  ;INTEGRATION CONTROL NUMBER
  1.  .Q:$D(^DPT(DFNIEN,-9))  ;DON'T ATTEMPT FOR MERGED RECORDS
  1.  .I $$DEMOPAT^AGMPHLU(DFNIEN) Q  ; 9/13/2017 - GCD - CR 7713 - Don't upload demo patients.
  1.  .;IF NO ICN THEN TRY A LOCK, IF CAN'T LOCK PATIENT RECORD BEING BUILT??
  1.  .L +^DPT(DFNIEN):5 I '$T Q
  1.  .L -^DPT(DFNIEN)
  1.  .D
  1.  ..I '$$ADDMSG^HLOAPI(.HLMSTATE,.HLPM,.ERR) D  Q
  1.  ...S QUIT=1
  1.  ...D NOTIF^AGMPIHLO(0,"UNABLE TO ADD MESSAGE TO BATCH."_$S($D(ERR):" ERR:"_$G(ERR),1:""))
  1.  ..M HLST=HLMSTATE
  1.  ..D EVN^AGMPIHLO(HLPM("EVENT"))
  1.  ..I '$D(ERR) D PID^AGMPIHL1(DFNIEN)
  1.  ..I '$D(ERR) D ZPD^AGMPIHL1(DFNIEN)
  1.  ..I $D(ERR) D NOTIF^AGMPIHLO(0,"UNABLE TO ADD MSG TO BATCH."_$S($D(ERR):" ERR:"_$G(ERR),1:""))
  1.  ..;D VTQ(DFNIEN,.SEG,.MSG)
  1.  ..;I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERR) Q
  1.  ..;D RDF(DFNIEN,.SEG,.MSG)
  1.  ..;I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERR) Q
  1.  Q:QUIT 0
  1.  ;B "S+"
  1.  D SET
  1.  ; 05/24/2013 - KJH - TFS8008 - Remove extraneous locks on the HLO globals.
  1.  I '$$SENDONE^HLOAPI1(.MSG,.APPARMS,.WHO,.ERR) D  Q 0
  1.  .D NOTIF^AGMPIHLO(0,"UNABLE TO SEND BATCH."_$S($D(ERR):" ERR:"_$G(ERR),1:""))
  1.  K BATCH
  1.  Q 1
  1.  ;
  1. SET ;EP - INIT VARS FOR BATCH
  1.  S APPARMS("SENDING APPLICATION")="RPMS-MPI"
  1.  S APPARMS("ACCEPT ACK TYPE")="AL"  ;Commit ACK type
  1.  ;S APPARMS("ACCEPT ACK TYPE")="NE"  ;(FIELD 15) Commit ACK type ;TPF - CHANGED TO THIS BECASUE OF "SE" ERRORS APPARMS("APP ACK RESPONSE")="AACK^AGMPIHLO"  ;Callback when 'application ACK' is received
  1.  S APPARMS("ACCEPT ACK RESPONSE")="CACK^AGMPIHLO"  ;Callback when 'commit ACK' is received
  1.  ;S APPARMS("APP ACK TYPE")="AL"  ;Application ACK type
  1.  S APPARMS("APP ACK TYPE")="NE"  ;(FIELD 16) Application ACK type ;TPF - CHANGED TO THIS BECASUE OF "SE" ERROR
  1.  S APPARMS("QUEUE")="MPI RPMS"   ;Incoming QUEUE
  1.  S APPARMS("RECEIVING APPLICATION")="MPI RPMS"
  1.  S WHO("RECEIVING APPLICATION")="MPI"  ;THIS DOES OVERRIDE LINE ABOVE
  1.  S WHO("FACILITY LINK NAME")="MPI"
  1.  S WHO("STATION NUMBER")=8990  ;IHS/SD/TPF MPI TEST
  1.  ;S WHO("IE LINK NAME")="MPIVA"  ;FOR EARLIER TESTS
  1.  S WHO("IE LINK NAME")="MPI"  ;FOR HLO TESTING
  1.  ;S APPARMS("SENDING FACILITY")=14752  ;14752 IS SELLS
  1.  S APPARMS("SENDING FACILITY")=$$GET1^DIQ(4,DUZ(2)_",",99,"E")
  1.  Q
  1.  ;SET(SEG,VALUE,FIELD,REP,COMP,SUBCOMP)
  1.  ;THIS LOOKS MORE LIKE THE ARRAY WILL ACTUALLY TURN OUT
  1.  ;AND ALSO MATCHES THE AGMPPARS V1.6 MESSAGE PARSER GENERIC OUTPUT
  1. MYSET(ARY,V,F,R,C,S) ;EP
  1.  D SET^HLOAPI(.ARY,.V,.F,.C,.S,.R)
  1.  Q