FHWOR1 ; HISC/REL/NCA - HL7 Additional Orders ;10/10/00 14:55
;;5.5;DIETETICS;;Jan 28, 2005
ADD ; Add new Order
S COM=$E(COM,1,160) D ORD^FHORO S $P(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0),"^",8)=+FHORN
S FILL="A"_";"_ADM_";"_FHDR_";"_COM K COM,FHDR
D SEND^FHWOR Q
CAN ; Process Cancel/Discontinue Order from OE/RR
S FHDR=+$P(FILL,";",3) I 'FHDR S TXT="No Filler Number." D CERR^FHWOR Q
D GADM^FHWORR
F0 I '$D(^FHPT(FHDFN,"A",+ADM,"OO",+FHDR,0)) S TXT="Additional Order not on file." D CERR^FHWOR Q
S Y=^FHPT(FHDFN,"A",ADM,"OO",FHDR,0)
I +FHORN'=$P(Y,"^",8) S TXT="Order Number Not Matching." D CERR^FHWOR Q
D NOW^%DTC S $P(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0),"^",5,7)="X^"_%_"^"_DUZ
K ^FHPT("AOO",FHDFN,ADM,FHDR) S EVT="O^C^"_FHDR D ^FHORX K %,FHDR,Y
D CSEND^FHWOR Q
AO ; Code Additional Orders
K MSG S FILL="A"_";"_ADM_";"_FHDR_";"_COM
S SDT=NOW D SET
; Code MSH, PID, and PV1
D MSH^FHWOR
; code ORC
S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_SDT_"|||"_DUZ_"||"_DUZ_"|||"_NOW
; Code ODS
S MSG(5)="ODS|D||^^^FH-6^Additional Order^99OTH|"_COM
K FILL,FHWRD,HOSP,RM,SITE,SDT
Q
SET ; Set Date/Time in HL7 format
S:SDT SDT=$$FMTHL7^XLFDT(SDT)
S:NOW NOW=$$FMTHL7^XLFDT(NOW)
Q
NA ; OE/RR Number Assign
S FHDR=+$P(FILL,";",3) G:'FHDR KIL S:ADM'=$P(FILL,";",2) ADM=$P(FILL,";",2)
G:'+FHORN KIL
S $P(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0),"^",8)=+FHORN
KIL K FHDR,MSG,FHORN Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHWOR1 1409 printed Dec 13, 2024@01:55:21 Page 2
FHWOR1 ; HISC/REL/NCA - HL7 Additional Orders ;10/10/00 14:55
+1 ;;5.5;DIETETICS;;Jan 28, 2005
ADD ; Add new Order
+1 SET COM=$EXTRACT(COM,1,160)
DO ORD^FHORO
SET $PIECE(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0),"^",8)=+FHORN
+2 SET FILL="A"_";"_ADM_";"_FHDR_";"_COM
KILL COM,FHDR
+3 DO SEND^FHWOR
QUIT
CAN ; Process Cancel/Discontinue Order from OE/RR
+1 SET FHDR=+$PIECE(FILL,";",3)
IF 'FHDR
SET TXT="No Filler Number."
DO CERR^FHWOR
QUIT
+2 DO GADM^FHWORR
F0 IF '$DATA(^FHPT(FHDFN,"A",+ADM,"OO",+FHDR,0))
SET TXT="Additional Order not on file."
DO CERR^FHWOR
QUIT
+1 SET Y=^FHPT(FHDFN,"A",ADM,"OO",FHDR,0)
+2 IF +FHORN'=$PIECE(Y,"^",8)
SET TXT="Order Number Not Matching."
DO CERR^FHWOR
QUIT
+3 DO NOW^%DTC
SET $PIECE(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0),"^",5,7)="X^"_%_"^"_DUZ
+4 KILL ^FHPT("AOO",FHDFN,ADM,FHDR)
SET EVT="O^C^"_FHDR
DO ^FHORX
KILL %,FHDR,Y
+5 DO CSEND^FHWOR
QUIT
AO ; Code Additional Orders
+1 KILL MSG
SET FILL="A"_";"_ADM_";"_FHDR_";"_COM
+2 SET SDT=NOW
DO SET
+3 ; Code MSH, PID, and PV1
+4 DO MSH^FHWOR
+5 ; code ORC
+6 SET MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_SDT_"|||"_DUZ_"||"_DUZ_"|||"_NOW
+7 ; Code ODS
+8 SET MSG(5)="ODS|D||^^^FH-6^Additional Order^99OTH|"_COM
+9 KILL FILL,FHWRD,HOSP,RM,SITE,SDT
+10 QUIT
SET ; Set Date/Time in HL7 format
+1 if SDT
SET SDT=$$FMTHL7^XLFDT(SDT)
+2 if NOW
SET NOW=$$FMTHL7^XLFDT(NOW)
+3 QUIT
NA ; OE/RR Number Assign
+1 SET FHDR=+$PIECE(FILL,";",3)
if 'FHDR
GOTO KIL
if ADM'=$PIECE(FILL,";",2)
SET ADM=$PIECE(FILL,";",2)
+2 if '+FHORN
GOTO KIL
+3 SET $PIECE(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0),"^",8)=+FHORN
KIL KILL FHDR,MSG,FHORN
QUIT
