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

MAGDHOW3.m

Go to the documentation of this file. 
  1. MAGDHOW3 ;WOIFO/PMK,DWM,DAC,GXT - Capture Consult/GMRC data ; Mar 12, 2020@14:08:32
  1.  ;;3.0;IMAGING;**138,180,203,208,231**;Mar 19, 2002;Build 9
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  ;
  1.  ; Supported IA #2051 reference $$FIND1^DIC function call
  1.  ; Supported IA #2056 reference $$GET1^DIQ function call
  1.  ; Supported IA #2056 reference GETS^DIQ subroutine call
  1.  ; Supported IA #4716 reference SET^HLOAPI and $$ADDSEG^HLOAPI calls
  1.  ; Supported IA #10103 reference $$FMTHL7^XLFDT function call
  1.  ; Supported IA #3065 reference $$HLNAME^XLFNAME function call
  1.  ; Controlled IA #4110 to read REQUEST/CONSULTATION file (#123)
  1.  ; Private IA #2698 to read URGENCY FILE (#101.42)
  1.  ; Supported IA #10060 to read phone numbers from NEW PERSON file (#200)
  1.  ;
  1. ORC(HLMSTATE,GMRCIEN,SAVEORCSEG) ; build the ORC segment (see ORC^GMRCHL7)
  1.  N ACNUMB,ERROR,ORCSEG,ORDERENTERER,ORDERNUMBER,ORDERPLACER,PRIORITY,SUCCESS,X
  1.  D SET^HLOAPI(.ORCSEG,"ORC",0)
  1.  D SET^HLOAPI(.ORCSEG,ORCTRL,1) ; ORC-1 order control
  1.  S ORDERNUMBER=$$GET1^DIQ(123,GMRCIEN,.03,"I") ; oe/rr file number
  1.  ; D SET^HLOAPI(.ORCSEG,$$STATNUMB^MAGDFCNV()_"-OR-"_ORDERNUMBER,2) ; ORC-2 placer order number
  1.  S ACNUMB=$$GMRCACN^MAGDFCNV(GMRCIEN)
  1.  D SET^HLOAPI(.ORCSEG,ACNUMB,2) ; ORC-2 placer order number (to be compatible with CP) P208 PMK 4/26/18
  1.  D SET^HLOAPI(.ORCSEG,ACNUMB,3) ; ORC-3 filler order number
  1.  ;
  1.  D SET^HLOAPI(.ORCSEG,ORSTATUS,5) ; ORC-5 order status
  1.  ; ORC-6 not used
  1.  ;
  1.  ; store date and time of scheduled appointment for order messages, not results
  1.  I MSGTYPE="ORM",$D(APTSCHED("FM DATETIME")) D
  1.  . D SET^HLOAPI(.ORCSEG,$$FMTHL7^XLFDT(APTSCHED("FM DATETIME")),7,4) ; ORC-7 start date/time
  1.  . Q
  1.  S PRIORITY=$$GET1^DIQ(123,GMRCIEN,5),PRIORITY=$P(PRIORITY," - ",2) ; urgency
  1.  S PRIORITY=$S(PRIORITY="EMERGENCY":"STAT",PRIORITY="NOW":"STAT",PRIORITY="OUTPATIENT":"ROUTINE",1:PRIORITY)
  1.  I PRIORITY'="" D  ; convert to HL7 priority
  1.  . N URGENCY
  1.  . S URGENCY=$$FIND1^DIC(101.42,,"B",PRIORITY)
  1.  . S PRIORITY=$S(URGENCY:$$GET1^DIQ(101.42,URGENCY,2,"E"),1:"")
  1.  . Q
  1.  D SET^HLOAPI(.ORCSEG,PRIORITY,7,6) ; ORC-7 priority
  1.  ; ORC-8 not used
  1.  D SET^HLOAPI(.ORCSEG,$$FMTHL7^XLFDT(FMDATETM),9) ; ORC-9 date/time of transaction
  1.  S ORDERENTERER=$$GET1^DIQ(100,ORDERNUMBER,3,"I") ; Order file - who entered
  1.  D NAME^MAGDHOW3(ORDERENTERER,10,.ORCSEG) ; ORC-10 entered by
  1.  ; ORC-11 not used
  1.  S ORDERPLACER=$$GET1^DIQ(123,GMRCIEN,10,"I") ; sending provider
  1.  D NAME^MAGDHOW3(ORDERPLACER,12,.ORCSEG) ; ORC-12 ordering provider
  1.  S X=$$GET1^DIQ(200,ORDERENTERER,29) ; service/section
  1.  D SET^HLOAPI(.ORCSEG,X,13) ; ORC-13 enterer's location
  1.  D PHONE^MAGDHOW3(ORDERPLACER,14,.ORCSEG) ; ORC-14 call back phone number(s)
  1.  S X=$$GET1^DIQ(123,GMRCIEN,3,"I") ; date of request
  1.  D SET^HLOAPI(.ORCSEG,$$FMTHL7^XLFDT(X),15) ; ORC-15 order effective date/time
  1.  ; ORC-16 not used
  1.  S X=$$GET1^DIQ(200,ORDERPLACER,29,"I") ; ordering provider's service/section
  1.  ; entering organization (abbreviation, name, coding system)
  1.  D SET^HLOAPI(.ORCSEG,$$GET1^DIQ(49,X,1),17,1)
  1.  D SET^HLOAPI(.ORCSEG,$$GET1^DIQ(49,X,.01),17,2)
  1.  D SET^HLOAPI(.ORCSEG,"VISTA49",17,3)
  1.  ;
  1.  M SAVEORCSEG=ORCSEG ; save some of the ORC fields for the OBR segment
  1.  S SUCCESS=$$ADDSEG^HLOAPI(.HLMSTATE,.ORCSEG,.ERROR)
  1.  I 'SUCCESS D
  1.  . N MSG,SUBJECT,VARIABLES
  1.  . S SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
  1.  . S MSG(1)="An error occurred in ORC^"_$T(+0)_" where the ADDSEG^HLOAPI invocation"
  1.  . S MSG(2)="for the ORC segment failed.  The error message is as follows:"
  1.  . S MSG(3)=""""_SUCCESS_""""
  1.  . S VARIABLES("HLMSTATE")=""
  1.  . S VARIABLES("ORCSEG")=""
  1.  . S VARIABLES("ERROR")=""
  1.  . D ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
  1.  . Q
  1.  Q
  1.  ;
  1. NAME(IEN,FIELD,ORCSEG) ; return person's name in HL7 format
  1.  N DGNAME,I,X
  1.  S DGNAME("FILE")=200,DGNAME("IENS")=IEN,DGNAME("FIELD")=.01
  1.  S X=$$HLNAME^XLFNAME(.DGNAME,"","^")
  1.  D SET^HLOAPI(.ORCSEG,IEN,FIELD,1)
  1.  F I=1:1:$L(X,"^") D SET^HLOAPI(.ORCSEG,$P(X,"^",I),FIELD,I+1)
  1.  Q
  1.  ;
  1. PHONE(IEN,FIELD,SEGMENT) ; call back phone number(s)
  1.  N FNUMBER,EQTYPE,I,MAGOUT,MAGERR,NUMBER,USECODE,X,REP,J,VAIEN,J,NUM
  1.  I IEN="" Q  ; P203 DAC - Quit if no order placer. Fixes P180 bug.
  1.  S REP=0 ; HL7 repetition
  1.  F I=1:1 S X=$T(PHONES+I) Q:"END"[$P(X,";;",2)  D
  1.  . S FNUMBER=$P(X,";",4),USECODE=$P(X,";",5),EQTYPE=$P(X,";",6)
  1.  . S NUMBER=$$GET1^DIQ(200,IEN,FNUMBER)
  1.  . D PHONE1(.REP,FIELD,.SEGMENT,NUMBER,USECODE,EQTYPE)
  1.  . Q
  1.  ;
  1.  ; P231 DAC - Removed Visited from Phone Numbers - Phone numbers not used, can cause errors.
  1.  ;
  1.  Q
  1.  ;
  1. PHONE1(REP,FIELD,SEGMENT,NUMBER,USECODE,EQTYPE) ; store phone info
  1.  I NUMBER'="" D
  1.  . S REP=REP+1
  1.  . D SET^HLOAPI(.SEGMENT,NUMBER,FIELD,1,1,REP)
  1.  . D SET^HLOAPI(.SEGMENT,USECODE,FIELD,2,1,REP)
  1.  . D SET^HLOAPI(.SEGMENT,EQTYPE,FIELD,3,1,REP)
  1.  . Q
  1.  Q
  1.  ;
  1. PHONES ;; field name ; field number ; HL7 Use Code ; HL7 Equipment Type
  1.  ;;PHONE (HOME);.131;PRN;PH
  1.  ;;OFFICE PHONE;.132;WPN;PH
  1.  ;;PHONE #3;.133;WPN;PN
  1.  ;;PHONE #4;.134;WPN;PN
  1.  ;;COMMERCIAL PHONE;.135;WPN;PN
  1.  ;;FAX NUMBER;.136;WPN;FX
  1.  ;;VOICE PAGER;.137;WPN;BP
  1.  ;;DIGITAL PAGER;.138;BPM;BP
  1.  ;;END
  1.  ;