SRCHL7U ;BIR/SJA - Receive HL-7 Surgery Request Consults Message (continued) ;12/27/04  11:41 AM
 ;;3.0; Surgery ;**144**;24 Jun 93
 ;
 Q
PID(SRCPID) ;Get fields from PID segment.
 S SRDFN=$P(SRCPID,"|",4),SRCPNM=$P(SRCPID,"|",6)
 Q
REJECT ;can't be filed send reject message
 ;send message to mail group SR CONSULT
 S DFN=SRDFN D DEM^VADPT
 K XMY S XMDUZ="SURGERY PACKAGE" D NOW^%DTC S Y=% X ^DD("DD")
 S SRM(1)="The Surgery Request Consult could not be processed for pre-certification."
 S SRM(2)=""
 S SRM(3)="Patient: "_$E(VADM(1),1,20)
 S SRM(4)="Date of Operation: "_SRDOP
 S SRM(5)="Surgeon ID: "_SRCPV1(17)
 S SRM(6)="Attending Surgeon ID: "_SRCPV1(7)
 S SRM(7)="Surgical Specialty: "_SRCSURG(2)
 S SRM(8)="Principal Pre-Op Diagnosis: "_SRCDG1(1,4)
 S SRM(9)="Principal Operative Procedure: "_SRCPR1(4)
 S XMTEXT="SRM(",XMSUB="Surgery Consult Error Log"
 S XMY("G.SR CONSULT")=""
 D ^XMD K XMTEXT,XMY,XMSUB,SRM
EXIT ;Kill variables and exit
 K Y,SRDOP,SRCZSS,SRCTRLC,SRCSURG,SRCSTDT,SRCSST,SRCSS,SRCSEND
 K SRX,SRCRF,SRCRFL,SRCRB,SRCRATSN,SRCQT,SRCPV2,SRCPR1,SRCPNM,SRCOTXT
 K SRCORNP,SRCOID,SRCODT,SRCOCR,SRCOBX,SRCOBR,SRCNOD,SRCMSG,SRCINTR,SRCDIV
 K SRCDG1,SRCATN,SRCARFN,SRC99C,SRDFN,LN
 Q
FMDATE(DATE) ;Convert HL-7 formatted date to a Fileman formatted date
 N X S X=$$HL7TFM^XLFDT(DATE)
 Q X
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRCHL7U   1338     printed  Sep 23, 2025@20:15:30                                                                                                                                                                                                     Page 2
SRCHL7U   ;BIR/SJA - Receive HL-7 Surgery Request Consults Message (continued) ;12/27/04  11:41 AM
 +1       ;;3.0; Surgery ;**144**;24 Jun 93
 +2       ;
 +3        QUIT 
PID(SRCPID) ;Get fields from PID segment.
 +1        SET SRDFN=$PIECE(SRCPID,"|",4)
           SET SRCPNM=$PIECE(SRCPID,"|",6)
 +2        QUIT 
REJECT    ;can't be filed send reject message
 +1       ;send message to mail group SR CONSULT
 +2        SET DFN=SRDFN
           DO DEM^VADPT
 +3        KILL XMY
           SET XMDUZ="SURGERY PACKAGE"
           DO NOW^%DTC
           SET Y=%
           XECUTE ^DD("DD")
 +4        SET SRM(1)="The Surgery Request Consult could not be processed for pre-certification."
 +5        SET SRM(2)=""
 +6        SET SRM(3)="Patient: "_$EXTRACT(VADM(1),1,20)
 +7        SET SRM(4)="Date of Operation: "_SRDOP
 +8        SET SRM(5)="Surgeon ID: "_SRCPV1(17)
 +9        SET SRM(6)="Attending Surgeon ID: "_SRCPV1(7)
 +10       SET SRM(7)="Surgical Specialty: "_SRCSURG(2)
 +11       SET SRM(8)="Principal Pre-Op Diagnosis: "_SRCDG1(1,4)
 +12       SET SRM(9)="Principal Operative Procedure: "_SRCPR1(4)
 +13       SET XMTEXT="SRM("
           SET XMSUB="Surgery Consult Error Log"
 +14       SET XMY("G.SR CONSULT")=""
 +15       DO ^XMD
           KILL XMTEXT,XMY,XMSUB,SRM
EXIT      ;Kill variables and exit
 +1        KILL Y,SRDOP,SRCZSS,SRCTRLC,SRCSURG,SRCSTDT,SRCSST,SRCSS,SRCSEND
 +2        KILL SRX,SRCRF,SRCRFL,SRCRB,SRCRATSN,SRCQT,SRCPV2,SRCPR1,SRCPNM,SRCOTXT
 +3        KILL SRCORNP,SRCOID,SRCODT,SRCOCR,SRCOBX,SRCOBR,SRCNOD,SRCMSG,SRCINTR,SRCDIV
 +4        KILL SRCDG1,SRCATN,SRCARFN,SRC99C,SRDFN,LN
 +5        QUIT 
FMDATE(DATE) ;Convert HL-7 formatted date to a Fileman formatted date
 +1        NEW X
           SET X=$$HL7TFM^XLFDT(DATE)
 +2        QUIT X