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