- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDSCPRG 2999 printed Feb 19, 2025@00:27:44 Page 2
- SDSCPRG ;ALB/JAM/RBS - ASCD Purge encounters that have been deleted ; 1/19/07 12:39pm
- +1 ;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
- +2 ;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
- +3 ;;known as Service Connected Automated Monitoring (SCAM).
- +4 ;
- +5 ;**Program Description**
- +6 ; This program will check to see if an encounter in the
- +7 ; SD SERVICE CONNECTED CHANGES File (#409.48)
- +8 ; has been deleted from the OUTPATIENT ENCOUNTER file (#409.68) and
- +9 ; remove that record from file #409.48.
- +10 QUIT
- EN ; Entry point
- +1 NEW SDOE,NOACT,ACT,NCNT,WCNT,DA,DIK,LINE,SDI,SDJ,CNT
- +2 KILL ^TMP("SDSCPRG",$JOB),^TMP("SDSCPMSG",$JOB)
- +3 SET DIK="^SDSC(409.48,"
- SET (SDOE,NOACT,ACT)=0
- SET (NCNT,WCNT)=1
- +4 FOR
- SET SDOE=$ORDER(^SDSC(409.48,SDOE))
- if 'SDOE
- QUIT
- Begin DoDot:1
- +5 IF $$GETOE^SDOE(SDOE)=""
- Begin DoDot:2
- +6 KILL ATEXT
- +7 DO GETS^DIQ(409.48,SDOE,"**","E","ATEXT")
- +8 ; Initialize message
- +9 SET ^TMP("SDSCPRG",$JOB,"NO",1,0)="Encounters with No Action Taken: "_NOACT
- +10 SET ^TMP("SDSCPRG",$JOB,"WITH",1,0)="Encounters with Actions Taken: "_ACT
- +11 IF $DATA(ATEXT(409.481))>0
- SET ACT=ACT+1
- SET ^TMP("SDSCPRG",$JOB,"WITH",1,0)="Encounters with Actions Taken: "_ACT
- +12 IF $DATA(ATEXT(409.481))'>0
- Begin DoDot:3
- +13 SET NOACT=NOACT+1
- SET ^TMP("SDSCPRG",$JOB,"NO",1,0)="Encounters with No Action Taken: "_NOACT
- +14 SET NCNT=NCNT+1
- +15 SET LINE=" "
- FOR SDI=".07",".11",".05"
- SET LINE=LINE_$GET(ATEXT(409.48,SDOE_",",SDI,"E"))_"-"
- +16 IF $EXTRACT(LINE,$LENGTH(LINE),$LENGTH(LINE))="-"
- SET LINE=$EXTRACT(LINE,1,$LENGTH(LINE)-1)
- +17 SET ^TMP("SDSCPRG",$JOB,"NO",NCNT,0)=LINE_"-Enc #: "_SDOE
- +18 SET DA=SDOE
- DO ^DIK
- End DoDot:3
- QUIT
- +19 ; Set information into ^TMP for report
- +20 SET WCNT=WCNT+1
- +21 SET LINE=" "
- FOR SDI=".07",".11",".05"
- SET LINE=LINE_$GET(ATEXT(409.48,SDOE_",",SDI,"E"))_"-"
- +22 IF $EXTRACT(LINE,$LENGTH(LINE),$LENGTH(LINE))="-"
- SET LINE=$EXTRACT(LINE,1,$LENGTH(LINE)-1)
- +23 SET ^TMP("SDSCPRG",$JOB,"WITH",WCNT,0)=LINE_"-Enc #: "_SDOE
- +24 SET SDJ=SDOE
- FOR
- SET SDJ=$ORDER(ATEXT(409.481,SDJ))
- if SDJ=""
- QUIT
- Begin DoDot:3
- +25 SET LINE=" "
- SET WCNT=WCNT+1
- +26 FOR SDI=".03",".02",".04"
- SET LINE=LINE_$GET(ATEXT(409.481,SDJ,SDI,"E"))_"-"
- +27 IF $GET(ATEXT(409.481,SDJ,".06","E"))="YES"
- SET LINE=LINE_"REVIEW"
- +28 IF $GET(ATEXT(409.481,SDJ,".05","E"))="YES"
- SET LINE=LINE_"SC YES"
- +29 IF $GET(ATEXT(409.481,SDJ,".05","E"))="NO"
- SET LINE=LINE_"SC NO"
- +30 SET ^TMP("SDSCPRG",$JOB,"WITH",WCNT,0)=LINE
- End DoDot:3
- +31 SET DA=SDOE
- DO ^DIK
- End DoDot:2
- End DoDot:1
- +32 IF '$DATA(^TMP("SDSCPRG",$JOB))
- Begin DoDot:1
- +33 NEW DIR,X,Y
- +34 IF $EXTRACT(IOST,1,2)="C-"
- SET DIR(0)="E"
- WRITE !!,"No records found to purge."
- DO ^DIR
- End DoDot:1
- GOTO END
- +35 IF $DATA(^TMP("SDSCPRG",$JOB))>0
- Begin DoDot:1
- +36 SET CNT=0
- SET SDJ=0
- +37 FOR
- SET SDJ=$ORDER(^TMP("SDSCPRG",$JOB,"NO",SDJ))
- if SDJ=""
- QUIT
- Begin DoDot:2
- +38 SET CNT=CNT+1
- SET ^TMP("SDSCPMSG",$JOB,CNT,0)=^TMP("SDSCPRG",$JOB,"NO",SDJ,0)
- End DoDot:2
- +39 IF CNT>0
- SET CNT=CNT+1
- SET ^TMP("SDSCPMSG",$JOB,CNT,0)=""
- +40 SET SDJ=0
- FOR
- SET SDJ=$ORDER(^TMP("SDSCPRG",$JOB,"WITH",SDJ))
- if SDJ=""
- QUIT
- Begin DoDot:2
- +41 SET CNT=CNT+1
- SET ^TMP("SDSCPMSG",$JOB,CNT,0)=^TMP("SDSCPRG",$JOB,"WITH",SDJ,0)
- End DoDot:2
- +42 SET XMZ(DUZ)=""
- SET XMDUZ="ASCD Purge Check"
- SET XMY("G.SDSC NIGHTLY TALLY")=""
- +43 SET XMTEXT="^TMP(""SDSCPMSG"",$J,"
- SET XMSUB="ASCD PURGE REPORT"
- +44 NEW DIFROM
- +45 DO ^XMD
- +46 KILL XMZ,XMTEXT,XMSUB,XMDUZ,XMY
- End DoDot:1
- +47 ;
- END KILL ^TMP("DIERR",$JOB),^TMP("SDSCPRG",$JOB),^TMP("SDSCPMSG",$JOB)
- +1 QUIT
