| [613] | 1 | FHWOR1 ; HISC/REL/NCA - HL7 Additional Orders ;10/10/00 14:55
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
|---|
| 3 | ADD ; 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
|
|---|
| 7 | CAN ; 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
|
|---|
| 10 | F0 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
|
|---|
| 16 | AO ; 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
|
|---|
| 27 | SET ; Set Date/Time in HL7 format
|
|---|
| 28 | S:SDT SDT=$$FMTHL7^XLFDT(SDT)
|
|---|
| 29 | S:NOW NOW=$$FMTHL7^XLFDT(NOW)
|
|---|
| 30 | Q
|
|---|
| 31 | NA ; 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
|
|---|
| 35 | KIL K FHDR,MSG,FHORN Q
|
|---|
