SCDXSUP2.m

SCDXSUP2 ;ALB/JRP - PURGE ERROR FILE;22-APR-97 ; 12/20/01 4:49pm

 ;;5.3;Scheduling;**121,247,1015**;AUG 13, 1993;Build 21

 ;

PRGCO ;Purge TRANSMITTED OUTPATIENT ENCOUNTER ERROR file (#409.75) of

 ; rejections for encounters that can not be transmitted due to

 ; NPCD Database Close-Out

 ;

 ;Input  : None

 ;Output : None

 ;

 ;Declare variables

 N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK,DIR,Y,X,DTOUT,DUOUT,DIRUT

 ;'Are you sure' prompt

 S DIR("A",1)=" "

 S DIR("A",2)="This option will purge entries in the TRANSMITTED OUTPATIENT"

 S DIR("A",3)="ENCOUNTER ERROR file (#409.75) of rejections for encounters that"

 S DIR("A",4)="can not be transmitted due to close-out of the National Patient"

 S DIR("A",5)="Care Database for database credit."

 S DIR("A",6)=" "

 S DIR("A")="Ok to continue"

 S DIR("B")="NO"

 S DIR(0)="Y"

 D ^DIR

 Q:('Y)

 ;Task (no device needed)

 S ZTRTN="PRGCOT^SCDXSUP2"

 S ZTDESC="Purge file #409.75 of encounters that won't get database credit"

 S ZTIO=""

 S ZTDTH=""

 D ^%ZTLOAD

 W:($G(ZTSK)) !!,"Scheduled as task number ",ZTSK

 W:('$G(ZTSK)) !!,"** Unable to schedule correctly **"

 Q

 ;

PRGCOT ;Task entry point (self contained)

 ;Declare variables

 N XMITPTR

 ;Loop through 'B' x-ref

 S XMITPTR=0

 F  S XMITPTR=+$O(^SD(409.75,"B",XMITPTR)) Q:('XMITPTR)  D  Q:($$S^%ZTLOAD())

 .;Determine if encounter can be transmitted for database credit

 .Q:+$$XMIT4DBC^SCDXFU04(XMITPTR)<4  ;SD*5.3*247

 .;Won't received database credit - delete all errors for encounter

 .D DELAERR^SCDXFU02(XMITPTR)

 ;Done

 S:($D(ZTQUEUED)) ZTREQ="@"

 Q

SCDXSUP2  ;ALB/JRP - PURGE ERROR FILE;22-APR-97 ; 12/20/01 4:49pm

 +1       ;;5.3;Scheduling;**121,247,1015**;AUG 13, 1993;Build 21

 +2       ;

PRGCO     ;Purge TRANSMITTED OUTPATIENT ENCOUNTER ERROR file (#409.75) of

 +1       ; rejections for encounters that can not be transmitted due to

 +2       ; NPCD Database Close-Out

 +3       ;

 +4       ;Input  : None

 +5       ;Output : None

 +6       ;

 +7       ;Declare variables

 +8        NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK,DIR,Y,X,DTOUT,DUOUT,DIRUT

 +9       ;'Are you sure' prompt

 +10       SET DIR("A",1)=" "

 +11       SET DIR("A",2)="This option will purge entries in the TRANSMITTED OUTPATIENT"

 +12       SET DIR("A",3)="ENCOUNTER ERROR file (#409.75) of rejections for encounters that"

 +13       SET DIR("A",4)="can not be transmitted due to close-out of the National Patient"

 +14       SET DIR("A",5)="Care Database for database credit."

 +15       SET DIR("A",6)=" "

 +16       SET DIR("A")="Ok to continue"

 +17       SET DIR("B")="NO"

 +18       SET DIR(0)="Y"

 +19       DO ^DIR

 +20       IF ('Y)

               QUIT 

 +21      ;Task (no device needed)

 +22       SET ZTRTN="PRGCOT^SCDXSUP2"

 +23       SET ZTDESC="Purge file #409.75 of encounters that won't get database credit"

 +24       SET ZTIO=""

 +25       SET ZTDTH=""

 +26       DO ^%ZTLOAD

 +27       IF ($GET(ZTSK))

               WRITE !!,"Scheduled as task number ",ZTSK

 +28       IF ('$GET(ZTSK))

               WRITE !!,"** Unable to schedule correctly **"

 +29       QUIT 

 +30      ;

PRGCOT    ;Task entry point (self contained)

 +1       ;Declare variables

 +2        NEW XMITPTR

 +3       ;Loop through 'B' x-ref

 +4        SET XMITPTR=0

 +5        FOR 

               SET XMITPTR=+$ORDER(^SD(409.75,"B",XMITPTR))

               IF ('XMITPTR)

                   QUIT 

               Begin DoDot:1

 +6       ;Determine if encounter can be transmitted for database credit

 +7       ;SD*5.3*247

                   IF +$$XMIT4DBC^SCDXFU04(XMITPTR)<4

                       QUIT 

 +8       ;Won't received database credit - delete all errors for encounter

 +9                DO DELAERR^SCDXFU02(XMITPTR)

               End DoDot:1

               IF ($$S^%ZTLOAD())

                   QUIT 

 +10      ;Done

 +11       IF ($DATA(ZTQUEUED))

               SET ZTREQ="@"

 +12       QUIT