SDSCLST ;ALB/JAM/RBS - ASCD Review List ; 4/24/07 4:29pm
;;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).
;
;**Program Description**
; This program will build a list of entries to review
Q
EN ; Entry Point
N DIR,X,Y,DTOUT,DUOUT
; Ask which records should be reviewed.
S SCOPT=$$SCSEL^SDSCUTL()
I SCOPT="" G EXIT
; Get start and end date for encounter list.
D GETDATE^SDSCOMP I SDSCTDT="" G EXIT
; Ask for division
D DIV^SDSCUTL
D ^DIR
I $G(DTOUT)!($G(DUOUT)) G EXIT
S SDSCDVSL=Y,SDSCDVLN=SCLN
K SCLN,DIR
; Determine type of user
D TYPE^SDSCUTL
; Call ListMan Screen
D EN^SDSCLM
;
EXIT D END^SDSCEDT
K EXIT,VALMBCK,VALMSG,SDCNT,SDEDT,SDSCBDT,SDSCDVLN,SDSCDVSL,SDSCEDT
K SDSCTAT,SDSCTDT,SDANS,SCOPT
Q
;
SEL ; Select entry to review
N DIR,SDSCMSG,DFN,SDOE,SDOE0,IEN,SDOEDT,SDEFLG
S DIR("A")="Select Number to Review"
S DIR(0)="NO^1:"_SDCNT D ^DIR K DIR
I $D(DIRUT) K DIRUT D EXT Q
I $G(DUOUT)!($G(DTOUT)) D EXT Q
I $G(Y)<1 D EXT Q
S IEN=^TMP($J,"SDSCENC",Y)
; Call display build
S SDOE=IEN,SDOE0=$$GETOE^SDOE(SDOE),SDOEDT=$P(SDOE0,U)
I SDOEDT="" S VALMSG="Encounter has been deleted.",VALMBCK="R" Q
I $$STDGET^SDSCRPT1() D Q:'SDEFLG
. S SDEFLG=0 D CHECK^SDSCEDT
. I 'SDEFLG S VALMSG="Cannot edit."_$G(SDSCMSG),VALMBCK="R" Q
. D DISPLAY^SDSCEDT
;Check if data came from an ancillary package and okay to edit
I '$$ANCPKG^SDSCUTL(IEN) S VALMSG="Cannot edit encounter.",VALMBCK="R" Q
; Check for sensitive patient and call ListMan if OK
S DFN=$P(SDOE0,U,2)
I DFN="" S VALMSG="Encounter has been deleted.",VALMBCK="R" Q
I '$$SENS^SDSCUTL(DFN,1) D EN^SDSCLM1
D RBLD^SDSCLM
S VALMBCK="R"
Q
;
EXT ; Exit
S VALMBCK=""
S EXIT=1
Q
;
EDT ; Edit SC Flag
S SDANS="Y"
D LEDT^SDSCEDT
S VALMBCK="Q"
Q
;
REV ; Send to Review
S SDANS="R"
D LEDT^SDSCEDT
S VALMBCK="Q"
Q
;
ACC ; Accept SC Flag
S SDANS="N"
D LEDT^SDSCEDT
S VALMBCK="Q"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDSCLST 2097 printed Apr 09, 2024@22:00:39 Page 2
SDSCLST ;ALB/JAM/RBS - ASCD Review List ; 4/24/07 4:29pm
+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 ;**Program Description**
+6 ; This program will build a list of entries to review
+7 QUIT
EN ; Entry Point
+1 NEW DIR,X,Y,DTOUT,DUOUT
+2 ; Ask which records should be reviewed.
+3 SET SCOPT=$$SCSEL^SDSCUTL()
+4 IF SCOPT=""
GOTO EXIT
+5 ; Get start and end date for encounter list.
+6 DO GETDATE^SDSCOMP
IF SDSCTDT=""
GOTO EXIT
+7 ; Ask for division
+8 DO DIV^SDSCUTL
+9 DO ^DIR
+10 IF $GET(DTOUT)!($GET(DUOUT))
GOTO EXIT
+11 SET SDSCDVSL=Y
SET SDSCDVLN=SCLN
+12 KILL SCLN,DIR
+13 ; Determine type of user
+14 DO TYPE^SDSCUTL
+15 ; Call ListMan Screen
+16 DO EN^SDSCLM
+17 ;
EXIT DO END^SDSCEDT
+1 KILL EXIT,VALMBCK,VALMSG,SDCNT,SDEDT,SDSCBDT,SDSCDVLN,SDSCDVSL,SDSCEDT
+2 KILL SDSCTAT,SDSCTDT,SDANS,SCOPT
+3 QUIT
+4 ;
SEL ; Select entry to review
+1 NEW DIR,SDSCMSG,DFN,SDOE,SDOE0,IEN,SDOEDT,SDEFLG
+2 SET DIR("A")="Select Number to Review"
+3 SET DIR(0)="NO^1:"_SDCNT
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
KILL DIRUT
DO EXT
QUIT
+5 IF $GET(DUOUT)!($GET(DTOUT))
DO EXT
QUIT
+6 IF $GET(Y)<1
DO EXT
QUIT
+7 SET IEN=^TMP($JOB,"SDSCENC",Y)
+8 ; Call display build
+9 SET SDOE=IEN
SET SDOE0=$$GETOE^SDOE(SDOE)
SET SDOEDT=$PIECE(SDOE0,U)
+10 IF SDOEDT=""
SET VALMSG="Encounter has been deleted."
SET VALMBCK="R"
QUIT
+11 IF $$STDGET^SDSCRPT1()
Begin DoDot:1
+12 SET SDEFLG=0
DO CHECK^SDSCEDT
+13 IF 'SDEFLG
SET VALMSG="Cannot edit."_$GET(SDSCMSG)
SET VALMBCK="R"
QUIT
+14 DO DISPLAY^SDSCEDT
End DoDot:1
if 'SDEFLG
QUIT
+15 ;Check if data came from an ancillary package and okay to edit
+16 IF '$$ANCPKG^SDSCUTL(IEN)
SET VALMSG="Cannot edit encounter."
SET VALMBCK="R"
QUIT
+17 ; Check for sensitive patient and call ListMan if OK
+18 SET DFN=$PIECE(SDOE0,U,2)
+19 IF DFN=""
SET VALMSG="Encounter has been deleted."
SET VALMBCK="R"
QUIT
+20 IF '$$SENS^SDSCUTL(DFN,1)
DO EN^SDSCLM1
+21 DO RBLD^SDSCLM
+22 SET VALMBCK="R"
+23 QUIT
+24 ;
EXT ; Exit
+1 SET VALMBCK=""
+2 SET EXIT=1
+3 QUIT
+4 ;
EDT ; Edit SC Flag
+1 SET SDANS="Y"
+2 DO LEDT^SDSCEDT
+3 SET VALMBCK="Q"
+4 QUIT
+5 ;
REV ; Send to Review
+1 SET SDANS="R"
+2 DO LEDT^SDSCEDT
+3 SET VALMBCK="Q"
+4 QUIT
+5 ;
ACC ; Accept SC Flag
+1 SET SDANS="N"
+2 DO LEDT^SDSCEDT
+3 SET VALMBCK="Q"
+4 QUIT
