- 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