- 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 Feb 18, 2025@23:09:29 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
