SDSCINS ;ALB/JAM/RBS - ASCD Check on Newly Identified Insurance ; 2/15/07 12:57pm ; 4/3/07 11:19am
;;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).
;
;**Program Description**
; This program will check the Audit file for any newly identified
; insurance policies
Q
EN(SDSCINS,SDSCSVC) ; Entry point
;
; Input: SDSCINS and SDSCSVC passed by reference
;
; Output:
; SDSCINS - count of records found with late-identified insurance
; SDSCSVC - count of those found records just filed to (#409.48)
;
N SDSCPAR
K SDSCBDT,SDSCEDT
;if audit not turned on quit
D FIELD^DID(2,.3192,"","AUDIT","SDSCPAR")
I $G(SDSCPAR("AUDIT"))'["YES" Q
K SDSCPAR
D FIELD^DID(2.312,.01,"","AUDIT","SDSCPAR")
I $G(SDSCPAR("AUDIT"))'["YES" Q
; Get encounter date range to check - start with from 24 months back
S SDSCBDT=$$FMADD^XLFDT(DT,-731),SDSCEDT=$O(^SDSC(409.48,"AE",""),-1)\1
;
N SDSCADT,SDEADT,SDINS
S SDSCADT=$$FMADD^XLFDT(DT,-1),SDEADT=$$FMADD^XLFDT(DT,-1)
F S SDSCADT=$O(^DIA(2,"C",SDSCADT)) Q:SDSCADT=""!((SDSCADT\1)>SDEADT) D
. S SDIEN="" F S SDIEN=$O(^DIA(2,"C",SDSCADT,SDIEN)) Q:SDIEN="" D
.. S SDUFLD=$P(^DIA(2,SDIEN,0),U,3)
.. I SDUFLD'=.3192,SDUFLD'[.3121 Q
.. I SDUFLD=.3192 D COV Q:'SDCOV
.. I SDUFLD=".3121,.01" D NINS Q:'SDIN
.. S SDFN=$P(^DIA(2,SDIEN,0),U,1) S:SDFN["," SDFN=$P(SDFN,",",1)
.. ;
.. ; check if this patient has encounters for the date range
.. S SDECDT=SDSCBDT
.. F S SDECDT=$O(^SCE("ADFN",SDFN,SDECDT)) Q:SDECDT=""!((SDECDT\1)>SDSCEDT) D
... S IEN="" F S IEN=$O(^SCE("ADFN",SDFN,SDECDT,IEN)) Q:IEN="" D
.... S SDINS=SDSCSVC
.... S SDOE=IEN,SDOEDT=$P(^SCE(SDOE,0),U,1) D OPT1^SDSCOMP
.... ; count the number of service connected records from late-identified insurance
.... I SDINS'=SDSCSVC S SDSCINS=SDSCINS+1
;
EXIT ; Exit
K SDOE,IEN,SDECDT,SDIN,SDCOV
K SDUFLD,SDFN,SDIEN,SDOEDT
Q
;
AUDIT(SDTEXT,SDCNT) ; Check if auditing is turned on
N SDSCPAR,SDARY,SDCT
S SDCT=0,SDCNT=$G(SDCNT)
D FIELD^DID(2,.3192,"","AUDIT","SDSCPAR")
I $G(SDSCPAR("AUDIT"))'["YES" D
. S SDCT=SDCT+1,SDARY(SDCT)="Auditing is not turned on for field COVERED BY HEALTH INSURANCE?"
K SDSCPAR
D FIELD^DID(2.312,.01,"","AUDIT","SDSCPAR")
I $G(SDSCPAR("AUDIT"))'["YES" D
. S SDCT=SDCT+1,SDARY(SDCT)="Auditing is not turned on for field INSURANCE TYPE"
I SDCT D
. S SDCNT=SDCNT+1,SDTEXT(SDCNT)="",SDCNT=SDCNT+1
. S SDTEXT(SDCNT)="ASCD Late Insurance Check:"
. S SDCT=0 F S SDCT=$O(SDARY(SDCT)) Q:'SDCT D
. . S SDCNT=SDCNT+1,SDTEXT(SDCNT)=SDARY(SDCT)
Q
MMSG ; Send mail message
I $G(DUZ)="" S XMZ(.5)=""
S XMZ(DUZ)="",XMDUZ="ASCD Insurance Check",XMY("G.SDSC NIGHTLY TALLY")=""
S XMTEXT="SDTEXT(",XMSUB="ASCD Insurance Identified"
D ^XMD
K XMY,XMDUZ,XMTEXT,SDTEXT,XMSUB,XMZ
Q
;
COV ; Covered by insurance
N SDOLD,SDNEW
S SDCOV=0
S SDOLD=$G(^DIA(2,SDIEN,2)),SDNEW=$G(^DIA(2,SDIEN,3))
I SDOLD="NO",SDNEW="YES" S SDCOV=1 Q
Q
;
NINS ; New insurance company added
N SDOLD,SDNEW
S SDIN=0
S SDOLD=$G(^DIA(2,SDIEN,2)),SDNEW=$G(^DIA(2,SDIEN,3))
I SDOLD="",SDNEW'="" S SDIN=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDSCINS 3262 printed Apr 09, 2024@21:59:01 Page 2
SDSCINS ;ALB/JAM/RBS - ASCD Check on Newly Identified Insurance ; 2/15/07 12:57pm ; 4/3/07 11:19am
+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 ;**Program Description**
+6 ; This program will check the Audit file for any newly identified
+7 ; insurance policies
+8 QUIT
EN(SDSCINS,SDSCSVC) ; Entry point
+1 ;
+2 ; Input: SDSCINS and SDSCSVC passed by reference
+3 ;
+4 ; Output:
+5 ; SDSCINS - count of records found with late-identified insurance
+6 ; SDSCSVC - count of those found records just filed to (#409.48)
+7 ;
+8 NEW SDSCPAR
+9 KILL SDSCBDT,SDSCEDT
+10 ;if audit not turned on quit
+11 DO FIELD^DID(2,.3192,"","AUDIT","SDSCPAR")
+12 IF $GET(SDSCPAR("AUDIT"))'["YES"
QUIT
+13 KILL SDSCPAR
+14 DO FIELD^DID(2.312,.01,"","AUDIT","SDSCPAR")
+15 IF $GET(SDSCPAR("AUDIT"))'["YES"
QUIT
+16 ; Get encounter date range to check - start with from 24 months back
+17 SET SDSCBDT=$$FMADD^XLFDT(DT,-731)
SET SDSCEDT=$ORDER(^SDSC(409.48,"AE",""),-1)\1
+18 ;
+19 NEW SDSCADT,SDEADT,SDINS
+20 SET SDSCADT=$$FMADD^XLFDT(DT,-1)
SET SDEADT=$$FMADD^XLFDT(DT,-1)
+21 FOR
SET SDSCADT=$ORDER(^DIA(2,"C",SDSCADT))
if SDSCADT=""!((SDSCADT\1)>SDEADT)
QUIT
Begin DoDot:1
+22 SET SDIEN=""
FOR
SET SDIEN=$ORDER(^DIA(2,"C",SDSCADT,SDIEN))
if SDIEN=""
QUIT
Begin DoDot:2
+23 SET SDUFLD=$PIECE(^DIA(2,SDIEN,0),U,3)
+24 IF SDUFLD'=.3192
IF SDUFLD'[.3121
QUIT
+25 IF SDUFLD=.3192
DO COV
if 'SDCOV
QUIT
+26 IF SDUFLD=".3121,.01"
DO NINS
if 'SDIN
QUIT
+27 SET SDFN=$PIECE(^DIA(2,SDIEN,0),U,1)
if SDFN[","
SET SDFN=$PIECE(SDFN,",",1)
+28 ;
+29 ; check if this patient has encounters for the date range
+30 SET SDECDT=SDSCBDT
+31 FOR
SET SDECDT=$ORDER(^SCE("ADFN",SDFN,SDECDT))
if SDECDT=""!((SDECDT\1)>SDSCEDT)
QUIT
Begin DoDot:3
+32 SET IEN=""
FOR
SET IEN=$ORDER(^SCE("ADFN",SDFN,SDECDT,IEN))
if IEN=""
QUIT
Begin DoDot:4
+33 SET SDINS=SDSCSVC
+34 SET SDOE=IEN
SET SDOEDT=$PIECE(^SCE(SDOE,0),U,1)
DO OPT1^SDSCOMP
+35 ; count the number of service connected records from late-identified insurance
+36 IF SDINS'=SDSCSVC
SET SDSCINS=SDSCINS+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+37 ;
EXIT ; Exit
+1 KILL SDOE,IEN,SDECDT,SDIN,SDCOV
+2 KILL SDUFLD,SDFN,SDIEN,SDOEDT
+3 QUIT
+4 ;
AUDIT(SDTEXT,SDCNT) ; Check if auditing is turned on
+1 NEW SDSCPAR,SDARY,SDCT
+2 SET SDCT=0
SET SDCNT=$GET(SDCNT)
+3 DO FIELD^DID(2,.3192,"","AUDIT","SDSCPAR")
+4 IF $GET(SDSCPAR("AUDIT"))'["YES"
Begin DoDot:1
+5 SET SDCT=SDCT+1
SET SDARY(SDCT)="Auditing is not turned on for field COVERED BY HEALTH INSURANCE?"
End DoDot:1
+6 KILL SDSCPAR
+7 DO FIELD^DID(2.312,.01,"","AUDIT","SDSCPAR")
+8 IF $GET(SDSCPAR("AUDIT"))'["YES"
Begin DoDot:1
+9 SET SDCT=SDCT+1
SET SDARY(SDCT)="Auditing is not turned on for field INSURANCE TYPE"
End DoDot:1
+10 IF SDCT
Begin DoDot:1
+11 SET SDCNT=SDCNT+1
SET SDTEXT(SDCNT)=""
SET SDCNT=SDCNT+1
+12 SET SDTEXT(SDCNT)="ASCD Late Insurance Check:"
+13 SET SDCT=0
FOR
SET SDCT=$ORDER(SDARY(SDCT))
if 'SDCT
QUIT
Begin DoDot:2
+14 SET SDCNT=SDCNT+1
SET SDTEXT(SDCNT)=SDARY(SDCT)
End DoDot:2
End DoDot:1
+15 QUIT
MMSG ; Send mail message
+1 IF $GET(DUZ)=""
SET XMZ(.5)=""
+2 SET XMZ(DUZ)=""
SET XMDUZ="ASCD Insurance Check"
SET XMY("G.SDSC NIGHTLY TALLY")=""
+3 SET XMTEXT="SDTEXT("
SET XMSUB="ASCD Insurance Identified"
+4 DO ^XMD
+5 KILL XMY,XMDUZ,XMTEXT,SDTEXT,XMSUB,XMZ
+6 QUIT
+7 ;
COV ; Covered by insurance
+1 NEW SDOLD,SDNEW
+2 SET SDCOV=0
+3 SET SDOLD=$GET(^DIA(2,SDIEN,2))
SET SDNEW=$GET(^DIA(2,SDIEN,3))
+4 IF SDOLD="NO"
IF SDNEW="YES"
SET SDCOV=1
QUIT
+5 QUIT
+6 ;
NINS ; New insurance company added
+1 NEW SDOLD,SDNEW
+2 SET SDIN=0
+3 SET SDOLD=$GET(^DIA(2,SDIEN,2))
SET SDNEW=$GET(^DIA(2,SDIEN,3))
+4 IF SDOLD=""
IF SDNEW'=""
SET SDIN=1
+5 QUIT
