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