source: FOIAVistA/trunk/r/DIETETICS-FH/FHWOR1.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 1.3 KB
Line 
1FHWOR1 ; HISC/REL/NCA - HL7 Additional Orders ;10/10/00 14:55
2 ;;5.5;DIETETICS;;Jan 28, 2005
3ADD ; Add new Order
4 S COM=$E(COM,1,160) D ORD^FHORO S $P(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0),"^",8)=+FHORN
5 S FILL="A"_";"_ADM_";"_FHDR_";"_COM K COM,FHDR
6 D SEND^FHWOR Q
7CAN ; Process Cancel/Discontinue Order from OE/RR
8 S FHDR=+$P(FILL,";",3) I 'FHDR S TXT="No Filler Number." D CERR^FHWOR Q
9 D GADM^FHWORR
10F0 I '$D(^FHPT(FHDFN,"A",+ADM,"OO",+FHDR,0)) S TXT="Additional Order not on file." D CERR^FHWOR Q
11 S Y=^FHPT(FHDFN,"A",ADM,"OO",FHDR,0)
12 I +FHORN'=$P(Y,"^",8) S TXT="Order Number Not Matching." D CERR^FHWOR Q
13 D NOW^%DTC S $P(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0),"^",5,7)="X^"_%_"^"_DUZ
14 K ^FHPT("AOO",FHDFN,ADM,FHDR) S EVT="O^C^"_FHDR D ^FHORX K %,FHDR,Y
15 D CSEND^FHWOR Q
16AO ; Code Additional Orders
17 K MSG S FILL="A"_";"_ADM_";"_FHDR_";"_COM
18 S SDT=NOW D SET
19 ; Code MSH, PID, and PV1
20 D MSH^FHWOR
21 ; code ORC
22 S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_SDT_"|||"_DUZ_"||"_DUZ_"|||"_NOW
23 ; Code ODS
24 S MSG(5)="ODS|D||^^^FH-6^Additional Order^99OTH|"_COM
25 K FILL,FHWRD,HOSP,RM,SITE,SDT
26 Q
27SET ; Set Date/Time in HL7 format
28 S:SDT SDT=$$FMTHL7^XLFDT(SDT)
29 S:NOW NOW=$$FMTHL7^XLFDT(NOW)
30 Q
31NA ; OE/RR Number Assign
32 S FHDR=+$P(FILL,";",3) G:'FHDR KIL S:ADM'=$P(FILL,";",2) ADM=$P(FILL,";",2)
33 G:'+FHORN KIL
34 S $P(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0),"^",8)=+FHORN
35KIL K FHDR,MSG,FHORN Q
Note: See TracBrowser for help on using the repository browser.