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

XUSNPIXI.m

Go to the documentation of this file. 
  1. XUSNPIXI ;OAK_BP/BEE - NPI EXTRACT REPORT INTERFACE ROUTINE ;01-OCT-06
  1.  ;;8.0;KERNEL;**481**;Jul 10, 1995;Build 18
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; Process incoming HL7 NPI Crosswalk Extract Schedule/Cancel Message
  1.  ;
  1.  ; Incoming Variables (Defined in HL7 Message Handler)
  1.  ;
  1.  ; HLNEXT   -> Executable code to step through message
  1.  ; HLMTIENS -> IEN of entry in Message Text file for subscriber application
  1.  ; HLNODE   -> Array containing current segment information
  1.  ; HLQUIT   -> Variable signifying last segment has been reached
  1.  ;
  1. EN ; Entry Point - Place message into a TMP global.
  1.  ;
  1.  N ACK,CNT,%DT,EVENT,FS,FSHLI,IDT,ORDCTL,PROCID,SEGCNT,SEGMSH,SEGORC,STS,X,XDT,Y
  1.  ;
  1.  ; Load message into ^TMP global
  1.  ;
  1.  K ^TMP($J,"XUSNPIXI")
  1.  F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0  D
  1.  . S CNT=0,^TMP($J,"XUSNPIXI",SEGCNT,CNT)=HLNODE
  1.  . F  S CNT=$O(HLNODE(CNT)) Q:'CNT  D
  1.  .. S ^TMP($J,"XUSNPIXI",SEGCNT,CNT)=HLNODE(CNT)
  1.  ;
  1.  ; Check MSH Segment
  1.  ;
  1.  S SEGMSH=$G(^TMP($J,"XUSNPIXI",1,0))
  1.  S (FS,FSHLI)=$E(SEGMSH,4)
  1.  ;
  1.  ;Make sure first message is MSH and check Process ID
  1.  S PROCID=$P(SEGMSH,FSHLI,11)
  1.  I ($E(SEGMSH,1,3)'="MSH")!(",T,P,"'[(","_PROCID_",")) D  G ACK
  1.  . S STS="AE^Invalid Message Header - First segment found is not MSH or PROCESS ID is not 'T' or 'P'"
  1.  ;
  1.  ;Verify Correct Message Type
  1.  S EVENT=$P(SEGMSH,FSHLI,9)
  1.  I EVENT'="ORM^O01^ORM_O01" D  G ACK
  1.  . S STS="AE^Invalid Message Type ("_EVENT_") - Expecting ORM^O01^ORM_O01"
  1.  ;
  1.  ;Save needed parameter
  1.  S HL("HLMTIENS")=$G(HLMTIENS)
  1.  ;
  1.  ; Process ORC Segment
  1.  ;
  1.  ;Pull next segment (should be an ORC)
  1.  S SEGORC=$G(^TMP($J,"XUSNPIXI",2,0))
  1.  ;
  1.  ;Check for ORC segment
  1.  I $E(SEGORC,1,3)'="ORC" D  G ACK
  1.  . S STS="AE^Invalid Segment ("_$E(SEGORC,1,3)_") - Second segment should be an ORC segment"
  1.  ;
  1.  ;Pull Order Control Field
  1.  S ORDCTL=$P(SEGORC,FSHLI,2)
  1.  I ORDCTL'="NW",ORDCTL'="CA" D  G ACK
  1.  . S STS="AE^Invalid Order Control Field Value ("_ORDCTL_") - Expected 'NW' or 'CA'"
  1.  ;
  1.  ;Check Date and Time
  1.  S X=$E($P(SEGORC,FSHLI,10),1,12)
  1.  S:X?8N X=X_"2100"  ;Default to 9:00PM if no time
  1.  S:X?10N X=X_"00"   ;Default minutes if not sent
  1.  S:X'?12N X=-1      ;Invalid date
  1.  S:X'=-1 X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4)_"@"_$E(X,9,12)
  1.  S %DT="R" D ^%DT I Y=-1 D  G ACK
  1.  . S STS="AE^Invalid Run Date/Time - ("_$P(SEGORC,FSHLI,10)_")"
  1.  S IDT=Y,XDT=X
  1.  ;
  1.  ;Call Schedule (NW) or Cancel (CA) Tags
  1.  I ORDCTL="NW" D
  1.  . S STS=$$NW(IDT,XDT)
  1.  I ORDCTL="CA" D
  1.  . S STS=$$CA(IDT,XDT)
  1.  ;
  1.  ; Kick Off Application Acknowledgment
  1.  ;
  1. ACK S ACK("MSA",1)=$P(STS,U)
  1.  S ACK("MSA",2)=$G(HL("MID"))  ;Message ID
  1.  S ACK("MSA",3)=$P(STS,U,2)    ;Message Text
  1.  D APPACK(.HL,.ACK)
  1.  ;
  1.  ; Exit the process
  1.  ;
  1. EXIT K ACK,CNT,%DT,EVENT,FS,FSHLI,IDT,PROCID,SEGCNT,SEGMSH,SEGORC,STS,X,XDT,Y
  1.  K ^TMP($J,"XUSNPIXI"),HL,HLNEXT,HLNODE,HLQUIT
  1.  Q
  1.  ;
  1.  ; Schedule a New Run
  1.  ;
  1. NW(IDT,XDT) N TSK
  1.  ;
  1.  ;Check if task already scheduled for date/time
  1.  S TSK=$$GETTASK(IDT)
  1.  I TSK Q "AE^Task (#"_TSK_") already scheduled to run on "_XDT
  1.  ;
  1.  ;Schedule the task
  1.  S TSK=$$SCHED(IDT)
  1.  ;
  1.  ;Check for scheduling problem
  1.  I 'TSK Q "AE^Task Could Not Be Scheduled"
  1.  ;
  1.  ;Send successful schedule message
  1.  D MSG("CROSSWALK EXTRACT REPORT Scheduled "_XDT)
  1.  Q "AA^"
  1.  ;
  1.  ; Cancel a Scheduled Run
  1.  ;
  1. CA(IDT,XDT) N ZTSK
  1.  ;
  1.  ;Check if task has been scheduled for date/time
  1.  S ZTSK=$$GETTASK(IDT)
  1.  I 'ZTSK Q "AE^Task was not scheduled to run on "_XDT_"."
  1.  ;
  1.  ;Delete Task
  1.  D KILL^%ZTLOAD
  1.  ;
  1.  ;Check for problem with cancel request
  1.  I '$G(ZTSK(0)) Q "AE^Task (#"_ZTSK_") could not be killed."
  1.  ;
  1.  ;Send successful run cancel message
  1.  D MSG("CROSSWALK EXTRACT REPORT Cancelled "_XDT)
  1.  ;
  1.  Q "AA^"
  1.  ;
  1.  ;Check To See If Task Is Scheduled for Date and Time/Locate Task
  1.  ;
  1. GETTASK(IDT) N TASK,TASKNO,TDT,XUSUCI,Y,ZTSK0
  1.  ;
  1.  ;Retrieve UCI
  1.  X ^%ZOSF("UCI") S XUSUCI=Y
  1.  ;
  1.  S TASK=0,TASKNO=""
  1.  F  S TASK=$O(^%ZTSK(TASK)) Q:'TASK  D  Q:TASKNO
  1.  .I $G(^%ZTSK(TASK,.03))["XUS NPI EXTRACT" D
  1.  ..S ZTSK0=$G(^%ZTSK(TASK,0))
  1.  ..;
  1.  ..;Exclude tasks scheduled by TaskMan
  1.  ..Q:ZTSK0["ZTSK^XQ1"
  1.  ..;
  1.  ..;Exclude tasks in other ucis
  1.  ..Q:(($P(ZTSK0,U,11)_","_$P(ZTSK0,U,12))'=XUSUCI)
  1.  ..;
  1.  ..;Check for correct date and time
  1.  ..S TDT=$$HTFM^XLFDT($P(ZTSK0,"^",6))
  1.  ..I TDT=IDT S TASKNO=TASK
  1.  Q TASKNO
  1.  ;
  1.  ;Schedule Task
  1.  ;
  1. SCHED(ZTDTH) N ZTRTN,ZTDESC,ZTIO,ZTSK
  1.  S ZTRTN="TASKMAN^XUSNPIX1"
  1.  S ZTDESC="XUS NPI EXTRACT"
  1.  S ZTIO=""
  1.  D ^%ZTLOAD
  1.  Q ZTSK
  1.  ;
  1.  ;Send Application Acknowledgment
  1.  ;
  1. APPACK(HL,XUSACK) ;
  1.  N FS,HLA,XUSGENR
  1.  S FS=$G(HL("FS")) I FS="" S FS="|"
  1.  ;
  1.  ;Set up HL7
  1.  D INIT^HLFNC2("XUS NPI EXTRACT INPUT",.HL)
  1.  ;
  1.  ;MSA Segment
  1.  S HLA("HLA",1)="MSA"_FS_$G(XUSACK("MSA",1))_FS_$G(XUSACK("MSA",2))_FS_$G(XUSACK("MSA",3))
  1.  ;
  1.  ;Kick off Application Acknowledgment
  1.  D GENACK^HLMA1($G(HL("EID")),$G(HL("HLMTIENS")),$G(HL("EIDS")),"LM",1,.XUSGENR)
  1.  ;
  1.  Q
  1.  ;
  1.  ;Send MailMan Status Message
  1.  ;
  1. MSG(XUSSUB) N XMSUB,XMTEXT,XMY,XUDT,XUSNPIMM,XMDUZ,XMZ,XMMG,DIFROM
  1.  ;
  1.  ;Set subject and text
  1.  S XMTEXT="XUSNPIMM("
  1.  S XUDT=$P($P(XUSSUB,"@")," ",$L(XUSSUB," "))
  1.  S XUSSUB=$P(XUSSUB," ",1,$L(XUSSUB," ")-1)_" "
  1.  S XUSSUB=XUSSUB_$E(XUDT,7,10)_$E(XUDT,1,2)_$E(XUDT,4,5)
  1.  S XMSUB=$$SUBJ()_XUSSUB
  1.  S XMDUZ="XUS NPI CROSSWALK EXTRACT SCHEDULER"
  1.  ;
  1.  ;Put subject in body as well so message will transmit
  1.  S XUSNPIMM(.0001)=XMSUB
  1.  ;
  1.  ;Set recipient
  1.  S XMY("G.NPI EXTRACT VERIFICATION")=""
  1.  ;
  1.  ;Send
  1.  D ^XMD
  1.  ;
  1.  Q
  1.  ;
  1.  ; Define First Part of Message Subject
  1.  ;
  1. SUBJ() N PROD,SINFO,SITE,SUBJ
  1.  ;
  1.  ;Pull site info
  1.  S SINFO=$$SITE^VASITE
  1.  ;
  1.  ; Station Number
  1.  S SITE=$P(SINFO,U,3)
  1.  ;
  1.  ;Determine whether production or test
  1.  S PROD=$S($$PROD^XUPROD(1):"PROD",1:"TEST")
  1.  ;
  1.  Q "Station "_SITE_"("_PROD_") NPI "