Routine: ECXTSR

ECXTSR ;MBS/BAH - Pharmacy DSS Extract Treating Specialty Report ;4/5/24  11:53

 ;;3.0;DSS EXTRACTS;**190**;Dec 22, 1997;Build 36

EN ;entry point from option

 N STOP,REPORT,DIVISION,SDATE,EDATE,X,TMP,ECXPORT,CNT,TXTYPE,ECXPAT,ECRUN,DATE,Y

 S STOP=0

 ; get today's date

 D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=Y K %DT

 ;Select date range

 D DATES  Q:STOP

 S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1  I $G(ECXPORT) D  Q

 .K ^TMP($J,"ECXPORT")

 .S ^TMP($J,"ECXPORT",0)="PTF CODE^NAME^STATUS^EFFECTIVE DATE^STATUS CHANGED",CNT=0

 .D GETDATA

 .D DETAIL

 .D EXPDISP^ECXUTL1

 .K ^TMP($J,"ECXPORT"),^TMP($J,"ECXTSR")

 ;Queue Report

 N ZTDESC,ZTIO,ZTSAVE

 F X="SDATE","EDATE","ECRUN","STOP" S ZTSAVE(X)=""

 S ZTIO=""

 S ZTDESC="DSS Extract Treating Specialty Report"

 W !!,"This report requires 132 column format."

 D EN^XUTMDEVQ("EN1^ECXTSR",ZTDESC,.ZTSAVE)

EN1 ;Init variables

 N PAGE,LN

 S PAGE=0

 D HEADER I STOP D EXIT Q

 D GETDATA I STOP D EXIT Q

 I '$O(^TMP($J,"ECXTSR",0)) D  Q

 .W !

 .W !,"************************************************************"

 .W !,"*  NOTHING TO REPORT FOR TREATING SPECIALTY REPORT  *"

 .W !,"************************************************************"

 .D WAIT

 .D EXIT

 D DETAIL I STOP D EXIT Q

EXIT Q

DATES ;Prompt for start date

 N DIR,DIRUT,X,Y

 S DIR(0)="D^:NOW:EX"

 S DIR("A")="Enter Report Start Date"

 S DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT,"1D")

 D ^DIR

 I $D(DIRUT) S STOP=1 Q

 S SDATE=Y

 ;Prompt for end date

 K DIR,DIRUT,X,Y

 S DIR(0)="D^:NOW:EX"

 S DIR("A")="Enter Report End Date"

 S DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT,"1D")

 D ^DIR

 I $D(DIRUT) S STOP=1 Q

 S EDATE=Y

HEADER ;Print header

 S PAGE=$G(PAGE)+1,$P(LN,"=",91)=""

 W @IOF

 W !,"Treating Specialty Report",?80,$$RJ^XLFSTR("PAGE: "_PAGE,10)

 W !,"Start Date: "_$$FMTE^XLFDT(SDATE),?49,"Report Run Date/Time:  "_ECRUN

 W !,"End Date:   "_$$FMTE^XLFDT(EDATE),!

 W !,"Note: '*' beside the status indicates status was changed during report period."

 W !,"PTF Code         Name                            Status           Effective Date"

 W !,LN

GETDATA ;Get data from Specialty File

 N ACTIVE,DATE,EFDT,EFDTI,ECXTSRD,ENDATE,ERROR,IEN,NAME,PTFC,STATCH,STATUS

 S DATE=SDATE-.1,ENDATE=EDATE+.999

 K ^TMP($J,"ECXTSR")

 S IEN=0 F  S IEN=$O(^DIC(42.4,IEN)) Q:'IEN  D

 .K ^TMP($J,"ECXTSRD")

 .S STATUS="DOES NOT EXIST",STATCH=0 ; Default to Specialty not existing at the time

 .D GETS^DIQ(42.4,IEN_",","*","EI",$NA(^TMP($J,"ECXTSRD")))

 .S ECXTSRD=$NA(^TMP($J,"ECXTSRD",42.4,IEN_","))

 .S NAME=$G(@ECXTSRD@(.01,"E")),PTFC=$G(@ECXTSRD@(7,"E"))

 .S EFDT=$O(^DIC(42.4,IEN,"E","B",ENDATE),-1)

 .I EFDT]"" D

 ..S EFDTI=$O(^DIC(42.4,IEN,"E","B",EFDT,0))

 ..S ACTIVE=$$GET1^DIQ(42.41,EFDTI_","_IEN_",",.02,"I"),STATUS=$S(+ACTIVE:"ACTIVE",1:"INACTIVE")

 ..S STATCH=$$STATCH(IEN,EFDT,SDATE,EDATE)

 .S:EFDT="" EFDT="N/A"

 .S ^TMP($J,"ECXTSR",IEN)=PTFC_U_NAME_U_STATUS_$S(STATCH:"*",1:"")_U_$$FMTE^XLFDT(EFDT,"2Z")

STATCH(IEN,EFDT,SDATE,EDATE) ;Check if status changed during report period

 Q EFDT'<SDATE&(EFDT'>EDATE)

DETAIL ;Print report

N I

 S I=0 F  S I=$O(^TMP($J,"ECXTSR",I)) Q:'+I  D  Q:STOP

 .S X=$G(^TMP($J,"ECXTSR",I))

 .I $G(ECXPORT) D  Q

 ..I $P(X,U,3)["*" S $P(X,U,3)=$P($P(X,U,3),"*"),$P(X,U,5)="*"

 ..S CNT=$G(CNT)+1,^TMP($J,"ECXPORT",CNT)=X

 .W !,$P(X,U),?17,$P(X,U,2),?49,$P(X,U,3),?66,$P(X,U,4)

 .I $Y>(IOSL-5) D WAIT Q:STOP  D HEADER

WAIT ;End of page logic

 ;Input   ; None

 ;Output  ; STOP - Flag indicating if printing should continue

 ;                 1 = Stop     0 = Continue

 S STOP=0

 ;CRT - Prompt for continue

 I $E(IOST,1,2)="C-" D  Q

 .F  Q:$Y>(IOSL-3)  W !

 .N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT

 .S DIR(0)="E"

 .D ^DIR

 .S STOP=$S(Y'=1:1,1:0)

 ;Background task - check taskman

 S STOP=$$S^%ZTLOAD()

 I STOP D

 .W !,"*********************************************"

 .W !,"*  PRINTING OF REPORT STOPPED AS REQUESTED  *"

 .W !,"*********************************************"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXTSR   4058     printed  Mar 13, 2025@20:58:51                                                                                                                                                                                                      Page 2

ECXTSR    ;MBS/BAH - Pharmacy DSS Extract Treating Specialty Report ;4/5/24  11:53

 +1       ;;3.0;DSS EXTRACTS;**190**;Dec 22, 1997;Build 36

 +2       ;

EN        ;entry point from option

 +1        NEW STOP,REPORT,DIVISION,SDATE,EDATE,X,TMP,ECXPORT,CNT,TXTYPE,ECXPAT,ECRUN,DATE,Y

 +2        SET STOP=0

 +3       ; get today's date

 +4        DO NOW^%DTC

           SET DATE=X

           SET Y=$EXTRACT(%,1,12)

           DO DD^%DT

           SET ECRUN=Y

           KILL %DT

 +5       ;Select date range

 +6        DO DATES

           if STOP

               QUIT

 +7        SET ECXPORT=$$EXPORT^ECXUTL1

           if ECXPORT=-1

               QUIT

           IF $GET(ECXPORT)

               Begin DoDot:1

 +8                KILL ^TMP($JOB,"ECXPORT")

 +9                SET ^TMP($JOB,"ECXPORT",0)="PTF CODE^NAME^STATUS^EFFECTIVE DATE^STATUS CHANGED"

                   SET CNT=0

 +10               DO GETDATA

 +11               DO DETAIL

 +12               DO EXPDISP^ECXUTL1

 +13               KILL ^TMP($JOB,"ECXPORT"),^TMP($JOB,"ECXTSR")

               End DoDot:1

               QUIT

 +14      ;Queue Report

 +15       NEW ZTDESC,ZTIO,ZTSAVE

 +16       FOR X="SDATE","EDATE","ECRUN","STOP"

               SET ZTSAVE(X)=""

 +17       SET ZTIO=""

 +18       SET ZTDESC="DSS Extract Treating Specialty Report"

 +19       WRITE !!,"This report requires 132 column format."

 +20       DO EN^XUTMDEVQ("EN1^ECXTSR",ZTDESC,.ZTSAVE)

 +21       QUIT

 +22      ;

EN1       ;Init variables

 +1        NEW PAGE,LN

 +2        SET PAGE=0

 +3        DO HEADER

           IF STOP

               DO EXIT

               QUIT

 +4        DO GETDATA

           IF STOP

               DO EXIT

               QUIT

 +5        IF '$ORDER(^TMP($JOB,"ECXTSR",0))

               Begin DoDot:1

 +6                WRITE !

 +7                WRITE !,"************************************************************"

 +8                WRITE !,"*  NOTHING TO REPORT FOR TREATING SPECIALTY REPORT  *"

 +9                WRITE !,"************************************************************"

 +10               DO WAIT

 +11               DO EXIT

               End DoDot:1

               QUIT

 +12       DO DETAIL

           IF STOP

               DO EXIT

               QUIT

EXIT       QUIT

 +1       ;

DATES     ;Prompt for start date

 +1        NEW DIR,DIRUT,X,Y

 +2        SET DIR(0)="D^:NOW:EX"

 +3        SET DIR("A")="Enter Report Start Date"

 +4        SET DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT,"1D")

 +5        DO ^DIR

 +6        IF $DATA(DIRUT)

               SET STOP=1

               QUIT

 +7        SET SDATE=Y

 +8       ;Prompt for end date

 +9        KILL DIR,DIRUT,X,Y

 +10       SET DIR(0)="D^:NOW:EX"

 +11       SET DIR("A")="Enter Report End Date"

 +12       SET DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT,"1D")

 +13       DO ^DIR

 +14       IF $DATA(DIRUT)

               SET STOP=1

               QUIT

 +15       SET EDATE=Y

 +16       QUIT

 +17      ;

HEADER    ;Print header

 +1        SET PAGE=$GET(PAGE)+1

           SET $PIECE(LN,"=",91)=""

 +2        WRITE @IOF

 +3        WRITE !,"Treating Specialty Report",?80,$$RJ^XLFSTR("PAGE: "_PAGE,10)

 +4        WRITE !,"Start Date: "_$$FMTE^XLFDT(SDATE),?49,"Report Run Date/Time:  "_ECRUN

 +5        WRITE !,"End Date:   "_$$FMTE^XLFDT(EDATE),!

 +6        WRITE !,"Note: '*' beside the status indicates status was changed during report period."

 +7        WRITE !,"PTF Code         Name                            Status           Effective Date"

 +8        WRITE !,LN

 +9        QUIT

 +10      ;

GETDATA   ;Get data from Specialty File

 +1        NEW ACTIVE,DATE,EFDT,EFDTI,ECXTSRD,ENDATE,ERROR,IEN,NAME,PTFC,STATCH,STATUS

 +2        SET DATE=SDATE-.1

           SET ENDATE=EDATE+.999

 +3        KILL ^TMP($JOB,"ECXTSR")

 +4        SET IEN=0

FOR

               SET IEN=$ORDER(^DIC(42.4,IEN))

               if 'IEN

                   QUIT

               Begin DoDot:1

 +5                KILL ^TMP($JOB,"ECXTSRD")

 +6       ; Default to Specialty not existing at the time

                   SET STATUS="DOES NOT EXIST"

                   SET STATCH=0

 +7                DO GETS^DIQ(42.4,IEN_",","*","EI",$NAME(^TMP($JOB,"ECXTSRD")))

 +8                SET ECXTSRD=$NAME(^TMP($JOB,"ECXTSRD",42.4,IEN_","))

 +9                SET NAME=$GET(@ECXTSRD@(.01,"E"))

                   SET PTFC=$GET(@ECXTSRD@(7,"E"))

 +10               SET EFDT=$ORDER(^DIC(42.4,IEN,"E","B",ENDATE),-1)

 +11               IF EFDT]""

                       Begin DoDot:2

 +12                       SET EFDTI=$ORDER(^DIC(42.4,IEN,"E","B",EFDT,0))

 +13                       SET ACTIVE=$$GET1^DIQ(42.41,EFDTI_","_IEN_",",.02,"I")

                           SET STATUS=$SELECT(+ACTIVE:"ACTIVE",1:"INACTIVE")

 +14                       SET STATCH=$$STATCH(IEN,EFDT,SDATE,EDATE)

                       End DoDot:2

 +15               if EFDT=""

                       SET EFDT="N/A"

 +16               SET ^TMP($JOB,"ECXTSR",IEN)=PTFC_U_NAME_U_STATUS_$SELECT(STATCH:"*",1:"")_U_$$FMTE^XLFDT(EFDT,"2Z")

               End DoDot:1

 +17       QUIT

 +18      ;

STATCH(IEN,EFDT,SDATE,EDATE) ;Check if status changed during report period

 +1        QUIT EFDT'<SDATE&(EFDT'>EDATE)

 +2       ;

DETAIL    ;Print report

 +1        NEW I

 +2        SET I=0

FOR

               SET I=$ORDER(^TMP($JOB,"ECXTSR",I))

               if '+I

                   QUIT

               Begin DoDot:1

 +3                SET X=$GET(^TMP($JOB,"ECXTSR",I))

 +4                IF $GET(ECXPORT)

                       Begin DoDot:2

 +5                        IF $PIECE(X,U,3)["*"

                               SET $PIECE(X,U,3)=$PIECE($PIECE(X,U,3),"*")

                               SET $PIECE(X,U,5)="*"

 +6                        SET CNT=$GET(CNT)+1

                           SET ^TMP($JOB,"ECXPORT",CNT)=X

                       End DoDot:2

                       QUIT

 +7                WRITE !,$PIECE(X,U),?17,$PIECE(X,U,2),?49,$PIECE(X,U,3),?66,$PIECE(X,U,4)

 +8                IF $Y>(IOSL-5)

                       DO WAIT

                       if STOP

                           QUIT

                       DO HEADER

               End DoDot:1

               if STOP

                   QUIT

 +9        QUIT

 +10      ;

WAIT      ;End of page logic

 +1       ;Input   ; None

 +2       ;Output  ; STOP - Flag indicating if printing should continue

 +3       ;                 1 = Stop     0 = Continue

 +4       ;

 +5        SET STOP=0

 +6       ;CRT - Prompt for continue

 +7        IF $EXTRACT(IOST,1,2)="C-"

               Begin DoDot:1

 +8                FOR

                       if $Y>(IOSL-3)

                           QUIT

                       WRITE !

 +9                NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT

 +10               SET DIR(0)="E"

 +11               DO ^DIR

 +12               SET STOP=$SELECT(Y'=1:1,1:0)

               End DoDot:1

               QUIT

 +13      ;Background task - check taskman

 +14       SET STOP=$$S^%ZTLOAD()

 +15       IF STOP

               Begin DoDot:1

 +16               WRITE !,"*********************************************"

 +17               WRITE !,"*  PRINTING OF REPORT STOPPED AS REQUESTED  *"

 +18               WRITE !,"*********************************************"

               End DoDot:1

 +19       QUIT

ECXTSR.m