| 1 | SD53396P ;VMP/RB - POST INIT FOR PATCH SD*5.3*396 ;09/30/04
|
|---|
| 2 | ;;5.3;Scheduling;**396**;AUG 13,1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;Post init routine to locate ^SCE encounters that have a app't
|
|---|
| 5 | ;status of pending action (14), BUT a status of 'I' in
|
|---|
| 6 | ;the associated ^DPT(DFN,"S") node. The app't status will be
|
|---|
| 7 | ;modified to '8' if condition found.
|
|---|
| 8 | TASK ;
|
|---|
| 9 | ; Task the initial bad data determination as background process
|
|---|
| 10 | ;
|
|---|
| 11 | D NOW^%DTC
|
|---|
| 12 | ;Task process
|
|---|
| 13 | S ZTDTH=%H
|
|---|
| 14 | S ZTIO=""
|
|---|
| 15 | S ZTRTN="INIT^SD53396P",ZTDESC="^SCE O/P encounter status check for inpatients"
|
|---|
| 16 | D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
|
|---|
| 17 | I $D(ZTSK)&('$D(ZTQUEUED)) D BMES^XPDUTL("Task Queued!")
|
|---|
| 18 | Q
|
|---|
| 19 | INIT ;
|
|---|
| 20 | ; Drives through ^SCE and finds all invalid entries.
|
|---|
| 21 | ; If entries are found to be invalid the entry is corrected
|
|---|
| 22 | ; and stored in temp print file
|
|---|
| 23 | ;
|
|---|
| 24 | N IEN,DFN,DATA,ESTS,SDAT,U,PDATE,SCHD,SSTS
|
|---|
| 25 | D NOW^%DTC
|
|---|
| 26 | S PDATE=+%H+60,U="^"
|
|---|
| 27 | S PDATE=$$HTFM^XLFDT(PDATE)
|
|---|
| 28 | L +^XTMP("SD53396P",0):1 I '$T Q
|
|---|
| 29 | K ^XTMP("SD53396P")
|
|---|
| 30 | S ^XTMP("SD53396P",0)=PDATE_"^"_X_"^"_"SCE encounter Clean Utility"
|
|---|
| 31 | L -^XTMP("SD53396P",0)
|
|---|
| 32 | S IEN=0
|
|---|
| 33 | F S IEN=$O(^SCE(IEN)) Q:IEN=""!'IEN D
|
|---|
| 34 | .S DATA=$G(^SCE(IEN,0)),SDAT=+$E($P(DATA,U),1,12),DFN=$P(DATA,U,2),ESTS=$P(DATA,U,12)
|
|---|
| 35 | .Q:ESTS'=14!'DFN
|
|---|
| 36 | .S SCHD=$G(^DPT(DFN,"S",SDAT,0)),SSTS=$P(SCHD,U,2)
|
|---|
| 37 | .Q:SSTS'="I"
|
|---|
| 38 | .S ^XTMP("SD53396P",IEN,0)=DFN_"^"_SDAT_"^"_ESTS_"^"_SSTS,^XTMP("SD53396P",IEN,1)=DATA,^XTMP("SD53396P",IEN,2)=SCHD
|
|---|
| 39 | .S $P(^SCE(IEN,0),U,12)=8
|
|---|
| 40 | .W !,IEN,?15,DFN,?30,SDAT,?50,ESTS,"/",SSTS
|
|---|
| 41 | S ZTREQ="@",^XTMP("SD53396P")="@"
|
|---|
| 42 | Q
|
|---|
| 43 | REPORT ;
|
|---|
| 44 | ; Reports the entries that are have been cleaned up by the cleaning process
|
|---|
| 45 | ;
|
|---|
| 46 | I '$D(^XTMP("SD53396P")) W !!,"COMPILE AUDIT NOT RUN" Q
|
|---|
| 47 | I $G(^XTMP("SD53396P"))'="@" W !!,"COMPILE NOT COMPLETED" Q
|
|---|
| 48 | N POP,REC,DATA
|
|---|
| 49 | D ^%ZIS
|
|---|
| 50 | Q:POP
|
|---|
| 51 | I '$O(^XTMP("SD53396P",0)) W !!,"** NO ERRORS DETECTED **" Q
|
|---|
| 52 | W !!,"List of entries that SD*5.3*396 has determined to be incorrect AND FIXED",!!
|
|---|
| 53 | W "IEN",?10,"DFN",?20,"SCHED DT",?34,"STS",!
|
|---|
| 54 | S REC=0
|
|---|
| 55 | F S REC=$O(^XTMP("SD53396P",REC)) Q:REC="" D
|
|---|
| 56 | .S DATA=^XTMP("SD53396P",REC,0)
|
|---|
| 57 | .W !,REC,?10,$P(DATA,U),?20,$P(DATA,U,2),?34,$P(DATA,U,3),"/",$P(DATA,U,4),?40,$P(^DPT($P(DATA,U),0),U)
|
|---|
| 58 | . W !,?3,"SCE: ",$E(^XTMP("SD53396P",REC,1),1,70)
|
|---|
| 59 | . W !,?3,"DPT: ",$E(^XTMP("SD53396P",REC,2),1,70)
|
|---|
| 60 | Q
|
|---|
