SDVWHLI3 ;ENHANCED HL7 RECEIVE APPLICATION DRIVER (CONTINUED)  FOR SDAPI and MAKE AN APPOINTMENT API 11/18/06
 ;;5.3;Scheduling;**502**;Aug 13, 1993  ;Build 14
 ; Copyright (C) 2007 WorldVistA
 ;
 ; This program is free software; you can redistribute it and/or modify
 ; it under the terms of the GNU General Public License as published by
 ; the Free Software Foundation; either version 2 of the License, or
 ; (at your option) any later version.
 ;
 ; This program is distributed in the hope that it will be useful,
 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ; GNU General Public License for more details.
 ;
 ; You should have received a copy of the GNU General Public License
 ; along with this program; if not, write to the Free Software
 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
 ;
CYCLE(SDDFN,SDCLIEN,SDDATE,SDAPPT,ERETURN) ;PID,PV1,PV2,NTE,NTE
 N SDFNNAME,SDFNSSN,TEMP,OUTIN,SDLOCATE
 ;;;N EXTRET,ERROR2,LOCACKCD,ACKCDER,TEMP8,SEG
 ;;;N ERR,ERROR3,HLMSTATE,WHO,APPARMS,XQ,RETURN1 ; NEW ONES SO CANNOT USE OLD HLMSTATE TO RETURN REAL ACK
 I IJCOUNT#2=0 G OVER8  ; EVERY OTHER (EVEN) APPOINTMENT IN SAME  MESSAGE NOT REPEAT INITIALIZATION
 S EXTRET=0
 ;S SEG=""
 S ERROR2=""
 S XQ=""
 ;
 ;
 ; SEND ACK MESSAGE COMMENTED OUT BELOW. INSTEAD JUST SEND NORMAL MESSAGE WITH ADDED SEGMENTS
 ;
 ;;;;S APPARMS("ACK CODE")="AA"
 ;;;;S APPARMS("ACCEPT ACK TYPE")="NE"
 ;;;;I (ERROR'="")!(SDCOUNT<0) D
 ;;;;.S APPARMS("ACK CODE")="AE"
 ;;;.S APPARMS("ERROR MESSAGE")=ERROR_"^"_SDCOUNT
 ;;;;S APPARMS("MESSAGE TYPE")="ACK"
 ;;;;;S APPARMS("EVENT")="A19"
 ;;
 ;;
 S APPARMS("MESSAGE TYPE")="ADT"
 S APPARMS("EVENT")="A19" ; RESPONSE
 S APPARMS("COUNTRY")="USA"
 S APPARMS("FIELD SEPARATOR")="|"
 S APPARMS("ENCODING CHARACTERS")="^~\&"
 S APPARMS("VERSION")=2.4
 ;
 ;
 S APPARMS("SECURITY")=MSGCTRL
 ;
 S ERR=""
 S ERROR3=""
 S ERROR1=""
 ;
 ;
 I '$$NEWMSG^HLOAPI(.APPARMS,.HLMSTATE,.ERROR3) S ERETURN="NEW MESSAGE ERROR"
 ;
 I (ERETURN'=0)!(ERROR'="")!(SDCOUNT<0)!(ERROR1'="")!(IER'=1) S EXTRET=$$ERRORW^SDVWHLI1(XQ)
 ;
 D
 .D SET^HLOAPI(.SEG,"QRD",0)
 .D SET^HLOAPI(.SEG,$$HLDATE^HLFNC($$NOW^XLFDT(),"TS"),1)
 .D SET^HLOAPI(.SEG,ORDRSORT,8)
 .;I (ERROR="")&(SDCOUNT'="") D SET^HLOAPI(.SEG,SDCOUNT,11)
 .D SET^HLOAPI(.SEG,SDCOUNT,11)
 .;
 .;
 .;
 .;; ADD SEGMENT
 .I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERR="QRD"
 .I $D(ERROR2) D
 ..;
 .E  D
 ..;
 ;;CREATE SEGMENT PID
 ; PUT IN INTERNAL PATIENTID, NAME AND SSN 
 ;
 ;
OVER8 ;
 D SET^HLOAPI(.SEG,"PID",0)
 D SET^HLOAPI(.SEG,SDDFN,3)
 S SDFNNAME=$P($G(^DPT(SDDFN,0)),"^",1)
 D SET^HLOAPI(.SEG,SDFNNAME,5)
 S SDFNSSN=$P($G(^DPT(SDDFN,0)),"^",9)
 D SET^HLOAPI(.SEG,SDFNSSN,19)
 ;
 ;; ADD SEGMENT
 I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERETURN="PID"
 ;
 ;NEXT PV1 SEGMENT
 ;
 ;CREATE SEGMENT PV1
 ;
 ;
 D SET^HLOAPI(.SEG,"PV1",0)
 ; IF NOT ADMITTED THEN OUTPATIENT
 S OUTIN="O"
 D SET^HLOAPI(.SEG,OUTIN,2) ;PATIENT CLASS
 D SET^HLOAPI(.SEG,SDCLIEN,3) ;HOSP LOCATION IEN
 S TEMP=$P(SDAPPT,"^",18)
 S TEMP=$P(TEMP,";",1)
 D SET^HLOAPI(.SEG,TEMP,10) ;HOSPITAL SERVICE > PURPOSE OF VISIT(IEN)
 S TEMP=$P(SDAPPT,"^",13)
 S TEMP=$P(TEMP,";",1)
 D SET^HLOAPI(.SEG,TEMP,18) ; PATIENT TYPE > PRIMARY STOP CODE IEN
 S TEMP=$P(SDAPPT,"^",14)
 S TEMP=$P(TEMP,";",1)
 D SET^HLOAPI(.SEG,TEMP,41) ; PATIENT TYPE > CREDIT STOP CODE IEN
 D SET^HLOAPI(.SEG,$$HLDATE^HLFNC(SDDATE,"TS"),44) ; APPOINTMENT/UNSCHEDULED VISIT DATE
 ;
 ;
 ;
 ;; ADD SEGMENT
 I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERETURN="PV1"
 ;
 ;NEXT PV2 SEGMENT
 ;
 ;CREATE SEGMENT PV2
 ;
 ;
 D SET^HLOAPI(.SEG,"PV2",0)
 ; GET PURPOSE OF VISIT AGAIN
 ;IF UNSCHEDULED VISIT SET ELIGIBILITY IN PV2-7
 S TEMP=$P(SDAPPT,"^",18)
 S TEMP=$P(TEMP,";",1)
 I TEMP=4 D
 .S TEMP=$P(SDAPPT,"^",8)
 .S TEMP=$P(TEMP,";",1)
 .D SET^HLOAPI(.SEG,OUTIN,7) ;ELIGIBILITY
 D SET^HLOAPI(.SEG,$$HLDATE^HLFNC(SDDATE,"TS"),8) ; DESIRED EXPECTED APPOINTMENT/UNSCHEDULED VISIT DATE
 S TEMP=$P(SDAPPT,"^",3)
 D SET^HLOAPI(.SEG,TEMP,24) ;APPOINTMENT/UNSCHEDULED VISIT STATUS
 S TEMP=$P(SDAPPT,"^",16)
 D SET^HLOAPI(.SEG,$$HLDATE^HLFNC(TEMP,"TS"),46) ; DATE APPOINTMENT/UNSCHEDULED VISIT ACTUALLY MADE
 ;
 ;
 ;
 ;; ADD SEGMENT
 I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERETURN="PV2"
 ;
 ;NEXT NTE SEGMENT FOR EXTERNAL LOCATION NAME
 ;
 ;CREATE SEGMENT NTE
 ;
 ;
 ;
 D SET^HLOAPI(.SEG,"NTE",0)
 S SDLOCATE=$P($G(^SC(SDCLIEN,0)),"^",1)
 D SET^HLOAPI(.SEG,"SDLOCATE="_""""_SDLOCATE_"""",3)
 ;
 ;;
 ;
 ;; ADD SEGMENT
 I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERETURN="NTE"_SDLOCATE
 ;
 ;NEXT NTE SEGMENT FOR SDAPPT 
 ;
 ;CREATE SEGMENT NTE
 ;
 ;FIRST CONVERT ALL FM DATE/TIMES TO EXTERNAL FORMAT
 ;
 ; FIELDS 1,9,11,16,17,19,20,21,24,25
 S DATETIM=$P(SDAPPT,"^",1)
 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",1)=Y
 S DATETIM=$P(SDAPPT,"^",9)
 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",9)=Y
 S DATETIM=$P(SDAPPT,"^",11)
 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",11)=Y
 S DATETIM=$P(SDAPPT,"^",16)
 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",16)=Y
 S DATETIM=$P(SDAPPT,"^",17)
 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",17)=Y
 S DATETIM=$P(SDAPPT,"^",19)
 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",19)=Y
 S DATETIM=$P(SDAPPT,"^",20)
 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",20)=Y
 S DATETIM=$P(SDAPPT,"^",21)
 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",21)=Y
 S DATETIM=$P(SDAPPT,"^",124)
 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",24)=Y
 S DATETIM=$P(SDAPPT,"^",25)
 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",25)=Y
 ;
 ;
 D SET^HLOAPI(.SEG,"NTE",0)
 ;TAKE OUT "^" AND REPLACE WITH "#" AS "^" IN NOT A CHARACTER
 ;THAT CAN BE USED IN HL7 DATA PART OF SEGMENT
 S TEMP8=SDAPPT
 D REPLACE(.TEMP8)
 S SDAPPT=TEMP8
 D SET^HLOAPI(.SEG,SDAPPT,3)
 ;
 ;; ADD SEGMENT
 I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERETURN="NTE"_SDAPPT
 ;
 ;SKIP MESSAGE IF ODD IJCOUNT AND ICOUNT'=SDCOUNT
 I (IJCOUNT#2'=0)&(IJCOUNT'=SDCOUNT) Q
 ; DEFINE SENDING AND RECEIVING PARAMETERS
    S APPARMS("SENDING APPLICATION")="VWSD RECEIVER"
 S APPARMS("ACCEPT ACK TYPE")="NE" ;"AL"
 ;S APPARMS("APP ACK RESPONSE")="APPACKRR^SDVWHLIN"
 ;S APPARMS("ACCEPT ACK RESPONSE")="MSGPROC^SDVWHLIN"
 ;REVERSE BELOW 
 S APPARMS("ACCEPT ACK RESPONSE")="APPACKRR^SDVWHLIN" ; WHEN COMIT ACK , SU OR AE RETURN MADE
 S APPARMS("APP ACK RESPONSE")="MSGPROC^SDVWHLIN" ; WHEN NO ACK RETURN MADE 
 S APPARMS("APP ACK TYPE")="NE" ;"AL"
 S WHO("RECEIVING APPLICATION")="VWSD HLO EXT"
 S WHO("FACILITY LINK NAME")="VWSD_PEASL"
 ;
 ;SEND MESSAGE
 ;
 S ERROR3=""
 S RETURN1=$$SENDONE^HLOAPI1(.HLMSTATE,.APPARMS,.WHO,.ERROR3)
 ;;;;;I '$$SENDONE^HLOAPI1(.HLMSTATE,.APPARMS,.WHO,.ERROR3) Q ;Q "ERR="_ERR_" ERROR="_ERROR
 ;;
 I IJCOUNT'=SDCOUNT H 5
 ;
 ;
 Q
REPLACE(TEMP8) ;
 N REST,LEN8,L8,PIEC8
 S REST=TEMP8
 S LEN8=$L(TEMP8)
 F  Q:REST=""  D
 .S PIEC8=$P(TEMP8,"^",1)
 .S L8=$L(PIEC8)+2
 .I L8>LEN8 D
 ..S REST="" I $E(TEMP8,LEN8,LEN8)="^" S $E(TEMP8,LEN8,LEN8)="#"
 .E  D
 ..S REST=$E(TEMP8,L8,LEN8)
 .I (PIEC8'="")&(REST'="") D
 ..S TEMP8=PIEC8_"#"_REST
 Q