62 lines
2.9 KiB
Mathematica
62 lines
2.9 KiB
Mathematica
SDSCPRG ;ALB/JAM/RBS - ASCD Purge encounters that have been deleted ; 1/19/07 12:39pm
|
|
;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
|
|
;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
|
|
;;known as Service Connected Automated Monitoring (SCAM).
|
|
;
|
|
;**Program Description**
|
|
; This program will check to see if an encounter in the
|
|
; SD SERVICE CONNECTED CHANGES File (#409.48)
|
|
; has been deleted from the OUTPATIENT ENCOUNTER file (#409.68) and
|
|
; remove that record from file #409.48.
|
|
Q
|
|
EN ; Entry point
|
|
N SDOE,NOACT,ACT,NCNT,WCNT,DA,DIK,LINE,SDI,SDJ,CNT
|
|
K ^TMP("SDSCPRG",$J),^TMP("SDSCPMSG",$J)
|
|
S DIK="^SDSC(409.48,",(SDOE,NOACT,ACT)=0,(NCNT,WCNT)=1
|
|
F S SDOE=$O(^SDSC(409.48,SDOE)) Q:'SDOE D
|
|
. I $$GETOE^SDOE(SDOE)="" D
|
|
.. K ATEXT
|
|
.. D GETS^DIQ(409.48,SDOE,"**","E","ATEXT")
|
|
.. ; Initialize message
|
|
.. S ^TMP("SDSCPRG",$J,"NO",1,0)="Encounters with No Action Taken: "_NOACT
|
|
.. S ^TMP("SDSCPRG",$J,"WITH",1,0)="Encounters with Actions Taken: "_ACT
|
|
.. I $D(ATEXT(409.481))>0 S ACT=ACT+1,^TMP("SDSCPRG",$J,"WITH",1,0)="Encounters with Actions Taken: "_ACT
|
|
.. I $D(ATEXT(409.481))'>0 D Q
|
|
... S NOACT=NOACT+1,^TMP("SDSCPRG",$J,"NO",1,0)="Encounters with No Action Taken: "_NOACT
|
|
... S NCNT=NCNT+1
|
|
... S LINE=" " F SDI=".07",".11",".05" S LINE=LINE_$G(ATEXT(409.48,SDOE_",",SDI,"E"))_"-"
|
|
... I $E(LINE,$L(LINE),$L(LINE))="-" S LINE=$E(LINE,1,$L(LINE)-1)
|
|
... S ^TMP("SDSCPRG",$J,"NO",NCNT,0)=LINE_"-Enc #: "_SDOE
|
|
... S DA=SDOE D ^DIK
|
|
.. ; Set information into ^TMP for report
|
|
.. S WCNT=WCNT+1
|
|
.. S LINE=" " F SDI=".07",".11",".05" S LINE=LINE_$G(ATEXT(409.48,SDOE_",",SDI,"E"))_"-"
|
|
.. I $E(LINE,$L(LINE),$L(LINE))="-" S LINE=$E(LINE,1,$L(LINE)-1)
|
|
.. S ^TMP("SDSCPRG",$J,"WITH",WCNT,0)=LINE_"-Enc #: "_SDOE
|
|
.. S SDJ=SDOE F S SDJ=$O(ATEXT(409.481,SDJ)) Q:SDJ="" D
|
|
... S LINE=" ",WCNT=WCNT+1
|
|
... F SDI=".03",".02",".04" S LINE=LINE_$G(ATEXT(409.481,SDJ,SDI,"E"))_"-"
|
|
... I $G(ATEXT(409.481,SDJ,".06","E"))="YES" S LINE=LINE_"REVIEW"
|
|
... I $G(ATEXT(409.481,SDJ,".05","E"))="YES" S LINE=LINE_"SC YES"
|
|
... I $G(ATEXT(409.481,SDJ,".05","E"))="NO" S LINE=LINE_"SC NO"
|
|
... S ^TMP("SDSCPRG",$J,"WITH",WCNT,0)=LINE
|
|
.. S DA=SDOE D ^DIK
|
|
I '$D(^TMP("SDSCPRG",$J)) D G END
|
|
. N DIR,X,Y
|
|
. I $E(IOST,1,2)="C-" S DIR(0)="E" W !!,"No records found to purge." D ^DIR
|
|
I $D(^TMP("SDSCPRG",$J))>0 D
|
|
. S CNT=0,SDJ=0
|
|
. F S SDJ=$O(^TMP("SDSCPRG",$J,"NO",SDJ)) Q:SDJ="" D
|
|
.. S CNT=CNT+1,^TMP("SDSCPMSG",$J,CNT,0)=^TMP("SDSCPRG",$J,"NO",SDJ,0)
|
|
. I CNT>0 S CNT=CNT+1,^TMP("SDSCPMSG",$J,CNT,0)=""
|
|
. S SDJ=0 F S SDJ=$O(^TMP("SDSCPRG",$J,"WITH",SDJ)) Q:SDJ="" D
|
|
.. S CNT=CNT+1,^TMP("SDSCPMSG",$J,CNT,0)=^TMP("SDSCPRG",$J,"WITH",SDJ,0)
|
|
. S XMZ(DUZ)="",XMDUZ="ASCD Purge Check",XMY("G.SDSC NIGHTLY TALLY")=""
|
|
. S XMTEXT="^TMP(""SDSCPMSG"",$J,",XMSUB="ASCD PURGE REPORT"
|
|
. NEW DIFROM
|
|
. D ^XMD
|
|
. K XMZ,XMTEXT,XMSUB,XMDUZ,XMY
|
|
;
|
|
END K ^TMP("DIERR",$J),^TMP("SDSCPRG",$J),^TMP("SDSCPMSG",$J)
|
|
Q
|