source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDHWS.m@ 1147

Last change on this file since 1147 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.3 KB
Line 
1MAGDHWS ;WOIFO/PMK - Capture Consult/GMRC data ; 03/16/2007 12:48
2 ;;3.0;IMAGING;**10,11,51,84,85**;16-March-2007;;Build 1039
3 ;; Per VHA Directive 2004-038, this routine should not be modified.
4 ;; +---------------------------------------------------------------+
5 ;; | Property of the US Government. |
6 ;; | No permission to copy or redistribute this software is given. |
7 ;; | Use of unreleased versions of this software requires the user |
8 ;; | to execute a written test agreement with the VistA Imaging |
9 ;; | Development Office of the Department of Veterans Affairs, |
10 ;; | telephone (301) 734-0100. |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18 ; Called from PROTOCOL called MAGD APPOINTMENT (^ORD(101,...))
19 ; through the scheduling package
20 ;
21 N %,AFTERSTS,APTSCHED,CLINIC,CONSULTM,CUTOFF,DATETIME
22 N DEL,DEL2,DEL3,DEL4,DEL5,DFN,DIVISION,DONE,FILLER1,FMDATE,FMDATETM
23 N GMRCIEN,HL,IGNORE,IREQ,ITYPCODE,ITYPNAME,MSGTYPE,REQUEST
24 N SERVICE,STATUS,UNKNOWN,X,Y,Z
25 ;
26 Q:$P($G(SDATA("AFTER","STATUS")),"^",3)="" ; Not a valid appointment
27 ;
28 D INIT^MAGDHW0 ; initialize variables
29 D NOW^%DTC S FMDATE=%\1,FMDATETM=%
30 S %H=%H-90 D TT^%DTC S CUTOFF=X ; cutoff date is 90 days ago
31 S DFN=$P(SDATA,"^",2),DATETIME=$P(SDATA,"^",3),CLINIC=$P(SDATA,"^",4)
32 S APTSCHED("CLINIC IEN")=CLINIC,APTSCHED("FM DATETIME")=DATETIME
33 S AFTERSTS=SDATA("AFTER","STATUS"),X=$P(AFTERSTS,"^",3)
34 ; appointment management transactions from ^SD(409.63)
35 S FILLER1="" D Q:FILLER1=""
36 . I X["CHECK IN" S FILLER1="SDAM-CHECKIN" Q
37 . I X["CHECKED IN" S FILLER1="SDAM-CHECKIN" Q
38 . I X["CHECK OUT" S FILLER1="SDAM-CHECKOUT" Q
39 . I X["CHECKED OUT" S FILLER1="SDAM-CHECKOUT" Q
40 . I X["AUTO RE-" S FILLER1="SDAM-SCHEDULED" Q
41 . I X["AUTO-RE" S FILLER1="SDAM-SCHEDULED" Q
42 . I X["ACTION REQUIRED" S FILLER1="SDAM-SCHEDULED" Q
43 . I X["ACT REQ" S FILLER1="SDAM-SCHEDULED" Q
44 . I X["NON-COUNT" S FILLER1="SDAM-SCHEDULED" Q
45 . I X["CANCELLED" S FILLER1="SDAM-CANCELLED" Q
46 . I X["NO-SHOW" S FILLER1="SDAM-CANCELLED" Q
47 . I X["DELETED" S FILLER1="SDAM-CANCELLED" Q
48 . I X["FUTURE" S FILLER1="SDAM-FUTURE" Q
49 . I X["NO ACTION TAKEN" S FILLER1="SDAM-SCHEDULED" Q
50 . I X["NO ACT TAKN" S FILLER1="SDAM-SCHEDULED" Q
51 . I X["INPATIENT" S FILLER1="SDAM-SCHEDULED" Q
52 . ;
53 . W !!,"Unexpected Status: """,X,""" in protocol MAGD APPOINTMENT."
54 . W !,"Please notify Customer Support"
55 . W !!,"Press <Enter> to continue: " R X:$G(DTIME,300)
56 . Q
57 ;
58 S APTSCHED("CLINIC NAME")=$S(CLINIC:$$GET1^DIQ(44,CLINIC,.01),1:"")
59 ;
60 ; find requests that can be performed in this clinic
61 D SEARCH^MAGDGMRC(DFN,CUTOFF,CLINIC,.REQUEST)
62 ;
63 ; output an HL7 message for each request related to this appointment
64 F IREQ=1:1:REQUEST D
65 . S GMRCIEN=$P(REQUEST(IREQ),"^",1),SERVICE=$P(REQUEST(IREQ),"^",2)
66 . S STATUS=$P(REQUEST(IREQ),"^",3)
67 . S IGNORE=1 D SERVICE^MAGDHWC Q:IGNORE ; not a service of interest
68 . ; if {pending, active, scheduled, partially resulted, or complete}
69 . I "^p^a^s^pr^c^"[("^"_STATUS_"^") D
70 . . ; completed requests can only be checked out or cancelled
71 . . I STATUS="c","SDAM-CHECKOUT^SDAM-CANCELLED"'[FILLER1 Q
72 . . D MESSAGE("S")
73 . . Q
74 . Q
75 Q
76 ;
77MESSAGE(MSGTYPE) ; invoked above and also from ^MAGDHWC for the initial order
78 N CONSULT,HL7,MSG,NEXT,OBXSEGNO,ORCTRL,ORSTATUS
79 I MSGTYPE="O" D ; ordered - set in ^MAGDHWC
80 . S MSGTYPE="ORDERED"
81 . S ORCTRL="NW" ; order control
82 . S ORSTATUS="IP" ; order status
83 . Q
84 E D
85 . S MSGTYPE="SCHEDULED"
86 . S ORCTRL="SC" ; order control -- status changed
87 . S ORSTATUS="ZC" ; scheduling
88 . Q
89 D MSH^HLFNC2(.HL,100000,.MSG) S $P(MSG,DEL,9)="ORM"
90 S NEXT=0
91 S NEXT=NEXT+1,HL7(NEXT)=MSG D MSH^MAGDHWA
92 S NEXT=NEXT+1,HL7(NEXT)="PID",$P(HL7(NEXT),DEL,1+3)=DFN
93 S NEXT=NEXT+1,HL7(NEXT)="PV1"
94 D PID^MAGDHWA ; generate PID and PV1 segments
95 S NEXT=NEXT+1,HL7(NEXT)=$$ORC D ORC^MAGDHWA
96 S NEXT=NEXT+1,HL7(NEXT)=$$OBR D OBR^MAGDHWA
97 S NEXT=NEXT+1,HL7(NEXT)=$$ZSV D ZSV^MAGDHWA
98 S NEXT=NEXT+1,NEXT=$$OBX(NEXT)
99 D ALLERGY^MAGDHWA,POSTINGS^MAGDHWA
100 D OUTPUT^MAGDHW0
101 Q
102 ;
103PV1() ; build a PV1 segment
104 N X,Z
105 S FROM=$$GET1^DIQ(123,GMRCIEN,.04,"I") ; patient location
106 S Z=FROM_DEL3_$S(FROM:$$GET1^DIQ(44,FROM,.01),1:"")_DEL3_SERVICE
107 S $P(X,DEL,10)=Z
108 Q "PV1"_DEL_X
109 ;
110ORC() ; build an ORC segment
111 N ORC,ORCPLCR,ORURG
112 S ORCPLCR=$$GET1^DIQ(123,GMRCIEN,10,"I") ; sending provider
113 D ORC^GMRCHL7(GMRCIEN,ORCTRL,ORCPLCR,,FMDATETM)
114 S $P(ORC,DEL,5+1)=ORSTATUS
115 Q ORC
116 ;
117ZSV() ; build a ZSV segment
118 N ZSV
119 D ZSV^GMRCHL7(GMRCIEN)
120 Q ZSV
121 ;
122OBR() ; build an OBR segment
123 N NOTIFY,OBR
124 D OBR^GMRCHL72(GMRCIEN,"",FMDATETM)
125 Q OBR
126 ;
127OBX(NEXT) ; build one or more OBX segments
128 N GMRCND,GMRCND1,I,J,OBX,X
129 D OBX^GMRCHL72(GMRCIEN)
130 S OBXSEGNO=0
131 F I=1:1 Q:'$D(OBX(I)) D
132 . D OBX1(OBX(I))
133 . I $D(OBX(I,1)) S X=$P(OBX(I),DEL,1,5) F J=1:1 Q:'$D(OBX(I,J)) D
134 . . D OBX1(X_DEL_OBX(I,J))
135 . . Q
136 . Q
137 Q NEXT
138 ;
139OBX1(RECORD) ; store one OBX segment into the HL7 array
140 S HL7(NEXT)=RECORD
141 S OBXSEGNO=$P(RECORD,DEL,2) ; get the highest value of OBXSEGNO
142 S NEXT=NEXT+1
143 Q
Note: See TracBrowser for help on using the repository browser.