ECXTPR.m

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 ---ECXTPR   1856     printed  Mar 13, 2025@20:58:44                                                                                                                                                                                                      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