- 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 Feb 18, 2025@23:21:43 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