| [613] | 1 | SDSCNSCP ;ALB/JAM - ASCD NSC Encounters Purge ; 4/24/07 4:29pm
|
|---|
| 2 | ;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
|
|---|
| 3 | ;
|
|---|
| 4 | ;**Program Description**
|
|---|
| 5 | ; This program will purge encounters with a status of NEW where
|
|---|
| 6 | ; the Visit SC value equals the ASCD value of "NO" for a specified
|
|---|
| 7 | ; division(s) with and a user defined date range. Users must have
|
|---|
| 8 | ; the SDSC SUPER key to run this option.
|
|---|
| 9 | Q
|
|---|
| 10 | EN ; Entry Point
|
|---|
| 11 | N ZTQUEUED,POP,ZTRTN,ZTDTH,ZTDESC,ZTSAVE,SDSCDVSL,SDSCDVLN,DIR,X,Y
|
|---|
| 12 | N DTOUT,DUOUT
|
|---|
| 13 | ; Get start and end date for encounter list.
|
|---|
| 14 | D GETDATE^SDSCOMP I SDSCTDT="" G EXIT
|
|---|
| 15 | ; Ask for division
|
|---|
| 16 | D DIV^SDSCUTL
|
|---|
| 17 | D ^DIR
|
|---|
| 18 | I $G(DTOUT)!($G(DUOUT)) G EXIT
|
|---|
| 19 | S SDSCDVSL=Y,SDSCDVLN=SCLN
|
|---|
| 20 | K SCLN,DIR
|
|---|
| 21 | ; Determine type of user
|
|---|
| 22 | D TYPE^SDSCUTL
|
|---|
| 23 | I SDTYPE'="S" W !!,"You do not have privileges to run this report." Q
|
|---|
| 24 | W !!,"This option will permanently remove the outpatient encounters that are at a"
|
|---|
| 25 | W !,"NEW status when both the Encounter SC value and the ASCD value are 'NO' from"
|
|---|
| 26 | W !,"the SDSC SERVICE CONNECTED CHANGES file (#409.48).",!
|
|---|
| 27 | S DIR(0)="Y",DIR("A")="Are you sure you want to continue",DIR("B")="N"
|
|---|
| 28 | S DIR("?")="YES to remove encounters from the Review file, NO to Exit."
|
|---|
| 29 | D ^DIR
|
|---|
| 30 | I ('Y)!($G(DTOUT))!($G(DUOUT)) G EXIT
|
|---|
| 31 | ;
|
|---|
| 32 | K %ZIS,IOP,IOC,ZTIO S %ZIS="QM" D ^%ZIS G:POP EXIT
|
|---|
| 33 | I $D(IO("Q")) D G EXIT
|
|---|
| 34 | . S ZTRTN="BEG^SDSCNSCP",ZTDTH=$H,ZTDESC="Purge ASCD NSC Encounters"
|
|---|
| 35 | . S ZTSAVE("SDSCDVSL")="",ZTSAVE("SDSCDVLN")="",ZTSAVE("SDEDT")=""
|
|---|
| 36 | . S ZTSAVE("SDSCTDT")="",ZTIO=ION
|
|---|
| 37 | . K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED"
|
|---|
| 38 | ;
|
|---|
| 39 | BEG ; Begin report
|
|---|
| 40 | N SDSCDIV,SDSCDNM,SDI,SDGTOT,SDPG
|
|---|
| 41 | S SDGTOT=0,SDPG=1
|
|---|
| 42 | S SDSCDIV=$S(SDSCDVSL'[SDSCDVLN:SDSCDVSL,1:"")
|
|---|
| 43 | I SDSCDIV="" S SDSCDNM="ALL" D FND G EXIT
|
|---|
| 44 | I SDSCDIV'="" D
|
|---|
| 45 | . F SDI=1:1:$L(SDSCDVSL,",") S SDSCDIV=$P(SDSCDVSL,",",SDI) Q:SDSCDIV="" D
|
|---|
| 46 | .. S SDSCDNM=$P(^DG(40.8,SDSCDIV,0),"^",1)
|
|---|
| 47 | .. D FND
|
|---|
| 48 | W !!,"Grand total of NSC Records Purged: ",SDGTOT
|
|---|
| 49 | G EXIT
|
|---|
| 50 | ;
|
|---|
| 51 | FND ; Find records and delete
|
|---|
| 52 | N SDOEDT,SDOE0,SDEDIV,SDOE,SDSCDATA,SDL,SDV0,SDPRV,SCVST,SDCNT,DFN,DIK,DA
|
|---|
| 53 | ;
|
|---|
| 54 | D HDR
|
|---|
| 55 | S SDOEDT=SDSCTDT-1,(SDL,SDCNT)=0
|
|---|
| 56 | F S SDOEDT=$O(^SDSC(409.48,"AE",SDOEDT)) Q:SDOEDT\1>SDEDT!(SDOEDT="") D
|
|---|
| 57 | . S SDOE=""
|
|---|
| 58 | . F S SDOE=$O(^SDSC(409.48,"AE",SDOEDT,SDOE)) Q:SDOE="" D
|
|---|
| 59 | .. S SDOE0=$$GETOE^SDOE(SDOE),SDSCDATA=$G(^SDSC(409.48,SDOE,0))
|
|---|
| 60 | .. Q:SDOE0="" Q:SDSCDATA=""
|
|---|
| 61 | .. ; Check if status is NEW
|
|---|
| 62 | .. I $P(SDSCDATA,U,5)'="N" Q
|
|---|
| 63 | .. S SDEDIV=$P(SDSCDATA,U,12) Q:SDEDIV=""
|
|---|
| 64 | .. I SDSCDIV'="" Q:SDEDIV'=SDSCDIV
|
|---|
| 65 | .. ; Check for ASCD SC value
|
|---|
| 66 | .. I $P(SDSCDATA,U,9)'=0 Q
|
|---|
| 67 | .. ; Check for Visit SC value
|
|---|
| 68 | .. S SDV0=$P(SDOE0,U,5),SCVST=$$GET1^DIQ(9000010,SDV0_",",80001,"I")
|
|---|
| 69 | .. I SCVST'=0 Q
|
|---|
| 70 | .. S DFN=$P(SDOE0,U,"2Z") D DEM^VADPT
|
|---|
| 71 | .. S SDCNT=SDCNT+1,SDGTOT=SDGTOT+1,SCVST=$S(SCVST:"Y",SCVST=0:"NO",1:"")
|
|---|
| 72 | .. S SDPRV=$$GET1^DIQ(200,$$PRIMVPRV^PXUTL1(SDV0)_",",.01,"E"),SDL=SDL+1
|
|---|
| 73 | .. W !,$$FMTE^XLFDT(SDOEDT,2),?16,SDOE,?30,$E(VADM(1),1,25),?55,$E(SDPRV,1,19),?75,SCVST
|
|---|
| 74 | .. S DIK="^SDSC(409.48,",DA=SDOE D ^DIK
|
|---|
| 75 | .. D KVA^VADPT
|
|---|
| 76 | .. I $E(IOST,1,2)'="C-",SDL+4>IOSL D HDR
|
|---|
| 77 | W !!,"Number of NSC Records Purged: ",SDCNT," for "_SDSCDNM
|
|---|
| 78 | Q
|
|---|
| 79 | ;
|
|---|
| 80 | HDR ; Print report
|
|---|
| 81 | N SDHDR,I
|
|---|
| 82 | S SDHDR="Purge ASCD NSC Encounters"
|
|---|
| 83 | W @IOF
|
|---|
| 84 | W SDHDR,?67,"PAGE: ",SDPG
|
|---|
| 85 | W !,?5,"For Encounters Dated ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)," For Division: ",SDSCDNM,!!
|
|---|
| 86 | W "Encounter Date",?16,"Encounter No.",?30,"Patient Name",?55,"Provider",?73,"SC Val"
|
|---|
| 87 | W ! F I=1:1:79 W "-"
|
|---|
| 88 | S SDPG=SDPG+1
|
|---|
| 89 | Q
|
|---|
| 90 | ;
|
|---|
| 91 | EXIT ;clean up variables before exiting option
|
|---|
| 92 | K SDEDT,SDOPT,SDSCBDT,SDSCCR,SDSCEDT,SDSCTAT,SDSCTDT,SDTYPE
|
|---|
| 93 | Q
|
|---|
