- SCDXUTL0 ;ALB/ESD - Generic functions for Amb Care HL7 Interface ; 5/31/05 11:23am
- ;;5.3;Scheduling;**44,55,69,77,85,110,122,94,66,132,180,235,256,258,325,451,441,562,585**;Aug 13, 1993;Build 19
- ;
- ; This routine contains functions used with the Ambulatory Care
- ; Reporting Project (ACRP).
- ;
- ;ICR Agreements:
- ;
- ;ICR - 3481 for reference to $$SC^DGMTR
- ;ICR - 2463 for reference to $$LST^DGMTU
- ;ICR - 3637 for reference to $$PA^DGMTUTL
- ;
- ;
- 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
- I '$D(^DIC(8,+EC,0)) Q MTI ;SD*585
- ;
- ;- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCDXUTL0 8087 printed Feb 19, 2025@00:06:06 Page 2
- SCDXUTL0 ;ALB/ESD - Generic functions for Amb Care HL7 Interface ; 5/31/05 11:23am
- +1 ;;5.3;Scheduling;**44,55,69,77,85,110,122,94,66,132,180,235,256,258,325,451,441,562,585**;Aug 13, 1993;Build 19
- +2 ;
- +3 ; This routine contains functions used with the Ambulatory Care
- +4 ; Reporting Project (ACRP).
- +5 ;
- +6 ;ICR Agreements:
- +7 ;
- +8 ;ICR - 3481 for reference to $$SC^DGMTR
- +9 ;ICR - 2463 for reference to $$LST^DGMTU
- +10 ;ICR - 3637 for reference to $$PA^DGMTUTL
- +11 ;
- +12 ;
- 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 ;SD*585
- IF '$DATA(^DIC(8,+EC,0))
- QUIT MTI
- +15 ;
- +16 ;- VA Code (get from MAS Eligibility Code IEN)
- +17 SET X=$GET(^DIC(8.1,$PIECE($GET(^DIC(8,+EC,0)),"^",9),0))
- +18 SET EC=$PIECE(X,"^",4)
- SET VET=$PIECE(X,"^",5)
- +19 ;- Non-Veteran
- +20 IF $PIECE($GET(^DPT(DFN,"VET")),"^")="N"!(VET="N")
- SET MTI="N"
- GOTO MTQ
- +21 ;- Dom patient
- +22 IF EC=6
- SET MTI="X"
- GOTO MTQ
- +23 ;- Inpatient status
- +24 SET SDVD1=DATE
- DO INPT^SDOPC1
- IF SDMT="X0"
- SET MTI="X"
- GOTO MTQ
- +25 ;- Service Connected > 50 %
- +26 IF EC=1
- SET MTI="AS"
- GOTO MTQ
- +27 ;-- Service Connected < 50 %
- +28 IF EC=3
- IF $$SC^DGMTR(DFN)
- Begin DoDot:1
- +29 ; 'AS' if seen for SC condition
- +30 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
- +31 ;-Military Disability Retiree
- +32 ;S X=$P($G(^DPT(DFN,.36)),"^",2) I X,(X<3) S MTI="AS" G MTQ
- +33 ;-Military Disability Retirement OR Discharge Due To Disability
- +34 IF $PIECE($GET(^DPT(DFN,.36)),"^",12)!($PIECE($GET(^DPT(DFN,.36)),"^",13))
- SET MTI="AS"
- GOTO MTQ
- +35 ;
- +36 IF EC=2
- Begin DoDot:1
- +37 ;- Mexican Border Period or World War I
- +38 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
- +39 ;- Prisoner of War (POW)
- +40 IF $PIECE($GET(^DPT(DFN,.52)),"^",5)="Y"
- SET MTI="AS"
- QUIT
- +41 ;- Purple Heart Recipient
- +42 IF $PIECE($GET(^DPT(DFN,.53)),"^")="Y"
- SET MTI="AS"
- QUIT
- +43 ;- Aid and Attendance
- +44 IF $PIECE($GET(^DPT(DFN,.362)),"^",12)="Y"
- SET MTI="AN"
- QUIT
- +45 ;- Housebound
- +46 IF $PIECE($GET(^DPT(DFN,.362)),"^",13)="Y"
- SET MTI="AN"
- QUIT
- End DoDot:1
- IF MTI'=""
- GOTO MTQ
- +47 ;- Receiving VA Pension
- +48 IF EC=4
- IF $PIECE($GET(^DPT(DFN,.362)),"^",14)="Y"
- SET MTI="AN"
- GOTO MTQ
- +49 ;
- +50 IF EC=5!(EC=3)
- Begin DoDot:1
- +51 ;- Eligible for Medicaid
- +52 IF $PIECE($GET(^DPT(DFN,.38)),"^")=1
- SET MTI="AN"
- QUIT
- +53 ;- Appt types with ignore billing set to 1 (except comp gen)
- +54 IF AT'=10
- IF $PIECE($GET(^SD(409.1,+AT,0)),"^",2)
- SET MTI="X"
- QUIT
- +55 ;- Treatment for AO, IR, EC, MST, HNC
- +56 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
- +57 IF MTI]""
- QUIT
- +58 ;- Means Test Code A, C, or G (also Pending Adj = Code C or Code G)
- +59 SET MT=$$LST^DGMTU(DFN,DATE)
- +60 IF $PIECE(MT,"^",4)="A"
- SET MTI="AN"
- QUIT
- +61 IF $PIECE(MT,"^",4)="C"
- SET MTI="C"
- QUIT
- +62 IF $PIECE(MT,"^",4)="G"
- SET MTI="G"
- QUIT
- +63 IF $PIECE(MT,"^",4)="P"
- Begin DoDot:2
- +64 SET MTI=$$PA^DGMTUTL($PIECE(MT,"^"))
- SET MTI=$SELECT('$DATA(MTI):"U",MTI="MT":"C",MTI="GMT":"G",1:"U")
- End DoDot:2
- QUIT
- +65 ;- no means test status or no longer required...check current eligibility data
- +66 ; get MAS eligibility
- SET X=+$GET(^DPT(DFN,.36))
- SET X=+$PIECE($GET(^DIC(8,X,0)),U,9)
- +67 ;- Service connected > 50 %
- +68 IF X=1
- SET MTI="AS"
- QUIT
- +69 ;- Service connected < 50 %
- +70 IF EC=3
- IF '$$SC^DGMTR(DFN)
- SET MTI="AS"
- QUIT
- +71 ;- mex border or WWI or POW
- +72 IF X=16!(X=17)!(X=18)!(X=22)
- SET MTI="AS"
- QUIT
- +73 ;- A&A or Pension or HB
- +74 IF X=2!(X=4)!(X=15)
- SET MTI="AN"
- QUIT
- End DoDot:1
- IF MTI'=""
- GOTO MTQ
- +75 ;- Means Test required and not done/completed
- +76 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