SDSCAPI ;ALB/JDS/JAM/RBS - Automated Service Connection Designation Review ; 4/16/07 10:39am
;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
;;known as Service Connected Automated Monitoring (SCAM).
;
; Routine should be called at specified tags only.
Q
SC(SDFN,SDXS,SDENC,SDVST) ; Determine if SC based on DXS codes
; Input:
; SDFN = Patient ien, file #2 [Required, if SDENC or SDVST undefined]
; SDXS = Diagnosis code array [Optional, if SDENC defined]
; SDENC = Encounter ien, file #409.68 [Optional]
; SDVST = Visit ien, field #9000010 [Optional]
;
; Output:
; $$SDFILEOK = (4 piece data string ^ delimited)
; (SC flag^SC description^VBA/ICD9 match^ASCD Review)
; SC flag: 1-SC, 0-NSC, ""-could not be determined
; SC description: SC or NSC
; VBA/ICD9 match: 1-yes, 0-no
; ASCD: 1-send to review, 0-don't send to review
;
N SDOE0,SDFILEOK,SDOEDAT,SDKILL
S SDENC=+$G(SDENC),SDFILEOK=""
I 'SDENC S SDENC=+$O(^SCE("AVSIT",+$G(SDVST),0))
I SDENC S SDOE0=$$GETOE^SDOE(SDENC)
S SDOEDAT=$S(SDENC:+SDOE0,+$G(SDVST):+$G(^AUPNVSIT(SDVST,0)),1:DT)
; Get patient. If no patient, quit.
I '$G(SDFN) S SDFN=$S(SDENC:$P(SDOE0,U,2),+$G(SDVST):$P($G(^AUPNVSIT(SDVST,0)),U,5),1:"")
I '$G(SDFN) Q SDFILEOK
; diagnosis codes present
I $O(SDXS(0)) D OPT3 Q SDFILEOK
I 'SDENC Q SDFILEOK
D OPT2 I $D(SDKILL) K SDXS
Q SDFILEOK
;
OPT2 ; enter with no DXS defined; get ICD9 for visit/encounter
N SCDXS
K SDXS
I '+$G(SDENC) Q
D GETDX^SDOE(SDENC,"SCDXS")
S SDXS=0 F S SDXS=$O(SCDXS(SDXS)) Q:'SDXS S SDXS(+SCDXS(SDXS))=""
I $O(SDXS(0))="" Q
S SDKILL=1
OPT3 ; enter with DXS defined
N I,SDRD,SDRDIEN,SD31,ICDMCH,SDMCH,FL,SDARR
; Patient has no rated disabilities
D RDIS^DGRPDB(SDFN,.SDARR)
I '$D(SDARR) S SDFILEOK="1^SC^0^1" Q
; Patient has rated disabilities
S (SDRD,FL)=0
F S SDRD=$O(SDARR(SDRD)) Q:'SDRD D
.S SDRDIEN=$P(SDARR(SDRD),U) Q:SDRDIEN=""
.; Get code from eligibility file.
.S I=0,SD31=$G(^DIC(31,SDRDIEN,0)) Q:SD31=""
.; Get partial or true match on ICD9 code
.F S I=$O(SDXS(I)) Q:'I D
..S SDMCH=$$MATCH(SDRDIEN,I,SDOEDAT,SDENC),ICDMCH(SDMCH)=""
; locate entry in the following priority order -
F I="1^SC^1^0","1^SC^1^1","0^NSC^0^1","1^SC^0^1" I $D(ICDMCH(I)) S SDFILEOK=I Q
Q
;
STORE ; Save the information for this encounter.
N SDSC,SDIEN,SDERR
S SDIEN(1)=SDENC
S SDSC(409.48,"+1,",.01)=SDENC
S SDSC(409.48,"+1,",.04)=DT
S SDSC(409.48,"+1,",.07)=+SDOE0
S SDSC(409.48,"+1,",.08)=SDPRV
S SDSC(409.48,"+1,",.09)=$P(SDFILEOK,U,3)
S SDSC(409.48,"+1,",.11)=$P(SDOE0,U,2)
S SDSC(409.48,"+1,",.12)=$P(SDOE0,U,11)
S SDSC(409.48,"+1,",.05)="N"
S SDSC(409.48,"+1,",.13)=SDOSC
D UPDATE^DIE("","SDSC","SDIEN","SDERR")
I $D(SDERR) S ERR=1
Q
ST(SDENC,SDXS) ;Reviews the diagnosis codes for an encounter and then
;determines whether or not to file, or delete the record from the
;ASCD file, SDSC SERVICE CONNECTED CHANGES (#409.48).
;
; Input: SDENC = Encounter ien, file (#409.68) [Required]
; SDXS = Diagnosis code array [Optional]
;
; Output: $$ST value
; 0 = not filed for additional review
; 1 = filed for additional review
; 2 = deleted from (#409.48) file
;
N SDLIST,SDOE0,SDEL,SDOEDAT,SDPRV,SDFN,SDFILEOK,ERR,SCVAL,SDCLIN,SDSTP
N SDPAT,SDCST,SDKILL,SDV0,SDOSC,SDOEDT
I '$G(SDENC) Q 0
S SDOE0=$$GETOE^SDOE(SDENC) I SDOE0="" Q 0
;quit if child encounter
I $P(SDOE0,U,6) Q 0
S SDV0=$P(SDOE0,U,5),SDOSC=$$GET1^DIQ(9000010,SDV0_",",80001,"I")
S SDPRV=$$PRIMVPRV^PXUTL1(SDV0),SDEL=$P(SDOE0,U,13),SCVAL=0
S (SDOEDAT,SDOEDT)=+SDOE0,(SDFILEOK,ERR)=0,SDCLIN=$P(SDOE0,U,4)
S SDCST=$P(SDOE0,U,3),(SDFN,SDPAT)=$P(SDOE0,U,2)
;no patient
I 'SDPAT Q 0
;no clinic
I 'SDCLIN Q 0
;no stop code
I 'SDCST Q 0
;no visit SC value
I SDOSC="" Q 0
;not checked-out
I $P(SDOE0,U,12)'=2 Q 0
;check for non-count
I $$NCTCL^SDSCUTL(SDCLIN) Q 0
;no eligibility
I SDEL="" Q 0
;If eligibility is not service connected, quit.
D ELIG I '$D(SDLIST(SDEL)) Q 0
;if non-billable for first and third party, quit
I $$NBFP^SDSCUTL(SDENC),$$NBTP^SDSCUTL(SDENC) Q 0
D
.I $O(SDXS(0)) D OPT3 Q
.D OPT2 I $D(SDKILL) K SDXS
I SDFILEOK="" Q 0
;File encounter in ASCD if it does not exist
I $P(SDFILEOK,U,4),'$D(^SDSC(409.48,SDENC,0)) D STORE Q 'ERR
I '$P(SDFILEOK,U,4) D Q SCVAL
.;Set for review if Visit SC is different from ASCD
.I SDOSC'=$P(SDFILEOK,U) Q:$D(^SDSC(409.48,SDENC,0)) D STORE S SCVAL='ERR Q
.;Remove encounter from ASCD if no review needed
.N DA,DIK
.I $D(^SDSC(409.48,SDENC,0)) S DA=SDENC,DIK="^SDSC(409.48," D ^DIK S SCVAL=2
Q 0
ELIG ;Compile list of service connected eligibility codes
N I,J
F I=1,3 S J=0 F S J=$O(^DIC(8,"D",I,J)) Q:'J S SDLIST(J)=""
Q
MATCH(SDIEN31,SDXIEN,SDATE,SDENC) ;ICD9 matching code
; - api should be changed to lexicon in next version
; Input:
; SDIEN31 = File #31 [Required]
; SDXIEN = Diagnosis code ien, file #80 [Required]
; SDATE = Encounter date, [Optional] [Required for lexicon]
; SDENC = Encounter ien, file #409.68 [Required]
;
; Output:
; $$SDFILEOK = (4 piece data string ^ delimited)
; (SC flag^SC description^VBA/ICD9 match^ASCD Review)
; SC flag: 1-SC, 0-NSC, ""-could not be determined
; SC description: SC or NSC
; VBA/ICD9 match: 1-yes, 0-no
; ASCD: 1-send to review, 0-don't send to review
;
N SDMCH,SDXIEN1,SDXLVL,SDPDX
I '$D(^DIC(31,SDIEN31,"ICD")) Q "1^SC^0^1"
I '$D(^DIC(31,SDIEN31,"ICD","B",SDXIEN)) Q "0^NSC^0^1"
S SDXIEN1=$O(^DIC(31,SDIEN31,"ICD","B",SDXIEN,0))
S SDXLVL=$G(^DIC(31,SDIEN31,"ICD",+SDXIEN1,0)),SDMCH=+$P(SDXLVL,U,2)
I ('SDXIEN1)!(SDXLVL="") Q "0^NSC^0^1"
D GETPDX^SDOERPC(.SDPDX,SDENC)
Q $S(SDMCH&(SDPDX=SDXIEN):"1^SC^1^0",1:"1^SC^1^1")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDSCAPI 6015 printed Apr 09, 2024@21:42:31 Page 2
SDSCAPI ;ALB/JDS/JAM/RBS - Automated Service Connection Designation Review ; 4/16/07 10:39am
+1 ;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
+2 ;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
+3 ;;known as Service Connected Automated Monitoring (SCAM).
+4 ;
+5 ; Routine should be called at specified tags only.
+6 QUIT
SC(SDFN,SDXS,SDENC,SDVST) ; Determine if SC based on DXS codes
+1 ; Input:
+2 ; SDFN = Patient ien, file #2 [Required, if SDENC or SDVST undefined]
+3 ; SDXS = Diagnosis code array [Optional, if SDENC defined]
+4 ; SDENC = Encounter ien, file #409.68 [Optional]
+5 ; SDVST = Visit ien, field #9000010 [Optional]
+6 ;
+7 ; Output:
+8 ; $$SDFILEOK = (4 piece data string ^ delimited)
+9 ; (SC flag^SC description^VBA/ICD9 match^ASCD Review)
+10 ; SC flag: 1-SC, 0-NSC, ""-could not be determined
+11 ; SC description: SC or NSC
+12 ; VBA/ICD9 match: 1-yes, 0-no
+13 ; ASCD: 1-send to review, 0-don't send to review
+14 ;
+15 NEW SDOE0,SDFILEOK,SDOEDAT,SDKILL
+16 SET SDENC=+$GET(SDENC)
SET SDFILEOK=""
+17 IF 'SDENC
SET SDENC=+$ORDER(^SCE("AVSIT",+$GET(SDVST),0))
+18 IF SDENC
SET SDOE0=$$GETOE^SDOE(SDENC)
+19 SET SDOEDAT=$SELECT(SDENC:+SDOE0,+$GET(SDVST):+$GET(^AUPNVSIT(SDVST,0)),1:DT)
+20 ; Get patient. If no patient, quit.
+21 IF '$GET(SDFN)
SET SDFN=$SELECT(SDENC:$PIECE(SDOE0,U,2),+$GET(SDVST):$PIECE($GET(^AUPNVSIT(SDVST,0)),U,5),1:"")
+22 IF '$GET(SDFN)
QUIT SDFILEOK
+23 ; diagnosis codes present
+24 IF $ORDER(SDXS(0))
DO OPT3
QUIT SDFILEOK
+25 IF 'SDENC
QUIT SDFILEOK
+26 DO OPT2
IF $DATA(SDKILL)
KILL SDXS
+27 QUIT SDFILEOK
+28 ;
OPT2 ; enter with no DXS defined; get ICD9 for visit/encounter
+1 NEW SCDXS
+2 KILL SDXS
+3 IF '+$GET(SDENC)
QUIT
+4 DO GETDX^SDOE(SDENC,"SCDXS")
+5 SET SDXS=0
FOR
SET SDXS=$ORDER(SCDXS(SDXS))
if 'SDXS
QUIT
SET SDXS(+SCDXS(SDXS))=""
+6 IF $ORDER(SDXS(0))=""
QUIT
+7 SET SDKILL=1
OPT3 ; enter with DXS defined
+1 NEW I,SDRD,SDRDIEN,SD31,ICDMCH,SDMCH,FL,SDARR
+2 ; Patient has no rated disabilities
+3 DO RDIS^DGRPDB(SDFN,.SDARR)
+4 IF '$DATA(SDARR)
SET SDFILEOK="1^SC^0^1"
QUIT
+5 ; Patient has rated disabilities
+6 SET (SDRD,FL)=0
+7 FOR
SET SDRD=$ORDER(SDARR(SDRD))
if 'SDRD
QUIT
Begin DoDot:1
+8 SET SDRDIEN=$PIECE(SDARR(SDRD),U)
if SDRDIEN=""
QUIT
+9 ; Get code from eligibility file.
+10 SET I=0
SET SD31=$GET(^DIC(31,SDRDIEN,0))
if SD31=""
QUIT
+11 ; Get partial or true match on ICD9 code
+12 FOR
SET I=$ORDER(SDXS(I))
if 'I
QUIT
Begin DoDot:2
+13 SET SDMCH=$$MATCH(SDRDIEN,I,SDOEDAT,SDENC)
SET ICDMCH(SDMCH)=""
End DoDot:2
End DoDot:1
+14 ; locate entry in the following priority order -
+15 FOR I="1^SC^1^0","1^SC^1^1","0^NSC^0^1","1^SC^0^1"
IF $DATA(ICDMCH(I))
SET SDFILEOK=I
QUIT
+16 QUIT
+17 ;
STORE ; Save the information for this encounter.
+1 NEW SDSC,SDIEN,SDERR
+2 SET SDIEN(1)=SDENC
+3 SET SDSC(409.48,"+1,",.01)=SDENC
+4 SET SDSC(409.48,"+1,",.04)=DT
+5 SET SDSC(409.48,"+1,",.07)=+SDOE0
+6 SET SDSC(409.48,"+1,",.08)=SDPRV
+7 SET SDSC(409.48,"+1,",.09)=$PIECE(SDFILEOK,U,3)
+8 SET SDSC(409.48,"+1,",.11)=$PIECE(SDOE0,U,2)
+9 SET SDSC(409.48,"+1,",.12)=$PIECE(SDOE0,U,11)
+10 SET SDSC(409.48,"+1,",.05)="N"
+11 SET SDSC(409.48,"+1,",.13)=SDOSC
+12 DO UPDATE^DIE("","SDSC","SDIEN","SDERR")
+13 IF $DATA(SDERR)
SET ERR=1
+14 QUIT
ST(SDENC,SDXS) ;Reviews the diagnosis codes for an encounter and then
+1 ;determines whether or not to file, or delete the record from the
+2 ;ASCD file, SDSC SERVICE CONNECTED CHANGES (#409.48).
+3 ;
+4 ; Input: SDENC = Encounter ien, file (#409.68) [Required]
+5 ; SDXS = Diagnosis code array [Optional]
+6 ;
+7 ; Output: $$ST value
+8 ; 0 = not filed for additional review
+9 ; 1 = filed for additional review
+10 ; 2 = deleted from (#409.48) file
+11 ;
+12 NEW SDLIST,SDOE0,SDEL,SDOEDAT,SDPRV,SDFN,SDFILEOK,ERR,SCVAL,SDCLIN,SDSTP
+13 NEW SDPAT,SDCST,SDKILL,SDV0,SDOSC,SDOEDT
+14 IF '$GET(SDENC)
QUIT 0
+15 SET SDOE0=$$GETOE^SDOE(SDENC)
IF SDOE0=""
QUIT 0
+16 ;quit if child encounter
+17 IF $PIECE(SDOE0,U,6)
QUIT 0
+18 SET SDV0=$PIECE(SDOE0,U,5)
SET SDOSC=$$GET1^DIQ(9000010,SDV0_",",80001,"I")
+19 SET SDPRV=$$PRIMVPRV^PXUTL1(SDV0)
SET SDEL=$PIECE(SDOE0,U,13)
SET SCVAL=0
+20 SET (SDOEDAT,SDOEDT)=+SDOE0
SET (SDFILEOK,ERR)=0
SET SDCLIN=$PIECE(SDOE0,U,4)
+21 SET SDCST=$PIECE(SDOE0,U,3)
SET (SDFN,SDPAT)=$PIECE(SDOE0,U,2)
+22 ;no patient
+23 IF 'SDPAT
QUIT 0
+24 ;no clinic
+25 IF 'SDCLIN
QUIT 0
+26 ;no stop code
+27 IF 'SDCST
QUIT 0
+28 ;no visit SC value
+29 IF SDOSC=""
QUIT 0
+30 ;not checked-out
+31 IF $PIECE(SDOE0,U,12)'=2
QUIT 0
+32 ;check for non-count
+33 IF $$NCTCL^SDSCUTL(SDCLIN)
QUIT 0
+34 ;no eligibility
+35 IF SDEL=""
QUIT 0
+36 ;If eligibility is not service connected, quit.
+37 DO ELIG
IF '$DATA(SDLIST(SDEL))
QUIT 0
+38 ;if non-billable for first and third party, quit
+39 IF $$NBFP^SDSCUTL(SDENC)
IF $$NBTP^SDSCUTL(SDENC)
QUIT 0
+40 Begin DoDot:1
+41 IF $ORDER(SDXS(0))
DO OPT3
QUIT
+42 DO OPT2
IF $DATA(SDKILL)
KILL SDXS
End DoDot:1
+43 IF SDFILEOK=""
QUIT 0
+44 ;File encounter in ASCD if it does not exist
+45 IF $PIECE(SDFILEOK,U,4)
IF '$DATA(^SDSC(409.48,SDENC,0))
DO STORE
QUIT 'ERR
+46 IF '$PIECE(SDFILEOK,U,4)
Begin DoDot:1
+47 ;Set for review if Visit SC is different from ASCD
+48 IF SDOSC'=$PIECE(SDFILEOK,U)
if $DATA(^SDSC(409.48,SDENC,0))
QUIT
DO STORE
SET SCVAL='ERR
QUIT
+49 ;Remove encounter from ASCD if no review needed
+50 NEW DA,DIK
+51 IF $DATA(^SDSC(409.48,SDENC,0))
SET DA=SDENC
SET DIK="^SDSC(409.48,"
DO ^DIK
SET SCVAL=2
End DoDot:1
QUIT SCVAL
+52 QUIT 0
ELIG ;Compile list of service connected eligibility codes
+1 NEW I,J
+2 FOR I=1,3
SET J=0
FOR
SET J=$ORDER(^DIC(8,"D",I,J))
if 'J
QUIT
SET SDLIST(J)=""
+3 QUIT
MATCH(SDIEN31,SDXIEN,SDATE,SDENC) ;ICD9 matching code
+1 ; - api should be changed to lexicon in next version
+2 ; Input:
+3 ; SDIEN31 = File #31 [Required]
+4 ; SDXIEN = Diagnosis code ien, file #80 [Required]
+5 ; SDATE = Encounter date, [Optional] [Required for lexicon]
+6 ; SDENC = Encounter ien, file #409.68 [Required]
+7 ;
+8 ; Output:
+9 ; $$SDFILEOK = (4 piece data string ^ delimited)
+10 ; (SC flag^SC description^VBA/ICD9 match^ASCD Review)
+11 ; SC flag: 1-SC, 0-NSC, ""-could not be determined
+12 ; SC description: SC or NSC
+13 ; VBA/ICD9 match: 1-yes, 0-no
+14 ; ASCD: 1-send to review, 0-don't send to review
+15 ;
+16 NEW SDMCH,SDXIEN1,SDXLVL,SDPDX
+17 IF '$DATA(^DIC(31,SDIEN31,"ICD"))
QUIT "1^SC^0^1"
+18 IF '$DATA(^DIC(31,SDIEN31,"ICD","B",SDXIEN))
QUIT "0^NSC^0^1"
+19 SET SDXIEN1=$ORDER(^DIC(31,SDIEN31,"ICD","B",SDXIEN,0))
+20 SET SDXLVL=$GET(^DIC(31,SDIEN31,"ICD",+SDXIEN1,0))
SET SDMCH=+$PIECE(SDXLVL,U,2)
+21 IF ('SDXIEN1)!(SDXLVL="")
QUIT "0^NSC^0^1"
+22 DO GETPDX^SDOERPC(.SDPDX,SDENC)
+23 QUIT $SELECT(SDMCH&(SDPDX=SDXIEN):"1^SC^1^0",1:"1^SC^1^1")
