PXRMCCHT ;BP/WAT; Report patients with Previous Enroll health factor ;06/03/16 08:14
;;2.0;CLINICAL REMINDERS;**19**;Feb 04, 2005;Build 187
;
;^VADPT - 10061 ;^XLFDT - 10103 ;^XLFSTR - 10104 ;^%ZTLOAD - 10063 ;XUTMDEVQ - 1519
;^DIR - 10026 ;^AUTTHF - 3083
;
EN ;start
N BDT,POP,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,PXRMTOT,PXRMSAVE
K ^TMP("PXRMPATS",$J)
S DIR(0)="D^2991231:DT"
S DIR("A")="Start date"
S DIR("A",1)="This report will try to find all patients that have the"
S DIR("A",2)="HT ENROLLMENT-START DATE (PREV ENROLL) Health Factor."
S DIR("A",3)="The default start date is 12/31/1999 and the report will"
S DIR("A",4)="search forward from that date."
S DIR("A",5)=""
S DIR("B")="12/31/1999"
W @IOF
D ^DIR
Q:$D(DIRUT)
S BDT=$G(Y)
N PXRMTASK S PXRMTASK=1
S PXRMSAVE("*")=""
D EN^XUTMDEVQ("PRINT^PXRMCCHT","HT Previous Enrollment HF Search",.PXRMSAVE,PXRMTASK)
W:$G(PXRMTASK)>1 "Queued successfully, task #: "_$G(PXRMTASK)
Q
;
PRINT ; output
D FINDPAT
N DONE,HFNAME,PATNAME,PXRMPAGE,HFCOUNT,RUNDATE
S (HFNAME,PATNAME)="",PXRMPAGE=1,RUNDATE=$$HTE^XLFDT($H,"1P")
W:$E(IOST,1,2)="C-" @IOF
D HEADER(PXRMPAGE) S PXRMPAGE=PXRMPAGE+1
F HFNAME="CCHT ENROLLMENT-START DATE (PREV ENROLL)","HT ENROLLMENT-START DATE (PREV ENROLL)" D Q:+$G(DONE)
. W:HFNAME["CCHT" !,HFNAME
. W:HFNAME'["CCHT" !!,HFNAME
. I $D(^TMP("PXRMPATS",$J,HFNAME))'>10 W !," No data" Q
. I $Y>(IOSL-3) D
.. I $E(IOST,1,2)["C-" D
... N DIR S DIR(0)="E" D ^DIR
... I 'Y S DONE=1
.. Q:$G(DONE)
.. D HEADER(PXRMPAGE) S PXRMPAGE=PXRMPAGE+1
. Q:$G(DONE)
. F S PATNAME=$O(^TMP("PXRMPATS",$J,HFNAME,PATNAME)) Q:PATNAME="" D Q:$G(DONE)
.. I $Y>(IOSL-3) D
... I $E(IOST,1,2)["C-" D
.... N DIR S DIR(0)="E" D ^DIR
.... I 'Y S DONE=1
... Q:$G(DONE)
... D HEADER(PXRMPAGE) S PXRMPAGE=PXRMPAGE+1
.. Q:$G(DONE)
.. W !!,^TMP("PXRMPATS",$J,HFNAME,PATNAME,0)
.. S HFCOUNT=0
.. F S HFCOUNT=$O(^TMP("PXRMPATS",$J,HFNAME,PATNAME,HFCOUNT)) Q:HFCOUNT=""!($G(DONE)) D
... I $Y>(IOSL-3) D
.... I $E(IOST,1,2)["C-" D
..... N DIR S DIR(0)="E" D ^DIR
..... I 'Y S DONE=1
.... Q:$G(DONE)
.... D HEADER(PXRMPAGE) S PXRMPAGE=PXRMPAGE+1
... Q:$G(DONE)
... W !,^TMP("PXRMPATS",$J,HFNAME,PATNAME,HFCOUNT)
Q:$G(DONE)
W !!,PXRMTOT
W !,$$CJ^XLFSTR("END OF REPORT",$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
Q
;
W @IOF
W !,$$REPEAT^XLFSTR("-",IOM-2),!
W "Patients with (CC)HT ENROLLMENT-START DATE (PREV ENROLL) Health Factor"
W !,"DATE RANGE - FROM: "_$$FMTE^XLFDT($G(BDT))_" TO: "_$$FMTE^XLFDT(DT)
W !,$G(RUNDATE)
W !,$$REPEAT^XLFSTR("-",IOM-2)
W !," NAME AND LAST 4 SSN"_$$REPEAT^XLFSTR(" ",28)_"ENCOUNTER DATE"
W !," PAGE: "_$G(PG)
W !,$$REPEAT^XLFSTR("=",IOM-2),!
Q
;
FINDPAT ;find patients with HT ENROLLMENT-START DATE (PREV ENROLL) health factor
; find health factor
;^PXRMINDX(FILE NUMBER,"IP",ITEM,DFN,DATE,DAS)
;TOTPAT = total number of patients found
N TOTPAT,FOUND,HFCOUNT,NAMEL4 S (TOTPAT,ZTSTOP)=0
N DFN,HFIEN,HFNAME,PTDFN,VISDATE,EXVISDT,VHFIEN,PTSSN,PTNAME S (HFIEN,PTDFN,VISDATE,EXVISDT)=""
F HFNAME="CCHT ENROLLMENT-START DATE (PREV ENROLL)","HT ENROLLMENT-START DATE (PREV ENROLL)" D
.S HFIEN=$O(^AUTTHF("B",HFNAME,""))
.Q:$G(HFIEN)=""
.S ^TMP("PXRMPATS",$J,HFNAME)=""
.F S PTDFN=$O(^PXRMINDX(9000010.23,"IP",HFIEN,PTDFN)) Q:PTDFN'>""!($G(ZTSTOP)=1) D
..I TOTPAT#50=0,($$S^%ZTLOAD) N X S ZTSTOP=1,X=$$S^%ZTLOAD("Received shutdown request") Q
..S DFN=PTDFN D DEM^VADPT S PTSSN=$P(VADM(2),U,2),PTNAME=VADM(1)
..S PTSSN=$P($G(PTSSN),"-",3),PTSSN="("_PTSSN_")"
..S NAMEL4=" "_PTNAME_" "_PTSSN
..I $L(NAMEL4)<40 S NAMEL4=NAMEL4_($$REPEAT^XLFSTR(" ",(40-$L(NAMEL4))))
..S ^TMP("PXRMPATS",$J,HFNAME,VADM(1),0)=NAMEL4
..S HFCOUNT=0
..F S VISDATE=$O(^PXRMINDX(9000010.23,"IP",HFIEN,PTDFN,VISDATE)) Q:VISDATE="" D
...S FOUND=0
...Q:VISDATE<BDT
...;need to capture each visit date this HF was recorded for this patient
...S:$G(VISDATE)="" EXVISDT="DATE MISSING"
...S EXVISDT=$$FMTE^XLFDT(VISDATE,"D")
...I $L(EXVISDT)<12 S EXVISDT=($$REPEAT^XLFSTR(" ",(12-$L(EXVISDT))))_EXVISDT
...S EXVISDT=$J(EXVISDT,21)
...I HFCOUNT=0 D Q
....S ^TMP("PXRMPATS",$J,HFNAME,VADM(1),0)=^TMP("PXRMPATS",$J,HFNAME,VADM(1),0)_EXVISDT,FOUND=1,TOTPAT=TOTPAT+1,HFCOUNT=HFCOUNT+1
...I HFCOUNT>0 D Q
....S EXVISDT=$J(EXVISDT,61)
....S ^TMP("PXRMPATS",$J,HFNAME,VADM(1),HFCOUNT)=EXVISDT,FOUND=1,HFCOUNT=HFCOUNT+1
..I FOUND=0 D
...K ^TMP("PXRMPATS",$J,HFNAME,VADM(1))
S PXRMTOT="TOTAL PATIENTS FOUND:"_$$REPEAT^XLFSTR("-",28)_TOTPAT
D KVA^VADPT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMCCHT 4612 printed Oct 16, 2024@17:43:57 Page 2
PXRMCCHT ;BP/WAT; Report patients with Previous Enroll health factor ;06/03/16 08:14
+1 ;;2.0;CLINICAL REMINDERS;**19**;Feb 04, 2005;Build 187
+2 ;
+3 ;^VADPT - 10061 ;^XLFDT - 10103 ;^XLFSTR - 10104 ;^%ZTLOAD - 10063 ;XUTMDEVQ - 1519
+4 ;^DIR - 10026 ;^AUTTHF - 3083
+5 ;
EN ;start
+1 NEW BDT,POP,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,PXRMTOT,PXRMSAVE
+2 KILL ^TMP("PXRMPATS",$JOB)
+3 SET DIR(0)="D^2991231:DT"
+4 SET DIR("A")="Start date"
+5 SET DIR("A",1)="This report will try to find all patients that have the"
+6 SET DIR("A",2)="HT ENROLLMENT-START DATE (PREV ENROLL) Health Factor."
+7 SET DIR("A",3)="The default start date is 12/31/1999 and the report will"
+8 SET DIR("A",4)="search forward from that date."
+9 SET DIR("A",5)=""
+10 SET DIR("B")="12/31/1999"
+11 WRITE @IOF
+12 DO ^DIR
+13 if $DATA(DIRUT)
QUIT
+14 SET BDT=$GET(Y)
+15 NEW PXRMTASK
SET PXRMTASK=1
+16 SET PXRMSAVE("*")=""
+17 DO EN^XUTMDEVQ("PRINT^PXRMCCHT","HT Previous Enrollment HF Search",.PXRMSAVE,PXRMTASK)
+18 if $GET(PXRMTASK)>1
WRITE "Queued successfully, task #: "_$GET(PXRMTASK)
+19 QUIT
+20 ;
PRINT ; output
+1 DO FINDPAT
+2 NEW DONE,HFNAME,PATNAME,PXRMPAGE,HFCOUNT,RUNDATE
+3 SET (HFNAME,PATNAME)=""
SET PXRMPAGE=1
SET RUNDATE=$$HTE^XLFDT($HOROLOG,"1P")
+4 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+5 DO HEADER(PXRMPAGE)
SET PXRMPAGE=PXRMPAGE+1
+6 FOR HFNAME="CCHT ENROLLMENT-START DATE (PREV ENROLL)","HT ENROLLMENT-START DATE (PREV ENROLL)"
Begin DoDot:1
+7 if HFNAME["CCHT"
WRITE !,HFNAME
+8 if HFNAME'["CCHT"
WRITE !!,HFNAME
+9 IF $DATA(^TMP("PXRMPATS",$JOB,HFNAME))'>10
WRITE !," No data"
QUIT
+10 IF $Y>(IOSL-3)
Begin DoDot:2
+11 IF $EXTRACT(IOST,1,2)["C-"
Begin DoDot:3
+12 NEW DIR
SET DIR(0)="E"
DO ^DIR
+13 IF 'Y
SET DONE=1
End DoDot:3
+14 if $GET(DONE)
QUIT
+15 DO HEADER(PXRMPAGE)
SET PXRMPAGE=PXRMPAGE+1
End DoDot:2
+16 if $GET(DONE)
QUIT
+17 FOR
SET PATNAME=$ORDER(^TMP("PXRMPATS",$JOB,HFNAME,PATNAME))
if PATNAME=""
QUIT
Begin DoDot:2
+18 IF $Y>(IOSL-3)
Begin DoDot:3
+19 IF $EXTRACT(IOST,1,2)["C-"
Begin DoDot:4
+20 NEW DIR
SET DIR(0)="E"
DO ^DIR
+21 IF 'Y
SET DONE=1
End DoDot:4
+22 if $GET(DONE)
QUIT
+23 DO HEADER(PXRMPAGE)
SET PXRMPAGE=PXRMPAGE+1
End DoDot:3
+24 if $GET(DONE)
QUIT
+25 WRITE !!,^TMP("PXRMPATS",$JOB,HFNAME,PATNAME,0)
+26 SET HFCOUNT=0
+27 FOR
SET HFCOUNT=$ORDER(^TMP("PXRMPATS",$JOB,HFNAME,PATNAME,HFCOUNT))
if HFCOUNT=""!($GET(DONE))
QUIT
Begin DoDot:3
+28 IF $Y>(IOSL-3)
Begin DoDot:4
+29 IF $EXTRACT(IOST,1,2)["C-"
Begin DoDot:5
+30 NEW DIR
SET DIR(0)="E"
DO ^DIR
+31 IF 'Y
SET DONE=1
End DoDot:5
+32 if $GET(DONE)
QUIT
+33 DO HEADER(PXRMPAGE)
SET PXRMPAGE=PXRMPAGE+1
End DoDot:4
+34 if $GET(DONE)
QUIT
+35 WRITE !,^TMP("PXRMPATS",$JOB,HFNAME,PATNAME,HFCOUNT)
End DoDot:3
End DoDot:2
if $GET(DONE)
QUIT
End DoDot:1
if +$GET(DONE)
QUIT
+36 if $GET(DONE)
QUIT
+37 WRITE !!,PXRMTOT
+38 WRITE !,$$CJ^XLFSTR("END OF REPORT",$SELECT(+$GET(IOM)>0:(IOM-1),1:79)," "),!
+39 QUIT
+40 ;
+1 WRITE @IOF
+2 WRITE !,$$REPEAT^XLFSTR("-",IOM-2),!
+3 WRITE "Patients with (CC)HT ENROLLMENT-START DATE (PREV ENROLL) Health Factor"
+4 WRITE !,"DATE RANGE - FROM: "_$$FMTE^XLFDT($GET(BDT))_" TO: "_$$FMTE^XLFDT(DT)
+5 WRITE !,$GET(RUNDATE)
+6 WRITE !,$$REPEAT^XLFSTR("-",IOM-2)
+7 WRITE !," NAME AND LAST 4 SSN"_$$REPEAT^XLFSTR(" ",28)_"ENCOUNTER DATE"
+8 WRITE !," PAGE: "_$GET(PG)
+9 WRITE !,$$REPEAT^XLFSTR("=",IOM-2),!
+10 QUIT
+11 ;
FINDPAT ;find patients with HT ENROLLMENT-START DATE (PREV ENROLL) health factor
+1 ; find health factor
+2 ;^PXRMINDX(FILE NUMBER,"IP",ITEM,DFN,DATE,DAS)
+3 ;TOTPAT = total number of patients found
+4 NEW TOTPAT,FOUND,HFCOUNT,NAMEL4
SET (TOTPAT,ZTSTOP)=0
+5 NEW DFN,HFIEN,HFNAME,PTDFN,VISDATE,EXVISDT,VHFIEN,PTSSN,PTNAME
SET (HFIEN,PTDFN,VISDATE,EXVISDT)=""
+6 FOR HFNAME="CCHT ENROLLMENT-START DATE (PREV ENROLL)","HT ENROLLMENT-START DATE (PREV ENROLL)"
Begin DoDot:1
+7 SET HFIEN=$ORDER(^AUTTHF("B",HFNAME,""))
+8 if $GET(HFIEN)=""
QUIT
+9 SET ^TMP("PXRMPATS",$JOB,HFNAME)=""
+10 FOR
SET PTDFN=$ORDER(^PXRMINDX(9000010.23,"IP",HFIEN,PTDFN))
if PTDFN'>""!($GET(ZTSTOP)=1)
QUIT
Begin DoDot:2
+11 IF TOTPAT#50=0
IF ($$S^%ZTLOAD)
NEW X
SET ZTSTOP=1
SET X=$$S^%ZTLOAD("Received shutdown request")
QUIT
+12 SET DFN=PTDFN
DO DEM^VADPT
SET PTSSN=$PIECE(VADM(2),U,2)
SET PTNAME=VADM(1)
+13 SET PTSSN=$PIECE($GET(PTSSN),"-",3)
SET PTSSN="("_PTSSN_")"
+14 SET NAMEL4=" "_PTNAME_" "_PTSSN
+15 IF $LENGTH(NAMEL4)<40
SET NAMEL4=NAMEL4_($$REPEAT^XLFSTR(" ",(40-$LENGTH(NAMEL4))))
+16 SET ^TMP("PXRMPATS",$JOB,HFNAME,VADM(1),0)=NAMEL4
+17 SET HFCOUNT=0
+18 FOR
SET VISDATE=$ORDER(^PXRMINDX(9000010.23,"IP",HFIEN,PTDFN,VISDATE))
if VISDATE=""
QUIT
Begin DoDot:3
+19 SET FOUND=0
+20 if VISDATE<BDT
QUIT
+21 ;need to capture each visit date this HF was recorded for this patient
+22 if $GET(VISDATE)=""
SET EXVISDT="DATE MISSING"
+23 SET EXVISDT=$$FMTE^XLFDT(VISDATE,"D")
+24 IF $LENGTH(EXVISDT)<12
SET EXVISDT=($$REPEAT^XLFSTR(" ",(12-$LENGTH(EXVISDT))))_EXVISDT
+25 SET EXVISDT=$JUSTIFY(EXVISDT,21)
+26 IF HFCOUNT=0
Begin DoDot:4
+27 SET ^TMP("PXRMPATS",$JOB,HFNAME,VADM(1),0)=^TMP("PXRMPATS",$JOB,HFNAME,VADM(1),0)_EXVISDT
SET FOUND=1
SET TOTPAT=TOTPAT+1
SET HFCOUNT=HFCOUNT+1
End DoDot:4
QUIT
+28 IF HFCOUNT>0
Begin DoDot:4
+29 SET EXVISDT=$JUSTIFY(EXVISDT,61)
+30 SET ^TMP("PXRMPATS",$JOB,HFNAME,VADM(1),HFCOUNT)=EXVISDT
SET FOUND=1
SET HFCOUNT=HFCOUNT+1
End DoDot:4
QUIT
End DoDot:3
+31 IF FOUND=0
Begin DoDot:3
+32 KILL ^TMP("PXRMPATS",$JOB,HFNAME,VADM(1))
End DoDot:3
End DoDot:2
End DoDot:1
+33 SET PXRMTOT="TOTAL PATIENTS FOUND:"_$$REPEAT^XLFSTR("-",28)_TOTPAT
+34 DO KVA^VADPT
+35 QUIT
