SDSCLM ;ALB/JAM/RBS - ASCD Encounter LISTMAN ; 3/7/07 12:42pm
;;5.3;Scheduling;**495,1015**;Aug 13, 1993;Build 21
;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
;;known as Service Connected Automated Monitoring (SCAM).
;
Q
EN ; -- main entry point for SDSC REVIEW
N SDSCEDIT S SDSCEDIT=1
D EN^VALM("SDSC REVIEW")
Q
;
HDR ; -- header code
S VALMHDR(1)="The Service Connected status needs to be reviewed for the following encounters."
S VALMHDR(2)="Selected Date Range: "_$$FMTE^XLFDT(SDSCBDT,"1Z")_" - "_$$FMTE^XLFDT(SDEDT,"1Z")
S VALMHDR(3)=" "
Q
;
INIT ; -- init variables and list array
;
RBLD ; Rebuild
N SDSCDIV
D CLEAN^VALM10
K ^TMP("SDSCENC",$J),^TMP($J,"SDSCENC")
S SDSCDIV=$S(SDSCDVSL'[SDSCDVLN:","_SDSCDVSL,1:"")
S SDCNT=0
I SDSCTAT'="" D RBLD1
I SDSCTAT="" D S SDSCTAT=""
. F SDSCTAT="N","R","C" D RBLD1
;
; -- set null message
I 'SDCNT D
. D SET^VALM10(1," ")
. D SET^VALM10(2," >>> No Encounter's to review for Date Range selected.")
. S ^TMP($J,"SDSCENC",1)=1,^(2)=2
;
S VALMCNT=$S(SDCNT<1:1,1:SDCNT)
Q
RBLD1 ;
N SDOEDT,SDOEDAT,STATUS,SDOE,SDECDT,SDPAT,X,DFN,SDERR,VADM,SCVST,SDV0
S SDOEDT=SDSCTDT,STATUS=$$EXTERNAL^DILFD(409.48,.05,"F",SDSCTAT,"SDERR")
F S SDOEDT=$O(^SDSC(409.48,"C",SDSCTAT,SDOEDT)) Q:SDOEDT=""!(SDOEDT\1>SDEDT) D
. S SDOE=""
. F S SDOE=$O(^SDSC(409.48,"C",SDSCTAT,SDOEDT,SDOE)) Q:SDOE="" D
.. I SDSCDIV'="",(","_SDSCDIV_",")'[(","_$P(^SDSC(409.48,SDOE,0),U,12)_",") Q
.. S SDOEDAT=$G(^SCE(SDOE,0)) Q:SDOEDAT=""
.. S SDV0=$P(SDOEDAT,U,5),SCVST=$$GET1^DIQ(9000010,SDV0_",",80001,"I")
.. I SCVST'=SCOPT,SCOPT'=2 Q
.. S SDCNT=SDCNT+1
.. S SDECDT=$P(SDOEDAT,U,1),SDPAT=$P(SDOEDAT,U,2)
.. S SDECDT=$$FMTE^XLFDT(SDECDT,"5Z")
.. S DFN=SDPAT D DEM^VADPT
.. S SDPAT=$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")"
.. S X=$$SETFLD^VALM1(SDCNT," ","LINENUM")
.. S X=$$SETFLD^VALM1(SDOE,X,"ENCNO")
.. S X=$$SETFLD^VALM1(SDECDT,X,"ENCDT")
.. S X=$$SETFLD^VALM1(SDPAT,X,"PAT")
.. S X=$$SETFLD^VALM1(STATUS,X,"STAT")
.. S ^TMP($J,"SDSCENC",SDCNT)=SDOE
.. D SET^VALM10(SDCNT,X)
D KVA^VADPT
Q
;
HELP ; -- help code
N X
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K VALMHDR,VALMCNT
K ^TMP("SDSCENC",$J),^TMP($J,"SDSCENC")
K SDCNT,SDEDT,SDSCBDT,SDSCDVLN,SDSCDVSL,SDSCEDT,SDSCTAT,SDSCTDT
Q
;
EXPND ; -- expand code
Q
SDSCLM ;ALB/JAM/RBS - ASCD Encounter LISTMAN ; 3/7/07 12:42pm
+1 ;;5.3;Scheduling;**495,1015**;Aug 13, 1993;Build 21
+2 ;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
+3 ;;known as Service Connected Automated Monitoring (SCAM).
+4 ;
+5 QUIT
EN ; -- main entry point for SDSC REVIEW
+1 NEW SDSCEDIT
SET SDSCEDIT=1
+2 DO EN^VALM("SDSC REVIEW")
+3 QUIT
+4 ;
HDR ; -- header code
+1 SET VALMHDR(1)="The Service Connected status needs to be reviewed for the following encounters."
+2 SET VALMHDR(2)="Selected Date Range: "_$$FMTE^XLFDT(SDSCBDT,"1Z")_" - "_$$FMTE^XLFDT(SDEDT,"1Z")
+3 SET VALMHDR(3)=" "
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 ;
RBLD ; Rebuild
+1 NEW SDSCDIV
+2 DO CLEAN^VALM10
+3 KILL ^TMP("SDSCENC",$JOB),^TMP($JOB,"SDSCENC")
+4 SET SDSCDIV=$SELECT(SDSCDVSL'[SDSCDVLN:","_SDSCDVSL,1:"")
+5 SET SDCNT=0
+6 IF SDSCTAT'=""
DO RBLD1
+7 IF SDSCTAT=""
Begin DoDot:1
+8 FOR SDSCTAT="N","R","C"
DO RBLD1
End DoDot:1
SET SDSCTAT=""
+9 ;
+10 ; -- set null message
+11 IF 'SDCNT
Begin DoDot:1
+12 DO SET^VALM10(1," ")
+13 DO SET^VALM10(2," >>> No Encounter's to review for Date Range selected.")
+14 SET ^TMP($JOB,"SDSCENC",1)=1
SET ^(2)=2
End DoDot:1
+15 ;
+16 SET VALMCNT=$SELECT(SDCNT<1:1,1:SDCNT)
+17 QUIT
RBLD1 ;
+1 NEW SDOEDT,SDOEDAT,STATUS,SDOE,SDECDT,SDPAT,X,DFN,SDERR,VADM,SCVST,SDV0
+2 SET SDOEDT=SDSCTDT
SET STATUS=$$EXTERNAL^DILFD(409.48,.05,"F",SDSCTAT,"SDERR")
+3 FOR
SET SDOEDT=$ORDER(^SDSC(409.48,"C",SDSCTAT,SDOEDT))
IF SDOEDT=""!(SDOEDT\1>SDEDT)
QUIT
Begin DoDot:1
+4 SET SDOE=""
+5 FOR
SET SDOE=$ORDER(^SDSC(409.48,"C",SDSCTAT,SDOEDT,SDOE))
IF SDOE=""
QUIT
Begin DoDot:2
+6 IF SDSCDIV'=""
IF (","_SDSCDIV_",")'[(","_$PIECE(^SDSC(409.48,SDOE,0),U,12)_",")
QUIT
+7 SET SDOEDAT=$GET(^SCE(SDOE,0))
IF SDOEDAT=""
QUIT
+8 SET SDV0=$PIECE(SDOEDAT,U,5)
SET SCVST=$$GET1^DIQ(9000010,SDV0_",",80001,"I")
+9 IF SCVST'=SCOPT
IF SCOPT'=2
QUIT
+10 SET SDCNT=SDCNT+1
+11 SET SDECDT=$PIECE(SDOEDAT,U,1)
SET SDPAT=$PIECE(SDOEDAT,U,2)
+12 SET SDECDT=$$FMTE^XLFDT(SDECDT,"5Z")
+13 SET DFN=SDPAT
DO DEM^VADPT
+14 SET SDPAT=$EXTRACT(VADM(1),1,25)_" ("_$EXTRACT($PIECE(VADM(2),U),6,9)_")"
+15 SET X=$$SETFLD^VALM1(SDCNT," ","LINENUM")
+16 SET X=$$SETFLD^VALM1(SDOE,X,"ENCNO")
+17 SET X=$$SETFLD^VALM1(SDECDT,X,"ENCDT")
+18 SET X=$$SETFLD^VALM1(SDPAT,X,"PAT")
+19 SET X=$$SETFLD^VALM1(STATUS,X,"STAT")
+20 SET ^TMP($JOB,"SDSCENC",SDCNT)=SDOE
+21 DO SET^VALM10(SDCNT,X)
End DoDot:2
End DoDot:1
+22 DO KVA^VADPT
+23 QUIT
+24 ;
HELP ; -- help code
+1 NEW X
+2 SET X="?"
DO DISP^XQORM1
WRITE !!
+3 QUIT
+4 ;
EXIT ; -- exit code
+1 KILL VALMHDR,VALMCNT
+2 KILL ^TMP("SDSCENC",$JOB),^TMP($JOB,"SDSCENC")
+3 KILL SDCNT,SDEDT,SDSCBDT,SDSCDVLN,SDSCDVSL,SDSCEDT,SDSCTAT,SDSCTDT
+4 QUIT
+5 ;
EXPND ; -- expand code
+1 QUIT
