ECXTPR ;ALB/DAN - List of current test patients ;3/30/17 11:49
;;3.0;DSS EXTRACTS;**166**;Dec 22, 1997;Build 24
;
N ECXPORT,ZTSAVE
W !!,"** NOTE: This report can take a while to generate. If you're not exporting the",!,"report, it's suggested that you queue it to run in the background.",!
S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1
I $G(ECXPORT) D Q ;If exporting get records and display to screen
.K ^TMP($J,"ECXTPR"),^TMP($J,"ECXPORT")
.D GETPTS
.M ^TMP($J,"ECXPORT")=^TMP($J,"ECXTPR")
.S ^TMP($J,"ECXPORT",0)="NAME^SSN^TEST PATIENT INDICATOR^DSS TEST PATIENT"
.D EXPDISP^ECXUTL1
.K ^TMP($J,"ECXTPR"),^TMP($J,"ECXPORT")
.Q
;
D EN^XUTMDEVQ("START^ECXTPR","Print list of test patients",.ZTSAVE)
Q
;
START ;
K ^TMP($J,"ECXTPR")
D GETPTS
D PRINT
K ^TMP($J,"ECXTPR")
Q
;
GETPTS ;Find test patients
N NAME,IEN,SSN,CNT,VTP,DTP
S CNT=0
S NAME="" F S NAME=$O(^DPT("B",NAME)) Q:NAME="" S IEN=0 F S IEN=$O(^DPT("B",NAME,IEN)) Q:'+IEN D
.S SSN=$$GET1^DIQ(2,IEN,.09)
.S VTP=$$TESTPAT^VADPT(IEN)
.S DTP=$$SSN^ECXUTL5(SSN)
.I 'DTP!($E(NAME,1,2)="ZZ") S CNT=CNT+1 S ^TMP($J,"ECXTPR",CNT)=NAME_"^"_SSN_"^"_$S(VTP:"Y",1:"N")_"^"_$S('DTP:"Y",1:"N")
.Q
Q
;
PRINT ;Display results
N NUM,DATA,PAGE,RDAT,QFLG
S (PAGE,QFLG)=0,RDAT=$$FMTE^XLFDT($E($$NOW^XLFDT,1,12))
D HEAD
S NUM=0 F S NUM=$O(^TMP($J,"ECXTPR",NUM)) Q:'+NUM!(QFLG) D
.I $Y>($G(IOSL)-4) D HEAD Q:QFLG
.S DATA=^TMP($J,"ECXTPR",NUM)
.W !,$P(DATA,"^"),?32,$P(DATA,"^",2),?48,$P(DATA,"^",3),?62,$P(DATA,"^",4)
.Q
Q
;
HEAD ;Print header
N Y,DIR
I $E(IOST)="C",PAGE>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
W @IOF
S PAGE=PAGE+1
W "Test Patient List on ",RDAT,?70,"Page: ",PAGE,!
W !,"NAME",?32,"SSN",?43,"TEST PATIENT",?57,"DSS TEST PAT",!,?43,"INDICATOR",?57,"INDICATOR",!,$$REPEAT^XLFSTR("-",80)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXTPR 1856 printed Nov 22, 2024@17:04:14 Page 2
ECXTPR ;ALB/DAN - List of current test patients ;3/30/17 11:49
+1 ;;3.0;DSS EXTRACTS;**166**;Dec 22, 1997;Build 24
+2 ;
+3 NEW ECXPORT,ZTSAVE
+4 WRITE !!,"** NOTE: This report can take a while to generate. If you're not exporting the",!,"report, it's suggested that you queue it to run in the background.",!
+5 SET ECXPORT=$$EXPORT^ECXUTL1
if ECXPORT=-1
QUIT
+6 ;If exporting get records and display to screen
IF $GET(ECXPORT)
Begin DoDot:1
+7 KILL ^TMP($JOB,"ECXTPR"),^TMP($JOB,"ECXPORT")
+8 DO GETPTS
+9 MERGE ^TMP($JOB,"ECXPORT")=^TMP($JOB,"ECXTPR")
+10 SET ^TMP($JOB,"ECXPORT",0)="NAME^SSN^TEST PATIENT INDICATOR^DSS TEST PATIENT"
+11 DO EXPDISP^ECXUTL1
+12 KILL ^TMP($JOB,"ECXTPR"),^TMP($JOB,"ECXPORT")
+13 QUIT
End DoDot:1
QUIT
+14 ;
+15 DO EN^XUTMDEVQ("START^ECXTPR","Print list of test patients",.ZTSAVE)
+16 QUIT
+17 ;
START ;
+1 KILL ^TMP($JOB,"ECXTPR")
+2 DO GETPTS
+3 DO PRINT
+4 KILL ^TMP($JOB,"ECXTPR")
+5 QUIT
+6 ;
GETPTS ;Find test patients
+1 NEW NAME,IEN,SSN,CNT,VTP,DTP
+2 SET CNT=0
+3 SET NAME=""
FOR
SET NAME=$ORDER(^DPT("B",NAME))
if NAME=""
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^DPT("B",NAME,IEN))
if '+IEN
QUIT
Begin DoDot:1
+4 SET SSN=$$GET1^DIQ(2,IEN,.09)
+5 SET VTP=$$TESTPAT^VADPT(IEN)
+6 SET DTP=$$SSN^ECXUTL5(SSN)
+7 IF 'DTP!($EXTRACT(NAME,1,2)="ZZ")
SET CNT=CNT+1
SET ^TMP($JOB,"ECXTPR",CNT)=NAME_"^"_SSN_"^"_$SELECT(VTP:"Y",1:"N")_"^"_$SELECT('DTP:"Y",1:"N")
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
PRINT ;Display results
+1 NEW NUM,DATA,PAGE,RDAT,QFLG
+2 SET (PAGE,QFLG)=0
SET RDAT=$$FMTE^XLFDT($EXTRACT($$NOW^XLFDT,1,12))
+3 DO HEAD
+4 SET NUM=0
FOR
SET NUM=$ORDER(^TMP($JOB,"ECXTPR",NUM))
if '+NUM!(QFLG)
QUIT
Begin DoDot:1
+5 IF $Y>($GET(IOSL)-4)
DO HEAD
if QFLG
QUIT
+6 SET DATA=^TMP($JOB,"ECXTPR",NUM)
+7 WRITE !,$PIECE(DATA,"^"),?32,$PIECE(DATA,"^",2),?48,$PIECE(DATA,"^",3),?62,$PIECE(DATA,"^",4)
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
HEAD ;Print header
+1 NEW Y,DIR
+2 IF $EXTRACT(IOST)="C"
IF PAGE>0
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
IF 'Y
SET QFLG=1
QUIT
+3 WRITE @IOF
+4 SET PAGE=PAGE+1
+5 WRITE "Test Patient List on ",RDAT,?70,"Page: ",PAGE,!
+6 WRITE !,"NAME",?32,"SSN",?43,"TEST PATIENT",?57,"DSS TEST PAT",!,?43,"INDICATOR",?57,"INDICATOR",!,$$REPEAT^XLFSTR("-",80)
+7 QUIT
