Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDSCEDT

SDSCEDT.m

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