SCDXUTL0 ;ALB/ESD - Generic functions for Amb Care HL7 Interface ; 5/31/05 11:23am
;;5.3;PIMS;**44,55,69,77,85,110,122,94,66,132,180,235,256,258,325,451,441,1015,1016**;JUN 30, 2012;Build 20
;
; This routine contains functions used with the Ambulatory Care
; Reporting Project (ACRP).
;
MTI(DFN,DATE,EC,AT,SDOE) ;Calculate Means Test Indicator
;
; Input: DFN = Patient IEN
; Date = Encounter Date/Time
; EC = Eligibility (Code) of Encounter
; AT = Appointment Type of Encounter
; SDOE = Outpatient Encounter IEN
;
; Output: MTI = Means Test Indicator
;
N MT,MTI,SDVD1,SDINPT,SDANS,SDANS1,SDINPT,SDMT,VET,X
S MTI=""
S DFN=$G(DFN),DATE=$G(DATE),EC=$G(EC),AT=$G(AT),SDOE=$G(SDOE)
I (DFN="")!(DATE="")!(EC="")!(EC=0)!(AT="")!(SDOE="") G MTQ
;
;SD*562 check for other possible invalid Eligibility codes
I $L(EC)>2!(EC="-1") G MTQ
;
;- VA Code (get from MAS Eligibility Code IEN)
S X=$G(^DIC(8.1,$P($G(^DIC(8,+EC,0)),"^",9),0))
S EC=$P(X,"^",4),VET=$P(X,"^",5)
;- Non-Veteran
I $P($G(^DPT(DFN,"VET")),"^")="N"!(VET="N") S MTI="N" G MTQ
;- Dom patient
I EC=6 S MTI="X" G MTQ
;- Inpatient status
S SDVD1=DATE D INPT^SDOPC1 I SDMT="X0" S MTI="X" G MTQ
;- Service Connected > 50 %
I EC=1 S MTI="AS" G MTQ
;-- Service Connected < 50 %
I EC=3,$$SC^DGMTR(DFN) D I MTI'="" G MTQ
.; 'AS' if seen for SC condition
.I $P($G(^SDD(409.42,+$O(^SDD(409.42,"AO",+SDOE,3,0)),0)),U,3) S MTI="AS"
;-Military Disability Retiree
;S X=$P($G(^DPT(DFN,.36)),"^",2) I X,(X<3) S MTI="AS" G MTQ
;-Military Disability Retirement OR Discharge Due To Disability
I $P($G(^DPT(DFN,.36)),"^",12)!($P($G(^DPT(DFN,.36)),"^",13)) S MTI="AS" G MTQ
;
I EC=2 D I MTI'="" G MTQ
.;- Mexican Border Period or World War I
.I $P($G(^DIC(21,+$P($G(^DPT(DFN,.32)),"^",3),0)),"^",3)=1!($P($G(^DIC(21,+$P($G(^DPT(DFN,.32)),"^",3),0)),"^",3)=3) S MTI="AS" Q
.;- Prisoner of War (POW)
.I $P($G(^DPT(DFN,.52)),"^",5)="Y" S MTI="AS" Q
.;- Purple Heart Recipient
.I $P($G(^DPT(DFN,.53)),"^")="Y" S MTI="AS" Q
.;- Aid and Attendance
.I $P($G(^DPT(DFN,.362)),"^",12)="Y" S MTI="AN" Q
.;- Housebound
.I $P($G(^DPT(DFN,.362)),"^",13)="Y" S MTI="AN" Q
;- Receiving VA Pension
I EC=4,$P($G(^DPT(DFN,.362)),"^",14)="Y" S MTI="AN" G MTQ
;
I EC=5!(EC=3) D I MTI'="" G MTQ
.;- Eligible for Medicaid
.I $P($G(^DPT(DFN,.38)),"^")=1 S MTI="AN" Q
.;- Appt types with ignore billing set to 1 (except comp gen)
.I AT'=10,$P($G(^SD(409.1,+AT,0)),"^",2) S MTI="X" Q
.;- Treatment for AO, IR, EC, MST, HNC
.F SDANS1=1,2,4,5,6 S SDANS=$S('$D(^SDD(409.42,"AO",+SDOE,SDANS1)):"",$P($G(^SDD(409.42,$O(^(SDANS1,0)),0)),"^",3):1,1:0) I SDANS=1 S MTI="AS" Q
.I MTI]"" Q
.;- Means Test Code A, C, or G (also Pending Adj = Code C or Code G)
.S MT=$$LST^DGMTU(DFN,DATE)
.I $P(MT,"^",4)="A" S MTI="AN" Q
.I $P(MT,"^",4)="C" S MTI="C" Q
.I $P(MT,"^",4)="G" S MTI="G" Q
.I $P(MT,"^",4)="P" D Q
. .S MTI=$$PA^DGMTUTL($P(MT,"^")),MTI=$S('$D(MTI):"U",MTI="MT":"C",MTI="GMT":"G",1:"U")
.;- no means test status or no longer required...check current eligibility data
.S X=+$G(^DPT(DFN,.36)),X=+$P($G(^DIC(8,X,0)),U,9) ; get MAS eligibility
.;- Service connected > 50 %
.I X=1 S MTI="AS" Q
.;- Service connected < 50 %
.I EC=3,'$$SC^DGMTR(DFN) S MTI="AS" Q
.;- mex border or WWI or POW
.I X=16!(X=17)!(X=18)!(X=22) S MTI="AS" Q
.;- A&A or Pension or HB
.I X=2!(X=4)!(X=15) S MTI="AN" Q
;- Means Test required and not done/completed
S MTI="U"
MTQ Q MTI
;
;
PATCLASS(DFN,SDOE) ; - Return classification questions from PATIENT (#2) file
; (Agent Orange, Radiation Exposure, Service Connected,
; Environmental Contaminants, Military Sexual Trauma and
; Head/Neck Cancer questions)
;
; Input: DFN = Patient IEN (from file #2)
; SDOE = Outpatient Encounter File IEN [Optional]
;
; Output: String containing Y if classification question = YES, N if
; = NO, null otherwise (classifications separated by "^")
;
N NODE,PATCLASS,SDTEMP,X
S SDTEMP(1)=$$AO^SDCO22(DFN,$G(SDOE))
S SDTEMP(2)=$$IR^SDCO22(DFN,$G(SDOE))
S SDTEMP(3)=$$SC^SDCO22(DFN,$G(SDOE))
S SDTEMP(4)=$$EC^SDCO22(DFN,$G(SDOE))
S SDTEMP(5)=$$MST^SDCO22(DFN,$G(SDOE))
S SDTEMP(6)=$$HNC^SDCO22(DFN,$G(SDOE))
S SDTEMP(7)=$$CV^SDCO22(DFN,$G(SDOE))
S SDTEMP(8)=$$SHAD^SDCO22(DFN)
F X=1:1:8 S $P(PATCLASS,U,X)=$S(SDTEMP(X)=1:"Y",1:"N")
Q PATCLASS
;
;
CLASS(SDOE,SCDXARRY) ; - Return array of classification types for encounter
;
; Input: SDOE = Outpatient Encounter IEN (from file #409.68)
;
; Output: Array (pass desired name as parameter) containing
; Classification Type^Value
;
N CLASS,I,X
S CLASS="",(I,X)=0
S SDOE=+$G(SDOE)
F S CLASS=+$O(^SDD(409.42,"OE",SDOE,CLASS)) Q:'CLASS D
. S I=$P($G(^SDD(409.42,CLASS,0)),"^"),X=X+1
. S @SCDXARRY@(I)=$P($G(^SDD(409.42,CLASS,0)),"^")_"^"_$P($G(^SDD(409.42,CLASS,0)),"^",3)
CLASSQ S @SCDXARRY@(0)=X
Q
;
;
CHKCLASS(DFN,SDOE) ; - Get classification data for HL7 VAFHLZCL segment
;
; Input: DFN = Patient IEN (from file #2)
; SDOE = Outpatient Encounter IEN (from file #409.68)
;
; Output: String separated by "^" containing:
; 1 (patient class = YES and encounter class = YES)
; 0 (patient class = YES and encounter class = NO)
; HLQ ("""""") otherwise
;
EN N OECLASS,OUT,PATCLASS,TYPE,ENCVAL,CLCNT,PATVAL
S PATCLASS=$$PATCLASS(DFN,SDOE)
D CLASS(SDOE,"OECLASS")
S CLCNT=$L(PATCLASS,"^")
F TYPE=1:1:CLCNT D
.S ENCVAL=$P($G(OECLASS(TYPE)),"^",2)
.S PATVAL=$P(PATCLASS,"^",TYPE)
.S $P(OUT,"^",TYPE)=""""""
.I PATVAL="Y" S $P(OUT,"^",TYPE)=ENCVAL
ENQ Q OUT
;
;
POV(DFN,DATE,CLINIC,APTYP) ; - Determine Purpose of Visit for encounter
;
; Input: DFN = Patient IEN
; DATE = Appointment Date/Time
; CLINIC = Clinic
; APTYP = Appointment Type
;
; Output: Purpose of Visit value (combination of Purpose of Visit
; and Appointment Type)
;
N POV,SCDXPOV
I (DFN=""!(DATE="")!(CLINIC="")!(APTYP="")) G POVQ
I $P($G(^DPT(DFN,"S",+DATE,0)),"^")'=CLINIC G POVQ
S POV=$P($G(^DPT(DFN,"S",+DATE,0)),"^",7),POV=$S($L(POV)=1:"0"_POV,1:POV)
S APTYP=$S($L(APTYP)=1:"0"_APTYP,1:APTYP)
S SCDXPOV=POV_APTYP
POVQ Q $G(SCDXPOV)
;
;
SCODE(SDOE,SCDXARRY) ; Return array of stop codes for encounter
;
; Input: SDOE = Outpatient Encounter IEN (from file #409.68)
;
; Output: Array (pass desired name as parameter) containing
; stop codes
;
;
N CNT,I,SDOE0,SDOEC,SDOEC0
S CNT=1,(I,SDOEC)=0
S SDOE=+$G(SDOE)
I '$D(^SCE(SDOE,0)) G SCODEQ
I '$P($G(^SCE(SDOE,0)),"^",3) G SCODEQ
S SDOE0=$G(^SCE(SDOE,0))
;
;- Get stop code from parent encounter
I $P(SDOE0,"^",3) S @SCDXARRY@(CNT)=$P(SDOE0,"^",3),I=CNT
;
;- Get stop code from child encounter (credit stop)
F S SDOEC=+$O(^SCE("APAR",SDOE,SDOEC)) Q:('SDOEC)!(CNT=2) D
. S SDOEC0=$G(^SCE(SDOEC,0))
. I $P(SDOEC0,"^",3),($P(SDOEC0,"^",8)=4) D
.. S CNT=CNT+1,I=CNT
.. S @SCDXARRY@(CNT)=$P(SDOEC0,"^",3)
SCODEQ S @SCDXARRY@(0)=I
Q
;
;
PROC(SDOE,SCDXARRY) ; Return array of procedures for encounter
;
;
; Input: SDOE = Outpatient Encounter IEN (from file #409.68)
;
; Output: Array (pass desired name as parameter) containing
; procedures
;
N CNT
S CNT=0,SDOE=+$G(SDOE)
I '$D(^SCE(SDOE,0)) G PROCQ
;
D GETPROC(.CNT,SDOE,SCDXARRY) G PROCQ
;
;- Array of procedures
PROCQ S @SCDXARRY@(0)=CNT
Q
;
;
GETPROC(CNT,ENC,SCDXARRY) ;Get procedures from Scheduling Visits file
;
N CPTS,VCPT
D GETCPT^SDOE(ENC,"CPTS")
N CPT,QTY,I
S VCPT=0
F S VCPT=$O(CPTS(VCPT)) Q:'VCPT D
. S CPT=$G(CPTS(VCPT))
. S QTY=+$P(CPT,U,16)
. F I=1:1:QTY S CNT=CNT+1,@SCDXARRY@(CNT)=+CPT
Q
SCDXUTL0 ;ALB/ESD - Generic functions for Amb Care HL7 Interface ; 5/31/05 11:23am
+1 ;;5.3;PIMS;**44,55,69,77,85,110,122,94,66,132,180,235,256,258,325,451,441,1015,1016**;JUN 30, 2012;Build 20
+2 ;
+3 ; This routine contains functions used with the Ambulatory Care
+4 ; Reporting Project (ACRP).
+5 ;
MTI(DFN,DATE,EC,AT,SDOE) ;Calculate Means Test Indicator
+1 ;
+2 ; Input: DFN = Patient IEN
+3 ; Date = Encounter Date/Time
+4 ; EC = Eligibility (Code) of Encounter
+5 ; AT = Appointment Type of Encounter
+6 ; SDOE = Outpatient Encounter IEN
+7 ;
+8 ; Output: MTI = Means Test Indicator
+9 ;
+10 NEW MT,MTI,SDVD1,SDINPT,SDANS,SDANS1,SDINPT,SDMT,VET,X
+11 SET MTI=""
+12 SET DFN=$GET(DFN)
SET DATE=$GET(DATE)
SET EC=$GET(EC)
SET AT=$GET(AT)
SET SDOE=$GET(SDOE)
+13 IF (DFN="")!(DATE="")!(EC="")!(EC=0)!(AT="")!(SDOE="")
GOTO MTQ
+14 ;
+15 ;SD*562 check for other possible invalid Eligibility codes
+16 IF $LENGTH(EC)>2!(EC="-1")
GOTO MTQ
+17 ;
+18 ;- VA Code (get from MAS Eligibility Code IEN)
+19 SET X=$GET(^DIC(8.1,$PIECE($GET(^DIC(8,+EC,0)),"^",9),0))
+20 SET EC=$PIECE(X,"^",4)
SET VET=$PIECE(X,"^",5)
+21 ;- Non-Veteran
+22 IF $PIECE($GET(^DPT(DFN,"VET")),"^")="N"!(VET="N")
SET MTI="N"
GOTO MTQ
+23 ;- Dom patient
+24 IF EC=6
SET MTI="X"
GOTO MTQ
+25 ;- Inpatient status
+26 SET SDVD1=DATE
DO INPT^SDOPC1
IF SDMT="X0"
SET MTI="X"
GOTO MTQ
+27 ;- Service Connected > 50 %
+28 IF EC=1
SET MTI="AS"
GOTO MTQ
+29 ;-- Service Connected < 50 %
+30 IF EC=3
IF $$SC^DGMTR(DFN)
Begin DoDot:1
+31 ; 'AS' if seen for SC condition
+32 IF $PIECE($GET(^SDD(409.42,+$ORDER(^SDD(409.42,"AO",+SDOE,3,0)),0)),U,3)
SET MTI="AS"
End DoDot:1
IF MTI'=""
GOTO MTQ
+33 ;-Military Disability Retiree
+34 ;S X=$P($G(^DPT(DFN,.36)),"^",2) I X,(X<3) S MTI="AS" G MTQ
+35 ;-Military Disability Retirement OR Discharge Due To Disability
+36 IF $PIECE($GET(^DPT(DFN,.36)),"^",12)!($PIECE($GET(^DPT(DFN,.36)),"^",13))
SET MTI="AS"
GOTO MTQ
+37 ;
+38 IF EC=2
Begin DoDot:1
+39 ;- Mexican Border Period or World War I
+40 IF $PIECE($GET(^DIC(21,+$PIECE($GET(^DPT(DFN,.32)),"^",3),0)),"^",3)=1!($PIECE($GET(^DIC(21,+$PIECE($GET(^DPT(DFN,.32)),"^",3),0)),"^",3)=3)
SET MTI="AS"
QUIT
+41 ;- Prisoner of War (POW)
+42 IF $PIECE($GET(^DPT(DFN,.52)),"^",5)="Y"
SET MTI="AS"
QUIT
+43 ;- Purple Heart Recipient
+44 IF $PIECE($GET(^DPT(DFN,.53)),"^")="Y"
SET MTI="AS"
QUIT
+45 ;- Aid and Attendance
+46 IF $PIECE($GET(^DPT(DFN,.362)),"^",12)="Y"
SET MTI="AN"
QUIT
+47 ;- Housebound
+48 IF $PIECE($GET(^DPT(DFN,.362)),"^",13)="Y"
SET MTI="AN"
QUIT
End DoDot:1
IF MTI'=""
GOTO MTQ
+49 ;- Receiving VA Pension
+50 IF EC=4
IF $PIECE($GET(^DPT(DFN,.362)),"^",14)="Y"
SET MTI="AN"
GOTO MTQ
+51 ;
+52 IF EC=5!(EC=3)
Begin DoDot:1
+53 ;- Eligible for Medicaid
+54 IF $PIECE($GET(^DPT(DFN,.38)),"^")=1
SET MTI="AN"
QUIT
+55 ;- Appt types with ignore billing set to 1 (except comp gen)
+56 IF AT'=10
IF $PIECE($GET(^SD(409.1,+AT,0)),"^",2)
SET MTI="X"
QUIT
+57 ;- Treatment for AO, IR, EC, MST, HNC
+58 FOR SDANS1=1,2,4,5,6
SET SDANS=$SELECT('$DATA(^SDD(409.42,"AO",+SDOE,SDANS1)):"",$PIECE($GET(^SDD(409.42,$ORDER(^(SDANS1,0)),0)),"^",3):1,1:0)
IF SDANS=1
SET MTI="AS"
QUIT
+59 IF MTI]""
QUIT
+60 ;- Means Test Code A, C, or G (also Pending Adj = Code C or Code G)
+61 SET MT=$$LST^DGMTU(DFN,DATE)
+62 IF $PIECE(MT,"^",4)="A"
SET MTI="AN"
QUIT
+63 IF $PIECE(MT,"^",4)="C"
SET MTI="C"
QUIT
+64 IF $PIECE(MT,"^",4)="G"
SET MTI="G"
QUIT
+65 IF $PIECE(MT,"^",4)="P"
Begin DoDot:2
+66 SET MTI=$$PA^DGMTUTL($PIECE(MT,"^"))
SET MTI=$SELECT('$DATA(MTI):"U",MTI="MT":"C",MTI="GMT":"G",1:"U")
End DoDot:2
QUIT
+67 ;- no means test status or no longer required...check current eligibility data
+68 ; get MAS eligibility
SET X=+$GET(^DPT(DFN,.36))
SET X=+$PIECE($GET(^DIC(8,X,0)),U,9)
+69 ;- Service connected > 50 %
+70 IF X=1
SET MTI="AS"
QUIT
+71 ;- Service connected < 50 %
+72 IF EC=3
IF '$$SC^DGMTR(DFN)
SET MTI="AS"
QUIT
+73 ;- mex border or WWI or POW
+74 IF X=16!(X=17)!(X=18)!(X=22)
SET MTI="AS"
QUIT
+75 ;- A&A or Pension or HB
+76 IF X=2!(X=4)!(X=15)
SET MTI="AN"
QUIT
End DoDot:1
IF MTI'=""
GOTO MTQ
+77 ;- Means Test required and not done/completed
+78 SET MTI="U"
MTQ QUIT MTI
+1 ;
+2 ;
PATCLASS(DFN,SDOE) ; - Return classification questions from PATIENT (#2) file
+1 ; (Agent Orange, Radiation Exposure, Service Connected,
+2 ; Environmental Contaminants, Military Sexual Trauma and
+3 ; Head/Neck Cancer questions)
+4 ;
+5 ; Input: DFN = Patient IEN (from file #2)
+6 ; SDOE = Outpatient Encounter File IEN [Optional]
+7 ;
+8 ; Output: String containing Y if classification question = YES, N if
+9 ; = NO, null otherwise (classifications separated by "^")
+10 ;
+11 NEW NODE,PATCLASS,SDTEMP,X
+12 SET SDTEMP(1)=$$AO^SDCO22(DFN,$GET(SDOE))
+13 SET SDTEMP(2)=$$IR^SDCO22(DFN,$GET(SDOE))
+14 SET SDTEMP(3)=$$SC^SDCO22(DFN,$GET(SDOE))
+15 SET SDTEMP(4)=$$EC^SDCO22(DFN,$GET(SDOE))
+16 SET SDTEMP(5)=$$MST^SDCO22(DFN,$GET(SDOE))
+17 SET SDTEMP(6)=$$HNC^SDCO22(DFN,$GET(SDOE))
+18 SET SDTEMP(7)=$$CV^SDCO22(DFN,$GET(SDOE))
+19 SET SDTEMP(8)=$$SHAD^SDCO22(DFN)
+20 FOR X=1:1:8
SET $PIECE(PATCLASS,U,X)=$SELECT(SDTEMP(X)=1:"Y",1:"N")
+21 QUIT PATCLASS
+22 ;
+23 ;
CLASS(SDOE,SCDXARRY) ; - Return array of classification types for encounter
+1 ;
+2 ; Input: SDOE = Outpatient Encounter IEN (from file #409.68)
+3 ;
+4 ; Output: Array (pass desired name as parameter) containing
+5 ; Classification Type^Value
+6 ;
+7 NEW CLASS,I,X
+8 SET CLASS=""
SET (I,X)=0
+9 SET SDOE=+$GET(SDOE)
+10 FOR
SET CLASS=+$ORDER(^SDD(409.42,"OE",SDOE,CLASS))
IF 'CLASS
QUIT
Begin DoDot:1
+11 SET I=$PIECE($GET(^SDD(409.42,CLASS,0)),"^")
SET X=X+1
+12 SET @SCDXARRY@(I)=$PIECE($GET(^SDD(409.42,CLASS,0)),"^")_"^"_$PIECE($GET(^SDD(409.42,CLASS,0)),"^",3)
End DoDot:1
CLASSQ SET @SCDXARRY@(0)=X
+1 QUIT
+2 ;
+3 ;
CHKCLASS(DFN,SDOE) ; - Get classification data for HL7 VAFHLZCL segment
+1 ;
+2 ; Input: DFN = Patient IEN (from file #2)
+3 ; SDOE = Outpatient Encounter IEN (from file #409.68)
+4 ;
+5 ; Output: String separated by "^" containing:
+6 ; 1 (patient class = YES and encounter class = YES)
+7 ; 0 (patient class = YES and encounter class = NO)
+8 ; HLQ ("""""") otherwise
+9 ;
EN NEW OECLASS,OUT,PATCLASS,TYPE,ENCVAL,CLCNT,PATVAL
+1 SET PATCLASS=$$PATCLASS(DFN,SDOE)
+2 DO CLASS(SDOE,"OECLASS")
+3 SET CLCNT=$LENGTH(PATCLASS,"^")
+4 FOR TYPE=1:1:CLCNT
Begin DoDot:1
+5 SET ENCVAL=$PIECE($GET(OECLASS(TYPE)),"^",2)
+6 SET PATVAL=$PIECE(PATCLASS,"^",TYPE)
+7 SET $PIECE(OUT,"^",TYPE)=""""""
+8 IF PATVAL="Y"
SET $PIECE(OUT,"^",TYPE)=ENCVAL
End DoDot:1
ENQ QUIT OUT
+1 ;
+2 ;
POV(DFN,DATE,CLINIC,APTYP) ; - Determine Purpose of Visit for encounter
+1 ;
+2 ; Input: DFN = Patient IEN
+3 ; DATE = Appointment Date/Time
+4 ; CLINIC = Clinic
+5 ; APTYP = Appointment Type
+6 ;
+7 ; Output: Purpose of Visit value (combination of Purpose of Visit
+8 ; and Appointment Type)
+9 ;
+10 NEW POV,SCDXPOV
+11 IF (DFN=""!(DATE="")!(CLINIC="")!(APTYP=""))
GOTO POVQ
+12 IF $PIECE($GET(^DPT(DFN,"S",+DATE,0)),"^")'=CLINIC
GOTO POVQ
+13 SET POV=$PIECE($GET(^DPT(DFN,"S",+DATE,0)),"^",7)
SET POV=$SELECT($LENGTH(POV)=1:"0"_POV,1:POV)
+14 SET APTYP=$SELECT($LENGTH(APTYP)=1:"0"_APTYP,1:APTYP)
+15 SET SCDXPOV=POV_APTYP
POVQ QUIT $GET(SCDXPOV)
+1 ;
+2 ;
SCODE(SDOE,SCDXARRY) ; Return array of stop codes for encounter
+1 ;
+2 ; Input: SDOE = Outpatient Encounter IEN (from file #409.68)
+3 ;
+4 ; Output: Array (pass desired name as parameter) containing
+5 ; stop codes
+6 ;
+7 ;
+8 NEW CNT,I,SDOE0,SDOEC,SDOEC0
+9 SET CNT=1
SET (I,SDOEC)=0
+10 SET SDOE=+$GET(SDOE)
+11 IF '$DATA(^SCE(SDOE,0))
GOTO SCODEQ
+12 IF '$PIECE($GET(^SCE(SDOE,0)),"^",3)
GOTO SCODEQ
+13 SET SDOE0=$GET(^SCE(SDOE,0))
+14 ;
+15 ;- Get stop code from parent encounter
+16 IF $PIECE(SDOE0,"^",3)
SET @SCDXARRY@(CNT)=$PIECE(SDOE0,"^",3)
SET I=CNT
+17 ;
+18 ;- Get stop code from child encounter (credit stop)
+19 FOR
SET SDOEC=+$ORDER(^SCE("APAR",SDOE,SDOEC))
IF ('SDOEC)!(CNT=2)
QUIT
Begin DoDot:1
+20 SET SDOEC0=$GET(^SCE(SDOEC,0))
+21 IF $PIECE(SDOEC0,"^",3)
IF ($PIECE(SDOEC0,"^",8)=4)
Begin DoDot:2
+22 SET CNT=CNT+1
SET I=CNT
+23 SET @SCDXARRY@(CNT)=$PIECE(SDOEC0,"^",3)
End DoDot:2
End DoDot:1
SCODEQ SET @SCDXARRY@(0)=I
+1 QUIT
+2 ;
+3 ;
PROC(SDOE,SCDXARRY) ; Return array of procedures for encounter
+1 ;
+2 ;
+3 ; Input: SDOE = Outpatient Encounter IEN (from file #409.68)
+4 ;
+5 ; Output: Array (pass desired name as parameter) containing
+6 ; procedures
+7 ;
+8 NEW CNT
+9 SET CNT=0
SET SDOE=+$GET(SDOE)
+10 IF '$DATA(^SCE(SDOE,0))
GOTO PROCQ
+11 ;
+12 DO GETPROC(.CNT,SDOE,SCDXARRY)
GOTO PROCQ
+13 ;
+14 ;- Array of procedures
PROCQ SET @SCDXARRY@(0)=CNT
+1 QUIT
+2 ;
+3 ;
GETPROC(CNT,ENC,SCDXARRY) ;Get procedures from Scheduling Visits file
+1 ;
+2 NEW CPTS,VCPT
+3 DO GETCPT^SDOE(ENC,"CPTS")
+4 NEW CPT,QTY,I
+5 SET VCPT=0
+6 FOR
SET VCPT=$ORDER(CPTS(VCPT))
IF 'VCPT
QUIT
Begin DoDot:1
+7 SET CPT=$GET(CPTS(VCPT))
+8 SET QTY=+$PIECE(CPT,U,16)
+9 FOR I=1:1:QTY
SET CNT=CNT+1
SET @SCDXARRY@(CNT)=+CPT
End DoDot:1
+10 QUIT
