- 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 Feb 19, 2025@00:27:54 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)