| [613] | 1 | SDSCPRG ;ALB/JAM/RBS - ASCD Purge encounters that have been deleted ; 1/19/07 12:39pm
|
|---|
| 2 | ;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
|
|---|
| 3 | ;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
|
|---|
| 4 | ;;known as Service Connected Automated Monitoring (SCAM).
|
|---|
| 5 | ;
|
|---|
| 6 | ;**Program Description**
|
|---|
| 7 | ; This program will check to see if an encounter in the
|
|---|
| 8 | ; SD SERVICE CONNECTED CHANGES File (#409.48)
|
|---|
| 9 | ; has been deleted from the OUTPATIENT ENCOUNTER file (#409.68) and
|
|---|
| 10 | ; remove that record from file #409.48.
|
|---|
| 11 | Q
|
|---|
| 12 | EN ; Entry point
|
|---|
| 13 | N SDOE,NOACT,ACT,NCNT,WCNT,DA,DIK,LINE,SDI,SDJ,CNT
|
|---|
| 14 | K ^TMP("SDSCPRG",$J),^TMP("SDSCPMSG",$J)
|
|---|
| 15 | S DIK="^SDSC(409.48,",(SDOE,NOACT,ACT)=0,(NCNT,WCNT)=1
|
|---|
| 16 | F S SDOE=$O(^SDSC(409.48,SDOE)) Q:'SDOE D
|
|---|
| 17 | . I $$GETOE^SDOE(SDOE)="" D
|
|---|
| 18 | .. K ATEXT
|
|---|
| 19 | .. D GETS^DIQ(409.48,SDOE,"**","E","ATEXT")
|
|---|
| 20 | .. ; Initialize message
|
|---|
| 21 | .. S ^TMP("SDSCPRG",$J,"NO",1,0)="Encounters with No Action Taken: "_NOACT
|
|---|
| 22 | .. S ^TMP("SDSCPRG",$J,"WITH",1,0)="Encounters with Actions Taken: "_ACT
|
|---|
| 23 | .. I $D(ATEXT(409.481))>0 S ACT=ACT+1,^TMP("SDSCPRG",$J,"WITH",1,0)="Encounters with Actions Taken: "_ACT
|
|---|
| 24 | .. I $D(ATEXT(409.481))'>0 D Q
|
|---|
| 25 | ... S NOACT=NOACT+1,^TMP("SDSCPRG",$J,"NO",1,0)="Encounters with No Action Taken: "_NOACT
|
|---|
| 26 | ... S NCNT=NCNT+1
|
|---|
| 27 | ... S LINE=" " F SDI=".07",".11",".05" S LINE=LINE_$G(ATEXT(409.48,SDOE_",",SDI,"E"))_"-"
|
|---|
| 28 | ... I $E(LINE,$L(LINE),$L(LINE))="-" S LINE=$E(LINE,1,$L(LINE)-1)
|
|---|
| 29 | ... S ^TMP("SDSCPRG",$J,"NO",NCNT,0)=LINE_"-Enc #: "_SDOE
|
|---|
| 30 | ... S DA=SDOE D ^DIK
|
|---|
| 31 | .. ; Set information into ^TMP for report
|
|---|
| 32 | .. S WCNT=WCNT+1
|
|---|
| 33 | .. S LINE=" " F SDI=".07",".11",".05" S LINE=LINE_$G(ATEXT(409.48,SDOE_",",SDI,"E"))_"-"
|
|---|
| 34 | .. I $E(LINE,$L(LINE),$L(LINE))="-" S LINE=$E(LINE,1,$L(LINE)-1)
|
|---|
| 35 | .. S ^TMP("SDSCPRG",$J,"WITH",WCNT,0)=LINE_"-Enc #: "_SDOE
|
|---|
| 36 | .. S SDJ=SDOE F S SDJ=$O(ATEXT(409.481,SDJ)) Q:SDJ="" D
|
|---|
| 37 | ... S LINE=" ",WCNT=WCNT+1
|
|---|
| 38 | ... F SDI=".03",".02",".04" S LINE=LINE_$G(ATEXT(409.481,SDJ,SDI,"E"))_"-"
|
|---|
| 39 | ... I $G(ATEXT(409.481,SDJ,".06","E"))="YES" S LINE=LINE_"REVIEW"
|
|---|
| 40 | ... I $G(ATEXT(409.481,SDJ,".05","E"))="YES" S LINE=LINE_"SC YES"
|
|---|
| 41 | ... I $G(ATEXT(409.481,SDJ,".05","E"))="NO" S LINE=LINE_"SC NO"
|
|---|
| 42 | ... S ^TMP("SDSCPRG",$J,"WITH",WCNT,0)=LINE
|
|---|
| 43 | .. S DA=SDOE D ^DIK
|
|---|
| 44 | I '$D(^TMP("SDSCPRG",$J)) D G END
|
|---|
| 45 | . N DIR,X,Y
|
|---|
| 46 | . I $E(IOST,1,2)="C-" S DIR(0)="E" W !!,"No records found to purge." D ^DIR
|
|---|
| 47 | I $D(^TMP("SDSCPRG",$J))>0 D
|
|---|
| 48 | . S CNT=0,SDJ=0
|
|---|
| 49 | . F S SDJ=$O(^TMP("SDSCPRG",$J,"NO",SDJ)) Q:SDJ="" D
|
|---|
| 50 | .. S CNT=CNT+1,^TMP("SDSCPMSG",$J,CNT,0)=^TMP("SDSCPRG",$J,"NO",SDJ,0)
|
|---|
| 51 | . I CNT>0 S CNT=CNT+1,^TMP("SDSCPMSG",$J,CNT,0)=""
|
|---|
| 52 | . S SDJ=0 F S SDJ=$O(^TMP("SDSCPRG",$J,"WITH",SDJ)) Q:SDJ="" D
|
|---|
| 53 | .. S CNT=CNT+1,^TMP("SDSCPMSG",$J,CNT,0)=^TMP("SDSCPRG",$J,"WITH",SDJ,0)
|
|---|
| 54 | . S XMZ(DUZ)="",XMDUZ="ASCD Purge Check",XMY("G.SDSC NIGHTLY TALLY")=""
|
|---|
| 55 | . S XMTEXT="^TMP(""SDSCPMSG"",$J,",XMSUB="ASCD PURGE REPORT"
|
|---|
| 56 | . NEW DIFROM
|
|---|
| 57 | . D ^XMD
|
|---|
| 58 | . K XMZ,XMTEXT,XMSUB,XMDUZ,XMY
|
|---|
| 59 | ;
|
|---|
| 60 | END K ^TMP("DIERR",$J),^TMP("SDSCPRG",$J),^TMP("SDSCPMSG",$J)
|
|---|
| 61 | Q
|
|---|
