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)
Q
;
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
Q
;
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
Q
;
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")
Q
;
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
Q
;
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 !,"*********************************************"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXTSR 4058 printed Nov 22, 2024@17:04:21 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 ;
+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
