SDRPA20 ;BPOI/ESW - Determine Admission Type for PAIT ;
;;5.3;Scheduling;**446,539**;Aug 13, 1993;Build 24
;
; This routine returns element Admission Type for appointment sent
; with PAIT - see TABLE SD009 - Purpose of Visit & Appointment Type
; SEQUENCE PV1.4. The same table is used with ACRP HL7 transmission.
;
;
POV(DFN,SDATE,CLINIC,CRDATE) ; - Determine Purpose of Visit for encounter
;
; Input: DFN = Patient IEN
; SDATE = Appointment Date/Time
; CLINIC = Clinic
; CRDATE = Creation date
;
; Identified from the Outpatient Encounter or the Appointment
; subfile (# 2.98)
;
; APTYP = Appointment Type
;
; Output: Purpose of Visit value (combination of Purpose of Visit
; and Appointment Type)
;
;
N SDARRAY,SCDXPOV,SDAPPT,POV,APTYP,SDENC
S SDARRAY(1)=SDATE_";"_SDATE
S SDARRAY(4)=DFN
S SDARRAY("FLDS")="2;10;12;16;18"
; fields: 2- clinic
; 10- appointment type
; 12- outpatient encounter
; 16 - date appt made
N SDCOUNT S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
I '$D(^TMP($J,"SDAMA301",DFN,CLINIC,SDATE)) Q $G(SCDXPOV)
S SDAPPT=^TMP($J,"SDAMA301",DFN,CLINIC,SDATE)
N SDCRC S SDCRC=+$P(SDAPPT,U,16) I SDCRC'=CRDATE Q $G(SCDXPOV)
N POV,SCDXPOV
S POV=+$P(SDAPPT,U,18),POV=$S($L(POV)=1:"0"_POV,1:POV)
S APTYP=+$P(SDAPPT,U,10) S SDENC=+$P(SDAPPT,U,12) D I 'APTYP Q $G(SCDXPOV)
.I +SDENC>0 S APTYP=$P($G(^SCE(SDENC,0)),U,10) ;
S APTYP=$S($L(APTYP)=1:"0"_APTYP,1:APTYP)
S SCDXPOV=POV_APTYP
POVQ Q $G(SCDXPOV)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDRPA20 1581 printed Nov 22, 2024@18:10:20 Page 2
SDRPA20 ;BPOI/ESW - Determine Admission Type for PAIT ;
+1 ;;5.3;Scheduling;**446,539**;Aug 13, 1993;Build 24
+2 ;
+3 ; This routine returns element Admission Type for appointment sent
+4 ; with PAIT - see TABLE SD009 - Purpose of Visit & Appointment Type
+5 ; SEQUENCE PV1.4. The same table is used with ACRP HL7 transmission.
+6 ;
+7 ;
POV(DFN,SDATE,CLINIC,CRDATE) ; - Determine Purpose of Visit for encounter
+1 ;
+2 ; Input: DFN = Patient IEN
+3 ; SDATE = Appointment Date/Time
+4 ; CLINIC = Clinic
+5 ; CRDATE = Creation date
+6 ;
+7 ; Identified from the Outpatient Encounter or the Appointment
+8 ; subfile (# 2.98)
+9 ;
+10 ; APTYP = Appointment Type
+11 ;
+12 ; Output: Purpose of Visit value (combination of Purpose of Visit
+13 ; and Appointment Type)
+14 ;
+15 ;
+16 NEW SDARRAY,SCDXPOV,SDAPPT,POV,APTYP,SDENC
+17 SET SDARRAY(1)=SDATE_";"_SDATE
+18 SET SDARRAY(4)=DFN
+19 SET SDARRAY("FLDS")="2;10;12;16;18"
+20 ; fields: 2- clinic
+21 ; 10- appointment type
+22 ; 12- outpatient encounter
+23 ; 16 - date appt made
+24 NEW SDCOUNT
SET SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
+25 IF '$DATA(^TMP($JOB,"SDAMA301",DFN,CLINIC,SDATE))
QUIT $GET(SCDXPOV)
+26 SET SDAPPT=^TMP($JOB,"SDAMA301",DFN,CLINIC,SDATE)
+27 NEW SDCRC
SET SDCRC=+$PIECE(SDAPPT,U,16)
IF SDCRC'=CRDATE
QUIT $GET(SCDXPOV)
+28 NEW POV,SCDXPOV
+29 SET POV=+$PIECE(SDAPPT,U,18)
SET POV=$SELECT($LENGTH(POV)=1:"0"_POV,1:POV)
+30 SET APTYP=+$PIECE(SDAPPT,U,10)
SET SDENC=+$PIECE(SDAPPT,U,12)
Begin DoDot:1
+31 ;
IF +SDENC>0
SET APTYP=$PIECE($GET(^SCE(SDENC,0)),U,10)
End DoDot:1
IF 'APTYP
QUIT $GET(SCDXPOV)
+32 SET APTYP=$SELECT($LENGTH(APTYP)=1:"0"_APTYP,1:APTYP)
+33 SET SCDXPOV=POV_APTYP
POVQ QUIT $GET(SCDXPOV)
+1 ;
