SDSCEDT ;ALB/JAM/RBS - ASCD Review and Edit SC value for encounters. ;4/24/07 4:29pm
;;5.3;Scheduling;**495,586**;Aug 13, 1993;Build 28
;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
;;known as Service Connected Automated Monitoring (SCAM).
;
; Reference to $$ICDDX^ICDEX supported by ICR #5747
;
Q
START ; Called by option "SDSC EDIT BY DATE - Edit encounters by date range"
N SCVST,SCOPT,SDSCEDIT S SDSCEDIT=1
D HOME^%ZIS
; Ask which records should be reviewed.
S SCOPT=$$SCSEL^SDSCUTL() I SCOPT="" G END
; Select correct user type based on security key.
D TYPE^SDSCUTL
; Get start and end date for encounter list.
D GETDATE^SDSCOMP I SDSCTDT="" G END
D DIV^SDSCUTL
D ^DIR
I $G(DTOUT)!($G(DUOUT)) G END
S SDSCDVSL=Y,SDSCDVLN=SCLN
K DIR,X,Y,SCLN
S SDSCDIV=$S(SDSCDVSL'[SDSCDVLN:","_SDSCDVSL,1:"")
; Initialize quit flags.
S SDQFLG=0,SDFLG=0
I SDSCTAT'="" D OPT
I SDSCTAT="" D S SDSCTAT=""
. S SDSCTAT="N" D OPT Q:SDQFLG=1
. S SDSCTAT="R" D OPT Q:SDQFLG=1
. Q
I SDFLG=0 D EN^DDIOL("No editable encounters found in the specified date range. ",,"!!?10") W *7
G END
;
OPT ; Loop through requested encounter status for specified date range, display each encounter, and allow edit.
S SDOEDT=SDSCTDT F S SDOEDT=$O(^SDSC(409.48,"C",SDSCTAT,SDOEDT)) Q:SDOEDT\1>SDEDT Q:(SDOEDT="")!(SDQFLG=1) D
. S SDOE=0 F S SDOE=$O(^SDSC(409.48,"C",SDSCTAT,SDOEDT,SDOE)) Q:'SDOE!(SDQFLG=1) D
.. ; Check review selection
.. S SDV0=$P($$GETOE^SDOE(SDOE),U,5) I SDV0="" Q
.. S SCVST=$$GET1^DIQ(9000010,SDV0_",",80001,"I")
.. I SCVST'=SCOPT,SCOPT'=2 Q
.. ; Initialize flag and do final editability checks on encounter.
.. S SDEFLG=0 D CHECK
.. ; If edit flag not set, quit. (Don't display error in this loop.)
.. I SDEFLG=0 Q
.. ; Check for sensitive patient
.. I $$SENS^SDSCUTL(SDPAT,0) Q
.. ; Display encounter.
.. D DISPLAY,DISPLAY1
.. ; IF quit flag set, quit.
.. I SDQFLG=1 Q
.. ;Check if data came from an ancillary package and okay to edit
.. I '$$ANCPKG^SDSCUTL(SDOE) S SDSCMSG="Cannot edit encounter." Q
.. ; Otherwise, edit encounter.
.. D EDIT
Q
START1 ; Called by option "SDSC SINGLE EDIT - Edit single encounter"
N SDSCEDIT S SDSCEDIT=1
D HOME^%ZIS
D TYPE^SDSCUTL
; Initialize quit flag.
S SDQFLG=0
F D Q:SDQFLG=1
. S DIC(0)="AEMNZ",DIC="^SDSC(409.48,"
. S DIC("A")="Select OUTPATIENT ENCOUNTER: "
. I SDSCCR]"" S DIC("S")=SDSCCR_",$P($G(^SCE(+Y,0)),""^"",6)="""""
. I SDSCCR="" S DIC("S")="I $P($G(^SCE(+Y,0)),""^"",6)="""""
. W !
. D ^DIC
. I +Y=-1!$D(DTOUT)!$D(DUOUT) S SDQFLG=1 Q
. S SDOE=+Y,SDOEDT=$P($G(^SDSC(409.48,SDOE,0)),U,7)
. ; Separate editing checks and display code for ListMan.
. ; Initialize flag and do final editability checks on encounter.
. S SDEFLG=0 D CHECK
. ; If edit flag not set, display error and quit.
. I SDEFLG=0 D EN^DDIOL("Cannot edit encounter# "_SDOE_". Missing data. ",,"!!?10") W *7 Q
. ; Check for sensitive patient
. I $$SENS^SDSCUTL(SDPAT,0) Q
. ; Display encounter.
. D DISPLAY,DISPLAY1
. ; If quit flag set, quit.
. I SDQFLG=1 Q
. I '$$ANCPKG^SDSCUTL(SDOE) D EN^DDIOL("Cannot edit encounter.") Q
. ; Otherwise, edit encounter.
. D EDIT
G END
;
CHECK ; Final editing checks for specified encounter.
; Check division, if doesn't match, quit.
I $G(SDSCDIV)'="",(","_SDSCDIV_",")'[(","_$P(^SDSC(409.48,SDOE,0),U,12)_",") Q
; Get encounter data. If no encounter data, quit.
S SDOEDAT=$$GETOE^SDOE(SDOE)
I SDOEDAT="" S SDSCMSG=" no encounter zero node" Q
; Get patient IEN.
S SDPAT=$P(SDOEDAT,U,2)
; Get visit file entry. If no visit, quit.
S SDV0=$P(SDOEDAT,U,5) I SDV0="" S SDSCMSG=" encounter missing visit number" Q
I $G(^AUPNVSIT(SDV0,0))="" S SDSCMSG=" no visit zero node" Q
; Get current service connection value from visit.
S SDOSC=$$GET1^DIQ(9000010,SDV0_",",80001,"I")
; Get package and source info from visit file. If missing, quit.
S SDSCPKG=$$GET1^DIQ(9000010,SDV0_",",81202,"E") I SDSCPKG="" S SDSCPKG="SCHEDULING"
S SDSCSRC=$$GET1^DIQ(9000010,SDV0_",",81203,"E") I SDSCSRC="" S SDSCSRC="AUTOMATED SC DESIGNATION"
; Data checks successful. Set flags to allow edit to continue
S SDEFLG=1,SDFLG=1
Q
DISPLAY ; Compile display for the specified encounter into a TMP global.
; Clear scratch global and reset line counter.
K ^TMP("SDSCLST",$J) S SDLN=0
S SDTMP="Encounter "_SDOE
I SDOSC=1 S SDTMP=SDTMP_" is marked as service connected and may not be."
E S SDTMP=SDTMP_" is NOT marked as service connected."
D LINE(SDTMP)
D LINE(" ")
; Display the date for the encounter.
D LINE("Date of Encounter: "_$$FMTE^XLFDT(SDOEDT,"5MZ"))
; Display the clinic for the encounter.
S SDCLIN=$P(SDOEDAT,U,4),SDTMP="Location: "
I SDCLIN]"" S SDTMP=SDTMP_$P($G(^SC(SDCLIN,0)),U)
D LINE(SDTMP)
; Display the primary provider for the visit.
S SDPRV=$P($G(^SDSC(409.48,SDOE,0)),U,8),SDTMP="Primary Provider: "
I SDPRV]"" S SDTMP=SDTMP_$$UP^XLFSTR($$NAME^XUSER(SDPRV))
D LINE(SDTMP)
; Display the patient name and last 4 SSN.
S SDTMP="Patient: "
I SDPAT]"" D
. N DFN,VADM S DFN=SDPAT D DEM^VADPT
. S SDTMP=SDTMP_$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")"
. ; Add flag if patient is considered sensitive.
. I +$P($G(^DGSL(38.1,+SDPAT,0)),U,2) S SDTMP=SDTMP_" *SENSITIVE*"
D LINE(SDTMP)
; Compile patient insurance information.
D INS
; Review VBA/ICD9 SC response
D VBAICD
; Compile all POVs for this visit.
D GETPDX^SDOERPC(.SDPDX,SDOE),POV2S
; Compile all disabilities for this patient.
D DIS2S
Q
DISPLAY1 ; Display the specified encounter.
W @IOF
S L=0
F SDLN=1:1 Q:'$D(^TMP("SDSCLST",$J,SDLN,0)) D Q:$G(SDQFLG)=1
. I L+3>IOSL D CONT^SDSCUTL S L=2 Q:$G(SDQFLG)=1
. W !,^TMP("SDSCLST",$J,SDLN,0)
. S L=L+1
. Q
W !
Q
INS ; Compile patient means test and insurance information.
S SDCP=$$BIL^DGMTUB(SDPAT,SDOEDT)
D LINE(" ")
D LINE("Patient "_$S(SDCP=1:"is",1:"is not")_" copay eligible.")
S SDACT=+$$INSUR^IBBAPI(SDPAT,SDOEDT)
D LINE("Patient "_$S(SDACT=1:"is",1:"is not")_" insured.")
I 'SDACT Q
; ICR#: 4419 (SUPPORTED) - look for Outpatient coverage
S SDCOV=$S($$INSUR^IBBAPI(SDPAT,SDOEDT,"O","",16)<1:0,1:1)
D LINE("Outpatient Coverage is "_$S(SDCOV:"",1:"not ")_"covered.")
Q
POV2S ; Compile all POV entries for the specified visit.
D LINE(" "),LINE(" POVs/ICDs:")
S SDVPOV0=0 F S SDVPOV0=$O(^AUPNVPOV("AD",SDV0,SDVPOV0)) Q:'SDVPOV0 D
. S SDPOV=$P($G(^AUPNVPOV(SDVPOV0,0)),U)
. ; Added display if diagnosis is marked service connected (CIDC) - ALA 9/27/05
. S SDPOVSC=$P($G(^AUPNVPOV(SDVPOV0,800)),U)
. S SCDX=$$ICDDX^ICDEX(SDPOV,+SDOEDAT,+$$SYS^ICDEX("DIAG",+SDOEDAT,"I"),"I") ;SD*5.3*586
. S SDPSC=$S(SDPDX=$P(SCDX,U):"*P* ",1:"")_$S(SDPOVSC=1:"*SC* ",1:"")
. S SDTMP=$J(SDPSC,15)_$P(SCDX,U,2)_" "
. S SDTMP=$E(SDTMP,1,23)_$P(SCDX,U,4)
. D LINE(SDTMP)
Q
DIS2S ; Compile all rated disabilities for this patient.
;DBIA4807 and DBIA1476
D LINE(" ")
D LINE(" Rated Disabilities:")
N SCRD,I,I1,I2
D RDIS^DGRPDB(SDPAT,.SCRD)
S I=0 F S I=$O(SCRD(I)) Q:'I D
. S I1=SCRD(I)
. S I2=$S($D(^DIC(31,+I1,0)):$P(^(0),U,3)_" "_$P(^(0),"^",1)_" ("_+$P(I1,"^",2)_"%-"_$S($P(I1,"^",3):"SC",$P(I1,"^",3)']"":"not specified",1:"NSC")_")",1:"")
. D LINE(" "_I2)
Q
VBAICD ;ASCD (VBA/ICD9) SC evaluation
N Y,VAL
D LINE(" ")
S Y=$$SC^SDSCAPI(SDPAT,,SDOE)
D LINE("ASCD Evaluation: "_$P(Y,"^",2))
Q
LINE(LINE) ; Save a line of text into the scratch global.
S SDLN=SDLN+1,^TMP("SDSCLST",$J,SDLN,0)=LINE
Q
EDIT ; Allow user to edit the specified encounter or send for review. (Roll and scroll)
K DIR,X,Y
S DIR(0)=SDOPT
S DIR("A")="DO YOU WANT TO CHANGE THE SERVICE CONNECTION FOR THIS ENCOUNTER? "
S DIR("?")=" "
S DIR("?",1)="Enter:"
S DIR("?",2)=" 'YES' to modify this encounter's Service Connected statuses."
S DIR("?",3)=" 'NO' to retain this encounter's Service Connected statuses."
S DIR("?",4)=" 'SKIP' to skip this encounter and review it later."
I SDOPT["REVIEW" S DIR("?",5)=" 'REVIEW' to flag this encounter for clinical review."
D ^DIR
I $D(DTOUT)!$D(DUOUT) S SDQFLG=1 Q
S SDANS=Y K DIR,X,Y
LEDT ; ListMan Entry Point for Editing
; If user selected 'SKIP', postpone action on this entry.
I $G(SDANS)="S" Q
; Set 'REVIEW' flag if required.
S SDRFLG=$S(SDANS="R":1,1:0)
; Lock record before editing
I '$$LOCK^SDSCUTL(SDOE) D Q
. W !!,"*** Encounter ",SDOE," locked by another user. Try later. ***" H 2
; If user answered 'YES' then send call PCE API.
I SDANS="Y" D
. N SDEDIT S SDEDIT=1
. S X=$$INTV^PXAPI("POV",SDSCPKG,SDSCSRC,SDV0) HANG 1
I '$D(^SDSC(409.48,SDOE)) D G CTUP ;Entry deleted because of review match
. W !!,"*** Encounter ",SDOE," Removed from ASCD File - True Match Found ***" H 2
S SDSCC=$$GET1^DIQ(9000010,SDV0_",",80001,"I")
I SDSCC="",$D(^SDSC(409.48,SDOE)) D G CTUP ;Remove entry if no SC value
. N DA,DIK S DA=SDOE,DIK="^SDSC(409.48," D ^DIK
. W !!,"*** Encounter ",SDOE," Removed from ASCD File - No SC value found in Visit File ***" H 2
; Store any changes the user made in the TRACK EDITS multiple.
D STEDT^SDSCUTL(SDOE,SDTYPE,SDRFLG,SDSCC)
CTUP ; Update claims tracking file in IB.
D
. I '$D(^SDSC(409.48,SDOE)) N SCTUPD S SCTUPD=$$RNBU^IBRSUTL(SDOE,1) Q
. D CLM^SDSCCLM(SDOE)
D UNLOCK^SDSCUTL(SDOE)
Q
;
END ; Clear all variables before exiting.
K SDSCTDT,SDEDT,SDOEDT,SDOE,SDOEX,SDEC,SDPAT,SDPASS,SDICD,SDPOV,SDSCC
K SDCST,SDSCPKG,SDSCSRC,SDPOVSC,SDPSC,SCDX,SDSCDVSL,SDFILEOK,SDV0
K SDVPOV0,SDPD,SDIENS,DA,DIE,DIC,DLAYGO,DIERR,ERR,SDRFLG,SDQFLG,SDTYPE
K SDOPT,SDSCTAT,SDSCDIV,SDSCDVLN,SDSCMSG,SDPRV,SDCLIN,SDLIST,P,L,SDABRT
K X,X1,X2,Y,DTOUT,DUOUT,DIR,SDACT,SDCOV,SDSCCR,SDOEDAT,SDEFLG,SDOSC,SDCP
K SDFLG,SDLN,SDTMP,SDANS,SDSCBDT,SDSCEDT,SDCNT,SDDATA,SDPDX
D KVA^VADPT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDSCEDT 9994 printed Dec 13, 2024@03:01:06 Page 2
SDSCEDT ;ALB/JAM/RBS - ASCD Review and Edit SC value for encounters. ;4/24/07 4:29pm
+1 ;;5.3;Scheduling;**495,586**;Aug 13, 1993;Build 28
+2 ;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
+3 ;;known as Service Connected Automated Monitoring (SCAM).
+4 ;
+5 ; Reference to $$ICDDX^ICDEX supported by ICR #5747
+6 ;
+7 QUIT
START ; Called by option "SDSC EDIT BY DATE - Edit encounters by date range"
+1 NEW SCVST,SCOPT,SDSCEDIT
SET SDSCEDIT=1
+2 DO HOME^%ZIS
+3 ; Ask which records should be reviewed.
+4 SET SCOPT=$$SCSEL^SDSCUTL()
IF SCOPT=""
GOTO END
+5 ; Select correct user type based on security key.
+6 DO TYPE^SDSCUTL
+7 ; Get start and end date for encounter list.
+8 DO GETDATE^SDSCOMP
IF SDSCTDT=""
GOTO END
+9 DO DIV^SDSCUTL
+10 DO ^DIR
+11 IF $GET(DTOUT)!($GET(DUOUT))
GOTO END
+12 SET SDSCDVSL=Y
SET SDSCDVLN=SCLN
+13 KILL DIR,X,Y,SCLN
+14 SET SDSCDIV=$SELECT(SDSCDVSL'[SDSCDVLN:","_SDSCDVSL,1:"")
+15 ; Initialize quit flags.
+16 SET SDQFLG=0
SET SDFLG=0
+17 IF SDSCTAT'=""
DO OPT
+18 IF SDSCTAT=""
Begin DoDot:1
+19 SET SDSCTAT="N"
DO OPT
if SDQFLG=1
QUIT
+20 SET SDSCTAT="R"
DO OPT
if SDQFLG=1
QUIT
+21 QUIT
End DoDot:1
SET SDSCTAT=""
+22 IF SDFLG=0
DO EN^DDIOL("No editable encounters found in the specified date range. ",,"!!?10")
WRITE *7
+23 GOTO END
+24 ;
OPT ; Loop through requested encounter status for specified date range, display each encounter, and allow edit.
+1 SET SDOEDT=SDSCTDT
FOR
SET SDOEDT=$ORDER(^SDSC(409.48,"C",SDSCTAT,SDOEDT))
if SDOEDT\1>SDEDT
QUIT
if (SDOEDT="")!(SDQFLG=1)
QUIT
Begin DoDot:1
+2 SET SDOE=0
FOR
SET SDOE=$ORDER(^SDSC(409.48,"C",SDSCTAT,SDOEDT,SDOE))
if 'SDOE!(SDQFLG=1)
QUIT
Begin DoDot:2
+3 ; Check review selection
+4 SET SDV0=$PIECE($$GETOE^SDOE(SDOE),U,5)
IF SDV0=""
QUIT
+5 SET SCVST=$$GET1^DIQ(9000010,SDV0_",",80001,"I")
+6 IF SCVST'=SCOPT
IF SCOPT'=2
QUIT
+7 ; Initialize flag and do final editability checks on encounter.
+8 SET SDEFLG=0
DO CHECK
+9 ; If edit flag not set, quit. (Don't display error in this loop.)
+10 IF SDEFLG=0
QUIT
+11 ; Check for sensitive patient
+12 IF $$SENS^SDSCUTL(SDPAT,0)
QUIT
+13 ; Display encounter.
+14 DO DISPLAY
DO DISPLAY1
+15 ; IF quit flag set, quit.
+16 IF SDQFLG=1
QUIT
+17 ;Check if data came from an ancillary package and okay to edit
+18 IF '$$ANCPKG^SDSCUTL(SDOE)
SET SDSCMSG="Cannot edit encounter."
QUIT
+19 ; Otherwise, edit encounter.
+20 DO EDIT
End DoDot:2
End DoDot:1
+21 QUIT
START1 ; Called by option "SDSC SINGLE EDIT - Edit single encounter"
+1 NEW SDSCEDIT
SET SDSCEDIT=1
+2 DO HOME^%ZIS
+3 DO TYPE^SDSCUTL
+4 ; Initialize quit flag.
+5 SET SDQFLG=0
+6 FOR
Begin DoDot:1
+7 SET DIC(0)="AEMNZ"
SET DIC="^SDSC(409.48,"
+8 SET DIC("A")="Select OUTPATIENT ENCOUNTER: "
+9 IF SDSCCR]""
SET DIC("S")=SDSCCR_",$P($G(^SCE(+Y,0)),""^"",6)="""""
+10 IF SDSCCR=""
SET DIC("S")="I $P($G(^SCE(+Y,0)),""^"",6)="""""
+11 WRITE !
+12 DO ^DIC
+13 IF +Y=-1!$DATA(DTOUT)!$DATA(DUOUT)
SET SDQFLG=1
QUIT
+14 SET SDOE=+Y
SET SDOEDT=$PIECE($GET(^SDSC(409.48,SDOE,0)),U,7)
+15 ; Separate editing checks and display code for ListMan.
+16 ; Initialize flag and do final editability checks on encounter.
+17 SET SDEFLG=0
DO CHECK
+18 ; If edit flag not set, display error and quit.
+19 IF SDEFLG=0
DO EN^DDIOL("Cannot edit encounter# "_SDOE_". Missing data. ",,"!!?10")
WRITE *7
QUIT
+20 ; Check for sensitive patient
+21 IF $$SENS^SDSCUTL(SDPAT,0)
QUIT
+22 ; Display encounter.
+23 DO DISPLAY
DO DISPLAY1
+24 ; If quit flag set, quit.
+25 IF SDQFLG=1
QUIT
+26 IF '$$ANCPKG^SDSCUTL(SDOE)
DO EN^DDIOL("Cannot edit encounter.")
QUIT
+27 ; Otherwise, edit encounter.
+28 DO EDIT
End DoDot:1
if SDQFLG=1
QUIT
+29 GOTO END
+30 ;
CHECK ; Final editing checks for specified encounter.
+1 ; Check division, if doesn't match, quit.
+2 IF $GET(SDSCDIV)'=""
IF (","_SDSCDIV_",")'[(","_$PIECE(^SDSC(409.48,SDOE,0),U,12)_",")
QUIT
+3 ; Get encounter data. If no encounter data, quit.
+4 SET SDOEDAT=$$GETOE^SDOE(SDOE)
+5 IF SDOEDAT=""
SET SDSCMSG=" no encounter zero node"
QUIT
+6 ; Get patient IEN.
+7 SET SDPAT=$PIECE(SDOEDAT,U,2)
+8 ; Get visit file entry. If no visit, quit.
+9 SET SDV0=$PIECE(SDOEDAT,U,5)
IF SDV0=""
SET SDSCMSG=" encounter missing visit number"
QUIT
+10 IF $GET(^AUPNVSIT(SDV0,0))=""
SET SDSCMSG=" no visit zero node"
QUIT
+11 ; Get current service connection value from visit.
+12 SET SDOSC=$$GET1^DIQ(9000010,SDV0_",",80001,"I")
+13 ; Get package and source info from visit file. If missing, quit.
+14 SET SDSCPKG=$$GET1^DIQ(9000010,SDV0_",",81202,"E")
IF SDSCPKG=""
SET SDSCPKG="SCHEDULING"
+15 SET SDSCSRC=$$GET1^DIQ(9000010,SDV0_",",81203,"E")
IF SDSCSRC=""
SET SDSCSRC="AUTOMATED SC DESIGNATION"
+16 ; Data checks successful. Set flags to allow edit to continue
+17 SET SDEFLG=1
SET SDFLG=1
+18 QUIT
DISPLAY ; Compile display for the specified encounter into a TMP global.
+1 ; Clear scratch global and reset line counter.
+2 KILL ^TMP("SDSCLST",$JOB)
SET SDLN=0
+3 SET SDTMP="Encounter "_SDOE
+4 IF SDOSC=1
SET SDTMP=SDTMP_" is marked as service connected and may not be."
+5 IF '$TEST
SET SDTMP=SDTMP_" is NOT marked as service connected."
+6 DO LINE(SDTMP)
+7 DO LINE(" ")
+8 ; Display the date for the encounter.
+9 DO LINE("Date of Encounter: "_$$FMTE^XLFDT(SDOEDT,"5MZ"))
+10 ; Display the clinic for the encounter.
+11 SET SDCLIN=$PIECE(SDOEDAT,U,4)
SET SDTMP="Location: "
+12 IF SDCLIN]""
SET SDTMP=SDTMP_$PIECE($GET(^SC(SDCLIN,0)),U)
+13 DO LINE(SDTMP)
+14 ; Display the primary provider for the visit.
+15 SET SDPRV=$PIECE($GET(^SDSC(409.48,SDOE,0)),U,8)
SET SDTMP="Primary Provider: "
+16 IF SDPRV]""
SET SDTMP=SDTMP_$$UP^XLFSTR($$NAME^XUSER(SDPRV))
+17 DO LINE(SDTMP)
+18 ; Display the patient name and last 4 SSN.
+19 SET SDTMP="Patient: "
+20 IF SDPAT]""
Begin DoDot:1
+21 NEW DFN,VADM
SET DFN=SDPAT
DO DEM^VADPT
+22 SET SDTMP=SDTMP_$EXTRACT(VADM(1),1,25)_" ("_$EXTRACT($PIECE(VADM(2),U),6,9)_")"
+23 ; Add flag if patient is considered sensitive.
+24 IF +$PIECE($GET(^DGSL(38.1,+SDPAT,0)),U,2)
SET SDTMP=SDTMP_" *SENSITIVE*"
End DoDot:1
+25 DO LINE(SDTMP)
+26 ; Compile patient insurance information.
+27 DO INS
+28 ; Review VBA/ICD9 SC response
+29 DO VBAICD
+30 ; Compile all POVs for this visit.
+31 DO GETPDX^SDOERPC(.SDPDX,SDOE)
DO POV2S
+32 ; Compile all disabilities for this patient.
+33 DO DIS2S
+34 QUIT
DISPLAY1 ; Display the specified encounter.
+1 WRITE @IOF
+2 SET L=0
+3 FOR SDLN=1:1
if '$DATA(^TMP("SDSCLST",$JOB,SDLN,0))
QUIT
Begin DoDot:1
+4 IF L+3>IOSL
DO CONT^SDSCUTL
SET L=2
if $GET(SDQFLG)=1
QUIT
+5 WRITE !,^TMP("SDSCLST",$JOB,SDLN,0)
+6 SET L=L+1
+7 QUIT
End DoDot:1
if $GET(SDQFLG)=1
QUIT
+8 WRITE !
+9 QUIT
INS ; Compile patient means test and insurance information.
+1 SET SDCP=$$BIL^DGMTUB(SDPAT,SDOEDT)
+2 DO LINE(" ")
+3 DO LINE("Patient "_$SELECT(SDCP=1:"is",1:"is not")_" copay eligible.")
+4 SET SDACT=+$$INSUR^IBBAPI(SDPAT,SDOEDT)
+5 DO LINE("Patient "_$SELECT(SDACT=1:"is",1:"is not")_" insured.")
+6 IF 'SDACT
QUIT
+7 ; ICR#: 4419 (SUPPORTED) - look for Outpatient coverage
+8 SET SDCOV=$SELECT($$INSUR^IBBAPI(SDPAT,SDOEDT,"O","",16)<1:0,1:1)
+9 DO LINE("Outpatient Coverage is "_$SELECT(SDCOV:"",1:"not ")_"covered.")
+10 QUIT
POV2S ; Compile all POV entries for the specified visit.
+1 DO LINE(" ")
DO LINE(" POVs/ICDs:")
+2 SET SDVPOV0=0
FOR
SET SDVPOV0=$ORDER(^AUPNVPOV("AD",SDV0,SDVPOV0))
if 'SDVPOV0
QUIT
Begin DoDot:1
+3 SET SDPOV=$PIECE($GET(^AUPNVPOV(SDVPOV0,0)),U)
+4 ; Added display if diagnosis is marked service connected (CIDC) - ALA 9/27/05
+5 SET SDPOVSC=$PIECE($GET(^AUPNVPOV(SDVPOV0,800)),U)
+6 ;SD*5.3*586
SET SCDX=$$ICDDX^ICDEX(SDPOV,+SDOEDAT,+$$SYS^ICDEX("DIAG",+SDOEDAT,"I"),"I")
+7 SET SDPSC=$SELECT(SDPDX=$PIECE(SCDX,U):"*P* ",1:"")_$SELECT(SDPOVSC=1:"*SC* ",1:"")
+8 SET SDTMP=$JUSTIFY(SDPSC,15)_$PIECE(SCDX,U,2)_" "
+9 SET SDTMP=$EXTRACT(SDTMP,1,23)_$PIECE(SCDX,U,4)
+10 DO LINE(SDTMP)
End DoDot:1
+11 QUIT
DIS2S ; Compile all rated disabilities for this patient.
+1 ;DBIA4807 and DBIA1476
+2 DO LINE(" ")
+3 DO LINE(" Rated Disabilities:")
+4 NEW SCRD,I,I1,I2
+5 DO RDIS^DGRPDB(SDPAT,.SCRD)
+6 SET I=0
FOR
SET I=$ORDER(SCRD(I))
if 'I
QUIT
Begin DoDot:1
+7 SET I1=SCRD(I)
+8 SET I2=$SELECT($DATA(^DIC(31,+I1,0)):$PIECE(^(0),U,3)_" "_$PIECE(^(0),"^",1)_" ("_+$PIECE(I1,"^",2)_"%-"_$SELECT($PIECE(I1,"^",3):"SC",$PIECE(I1,"^",3)']"":"not specified",1:"NSC")_")",1:"")
+9 DO LINE(" "_I2)
End DoDot:1
+10 QUIT
VBAICD ;ASCD (VBA/ICD9) SC evaluation
+1 NEW Y,VAL
+2 DO LINE(" ")
+3 SET Y=$$SC^SDSCAPI(SDPAT,,SDOE)
+4 DO LINE("ASCD Evaluation: "_$PIECE(Y,"^",2))
+5 QUIT
LINE(LINE) ; Save a line of text into the scratch global.
+1 SET SDLN=SDLN+1
SET ^TMP("SDSCLST",$JOB,SDLN,0)=LINE
+2 QUIT
EDIT ; Allow user to edit the specified encounter or send for review. (Roll and scroll)
+1 KILL DIR,X,Y
+2 SET DIR(0)=SDOPT
+3 SET DIR("A")="DO YOU WANT TO CHANGE THE SERVICE CONNECTION FOR THIS ENCOUNTER? "
+4 SET DIR("?")=" "
+5 SET DIR("?",1)="Enter:"
+6 SET DIR("?",2)=" 'YES' to modify this encounter's Service Connected statuses."
+7 SET DIR("?",3)=" 'NO' to retain this encounter's Service Connected statuses."
+8 SET DIR("?",4)=" 'SKIP' to skip this encounter and review it later."
+9 IF SDOPT["REVIEW"
SET DIR("?",5)=" 'REVIEW' to flag this encounter for clinical review."
+10 DO ^DIR
+11 IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDQFLG=1
QUIT
+12 SET SDANS=Y
KILL DIR,X,Y
LEDT ; ListMan Entry Point for Editing
+1 ; If user selected 'SKIP', postpone action on this entry.
+2 IF $GET(SDANS)="S"
QUIT
+3 ; Set 'REVIEW' flag if required.
+4 SET SDRFLG=$SELECT(SDANS="R":1,1:0)
+5 ; Lock record before editing
+6 IF '$$LOCK^SDSCUTL(SDOE)
Begin DoDot:1
+7 WRITE !!,"*** Encounter ",SDOE," locked by another user. Try later. ***"
HANG 2
End DoDot:1
QUIT
+8 ; If user answered 'YES' then send call PCE API.
+9 IF SDANS="Y"
Begin DoDot:1
+10 NEW SDEDIT
SET SDEDIT=1
+11 SET X=$$INTV^PXAPI("POV",SDSCPKG,SDSCSRC,SDV0)
HANG 1
End DoDot:1
+12 ;Entry deleted because of review match
IF '$DATA(^SDSC(409.48,SDOE))
Begin DoDot:1
+13 WRITE !!,"*** Encounter ",SDOE," Removed from ASCD File - True Match Found ***"
HANG 2
End DoDot:1
GOTO CTUP
+14 SET SDSCC=$$GET1^DIQ(9000010,SDV0_",",80001,"I")
+15 ;Remove entry if no SC value
IF SDSCC=""
IF $DATA(^SDSC(409.48,SDOE))
Begin DoDot:1
+16 NEW DA,DIK
SET DA=SDOE
SET DIK="^SDSC(409.48,"
DO ^DIK
+17 WRITE !!,"*** Encounter ",SDOE," Removed from ASCD File - No SC value found in Visit File ***"
HANG 2
End DoDot:1
GOTO CTUP
+18 ; Store any changes the user made in the TRACK EDITS multiple.
+19 DO STEDT^SDSCUTL(SDOE,SDTYPE,SDRFLG,SDSCC)
CTUP ; Update claims tracking file in IB.
+1 Begin DoDot:1
+2 IF '$DATA(^SDSC(409.48,SDOE))
NEW SCTUPD
SET SCTUPD=$$RNBU^IBRSUTL(SDOE,1)
QUIT
+3 DO CLM^SDSCCLM(SDOE)
End DoDot:1
+4 DO UNLOCK^SDSCUTL(SDOE)
+5 QUIT
+6 ;
END ; Clear all variables before exiting.
+1 KILL SDSCTDT,SDEDT,SDOEDT,SDOE,SDOEX,SDEC,SDPAT,SDPASS,SDICD,SDPOV,SDSCC
+2 KILL SDCST,SDSCPKG,SDSCSRC,SDPOVSC,SDPSC,SCDX,SDSCDVSL,SDFILEOK,SDV0
+3 KILL SDVPOV0,SDPD,SDIENS,DA,DIE,DIC,DLAYGO,DIERR,ERR,SDRFLG,SDQFLG,SDTYPE
+4 KILL SDOPT,SDSCTAT,SDSCDIV,SDSCDVLN,SDSCMSG,SDPRV,SDCLIN,SDLIST,P,L,SDABRT
+5 KILL X,X1,X2,Y,DTOUT,DUOUT,DIR,SDACT,SDCOV,SDSCCR,SDOEDAT,SDEFLG,SDOSC,SDCP
+6 KILL SDFLG,SDLN,SDTMP,SDANS,SDSCBDT,SDSCEDT,SDCNT,SDDATA,SDPDX
+7 DO KVA^VADPT
+8 QUIT
