- 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 Jan 18, 2025@04:02:12 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")