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

SDSCUTL.m

Go to the documentation of this file.
  1. SDSCUTL ;ALB/JAM/RBS - ASCD Utility Program ; 4/24/07 4:26pm
  1. ;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
  1. ;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
  1. ;;known as Service Connected Automated Monitoring (SCAM).
  1. ;
  1. Q
  1. ;
  1. TYPE ; Select proper user type based on security key.
  1. ; called by routines: SDSCEDT,SDSCLST,SDSCMSR,SDSCRP1,SDSCSSD
  1. ; sets variables: SDTYPE,SDSCTAT,SDOPT,SDSCCR
  1. ; (should be killed by calling routines)
  1. I $G(SDTYPE)=""!($G(SDSCTAT)="")!($G(SDOPT)="") D
  1. . I $D(^XUSEC("SDSC SUPER",DUZ)) D Q
  1. .. ; Supervisor can look at encounters with any status.
  1. .. S SDTYPE="S",SDSCTAT="",SDOPT="SA^Y:YES;N:NO;S:SKIP;R:REVIEW"
  1. .. S SDSCCR=""
  1. .. Q
  1. . I $D(^XUSEC("SDSC CLINICAL",DUZ)) D Q
  1. .. ; Clinician can only look at encounters with a status of REVIEW.
  1. .. S SDTYPE="C",SDSCTAT="R",SDOPT="SA^Y:YES;N:NO;S:SKIP;R:REVIEW"
  1. .. S SDSCCR="I $P(^(0),U,5)=SDSCTAT"
  1. .. Q
  1. . ; User (default) can only look at encounters with a status of NEW.
  1. . S SDTYPE="U",SDSCTAT="N",SDOPT="SA^Y:YES;N:NO;S:SKIP;R:REVIEW"
  1. . S SDSCCR="I $P(^(0),U,5)=SDSCTAT"
  1. . Q
  1. Q
  1. ;
  1. NBFP(SDOE) ; Is first-party non-billable based on either clinic, stop code, or patient?
  1. N SDOE0,SDPAT,SDOEDT
  1. I $G(SDOE)="" Q 0
  1. S SDOE0=$$GETOE^SDOE(SDOE),SDPAT=$P(SDOE0,U,2),SDOEDT=+SDOE0
  1. I '+$$FIRST^IBRSUTL(SDOE) Q 1
  1. Q 0
  1. ;
  1. NBTP(SDOE) ; Is third-party non-billable based on either clinic, stop code, or patient?
  1. N SDOE0,SDPAT,SDOEDT,SDCOV
  1. I $G(SDOE)="" Q 0
  1. S SDOE0=$$GETOE^SDOE(SDOE),SDPAT=$P(SDOE0,U,2),SDOEDT=+SDOE0
  1. I '+$$THIRD^IBRSUTL(SDOE) Q 1
  1. ; ICR#: 4419 (SUPPORTED) - look for Outpatient coverage
  1. S SDCOV=$S($$INSUR^IBBAPI(SDPAT,SDOEDT,"O","",16)<1:0,1:1)
  1. I 'SDCOV Q 1
  1. Q 0
  1. ;
  1. SENS(SDFN,SDFLG) ; Check for Sensitive Patient
  1. ; Input
  1. ; SDFN - Patient IEN
  1. ; SDFLG - '1' if called from ListMan edit
  1. ; - '0' if called from roll-and-scroll
  1. ; Returns
  1. ; '0' - OK to view (patient is not sensitive, user has key, or answered 'OK')
  1. ; '1' - not OK to view patient (patient is sensitive, user does not have key and answered 'NO')
  1. ;
  1. N SDANS
  1. S SDANS=0
  1. I +$P($G(^DGSL(38.1,+SDFN,0)),U,2) D
  1. . NEW DIC,Y,DFN,X,VADM
  1. . S DFN=SDFN D DEM^VADPT
  1. . I $G(SDFLG)=0 W !!,$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")",!!
  1. . I $G(SDFLG)=1 D FULL^VALM1
  1. . S DIC(0)="AE",Y=SDFN
  1. . D ^DGSEC
  1. . I Y<0 S SDANS=1
  1. . I $D(^XUSEC("DG SENSITIVITY",DUZ)) D
  1. .. ; If user holds key, prevent sensitive patient warning from scrolling off screen
  1. .. N DIR W ! S DIR(0)="E" D ^DIR
  1. .D KVA^VADPT
  1. Q SDANS
  1. ;
  1. DIV ; Ask for Division
  1. N SDN
  1. S SDN=0
  1. F S SDN=$O(^DG(40.8,SDN)) Q:'SDN D
  1. . S DIR("A",SDN)=SDN_" "_$P(^DG(40.8,SDN,0),"^",1)
  1. . S SCLN=SDN
  1. S SCLN=SCLN+1,DIR("A",SCLN)=SCLN_" ALL"
  1. S DIR(0)="L^1:"_SCLN,DIR("B")=SCLN
  1. S DIR("A")="Select DIVISION"
  1. Q
  1. ;
  1. SRV ; Ask for Clinic Service
  1. N TDIR
  1. S TDIR="M:MEDICINE;S:SURGERY;P:PSYCHIATRY;R:REHAB MEDICINE;N:NEUROLOGY;0:NONE;"
  1. S TDIR=TDIR_"A:ALL"
  1. S DIR(0)="S^"_TDIR,DIR("A")="Select SERVICE"
  1. Q
  1. ;
  1. STEDT(SDOE,SDTYPE,SDRFLG,SDSCC) ; Store the TRACK EDITS multiple for encounter
  1. ; Input:
  1. ; SDOE - Encounter IEN
  1. ; SDTYPE - Type of User - (Supervisor, Clinician, User)
  1. ; SDRFLG - Review flag var
  1. ; SDSCC - visit file service connected value (1/0)
  1. ;
  1. ; Output: none
  1. ;
  1. ; First add a new entry to the multiple.
  1. Q:'$G(SDOE)
  1. N DD,DO,X,DA,DIC,DIE,DLAYGO,SDIENS,SDPD,SDVBA,ERR
  1. I '$D(^SDSC(409.48,SDOE,1,0)) S ^SDSC(409.48,SDOE,1,0)="^409.481^^"
  1. S X=$P(^SDSC(409.48,SDOE,1,0),U,3)+1
  1. S DA(1)=SDOE,DA=X,DIC="^SDSC(409.48,"_DA(1)_",1,",DIE=DIC
  1. S DLAYGO=409.481,DIC("P")=DLAYGO,DIC(0)="L"
  1. K DD,DO
  1. D FILE^DICN
  1. K DD,DO
  1. ; Next update the fields within the multiple.
  1. S SDIENS=$$IENS^DILF(.DA)
  1. S SDPD(409.481,SDIENS,.02)=DT
  1. S SDPD(409.481,SDIENS,.03)=DUZ
  1. S SDPD(409.481,SDIENS,.04)=$G(SDTYPE)
  1. ; If user answered "REVIEW", set the review flag to "YES".
  1. ; Else, set SERV. CONNECT (OK BY USER?) field with current SC status.
  1. I $G(SDRFLG)=1 S SDPD(409.481,SDIENS,.06)=1
  1. E S SDPD(409.481,SDIENS,.05)=$G(SDSCC)
  1. D FILE^DIE("","SDPD","ERR")
  1. ;
  1. ; -- If not "REVIEW" flag,
  1. ; Set file;field (#409.48;.09) SERV. CONNECT (OK BY VBA/ICD?)
  1. ; equal to the VBA/ICD9 match result.
  1. I '$G(SDRFLG) D
  1. . K SDPD,ERR
  1. . S SDVBA=$$SC^SDSCAPI(,,SDOE)
  1. . S SDPD(409.48,SDOE_",",.09)=$P(SDVBA,U,3)
  1. . D FILE^DIE("","SDPD","ERR")
  1. Q
  1. ;
  1. CONT ; Standard press RETURN to continue prompt.
  1. N DIR,X,Y,DTOUT,DUOUT
  1. S DIR(0)="EA"
  1. S DIR("A")="Enter RETURN to continue "
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) S SDQFLG=1
  1. W @IOF,!,"Encounter ",SDOE," (cont'd)"
  1. Q
  1. ;
  1. ANCPKG(SCEIEN) ;check if visit came from an ancillary package & if to continue
  1. N PCEIEN,DIR,DA,X,Y
  1. I '$G(SCEIEN) Q 1
  1. S PCEIEN=$P($$GETOE^SDOE(SCEIEN),"^",5) I 'PCEIEN Q 1
  1. I $P($G(^AUPNVSIT(PCEIEN,150)),"^",3)'="A" Q 1
  1. W $C(7)
  1. S DIR("A",1)="WARNING: This encounter came from another package. If it is changed"
  1. S DIR("A",2)=" it will not agree with what is in the originating package."
  1. S DIR("A",3)=" "
  1. S DIR("A")="Do you want to continue with this encounter"
  1. S DIR("B")="YES",DIR(0)="Y"
  1. D ^DIR
  1. Q $S(Y:1,Y<0:1,1:0)
  1. NCTCL(SDCLIN) ;Checks if a non-count clinic
  1. I $P($G(^SC(+SDCLIN,0)),U,17)="Y" Q 1
  1. Q 0
  1. SCHNG(SDOE) ;Checks if a completed encounter SC value was changed.
  1. ;Input: SDOE - Encounter IEN
  1. ;Output: SC Changed^Orignal Value(1 or 0)^Last Value(1 or 0)
  1. ; SC Changed: 0-no change, 1-change
  1. ; Null is return if invalid
  1. N SDVAL,SDORG,SDUSR
  1. I $G(SDOE)="" Q ""
  1. S SDVAL=$G(^SDSC(409.48,SDOE,0)) I SDVAL="" Q ""
  1. I $P(SDVAL,"^",5)'="C" Q ""
  1. S SDORG=$P(SDVAL,U,13),SDUSR=$P(SDVAL,U,6)
  1. I SDORG="" S SDORG=1
  1. Q $S(SDORG=SDUSR:0,1:1)_U_SDORG_U_SDUSR
  1. ;
  1. LOCK(SCIEN) ;Locks an ASCD record.
  1. ; This function locks an ASCD so as to prevent another process from
  1. ; editing the same record.
  1. ; Input: SCIEN - IEN of record in file #409.48
  1. ;
  1. ; Output: Returns 1 if lock was successful, 0 otherwise
  1. ;
  1. I $G(SCIEN) L +^SDSC(409.48,SCIEN):5
  1. Q $T
  1. ;
  1. UNLOCK(SCIEN) ;Unlocks an ASCD record.
  1. ; This function releases the lock on an ASCD record created by $$LOCK.
  1. ; Input: SCIEN - IEN of record in file #409.48
  1. ;
  1. ; Output: None
  1. ;
  1. I $G(SCIEN) L -^SDSC(409.48,SCIEN)
  1. Q
  1. ;
  1. SCSEL() ;Prompts for the type of service connection records to review.
  1. ; Input: No input required
  1. ; Output: 1 - SC, 0 - NSC, 2 - All and "" (null)
  1. N DIR
  1. W !,"Service Connected Encounters Review Selection"
  1. S DIR(0)="SO^S:Service Connected;N:Non-Service Connected;A:All"
  1. S DIR("B")="S",DIR("A")="Which type do you want to review?"
  1. D ^DIR I $D(DIRUT) Q ""
  1. Q $S(Y="S":1,Y="N":0,1:2)