BIREPVP ;IHS/CMI/MWR - REPORT, VIEW PATIENTS IN REPORT.; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; REPORTS, VIEW LIST OF PATIENTS IN REPORT: REJECTED, APPROPRIATE, OR ALL.
;
;---> Called by Protocols BI REPORT GEN PATIENTS - NOT APPRO, - APPRO,
;---> and - ALL, on the Protocol Menu BI MENU REPORT GEN PATIENTS VIEW.
;---> Assumption is that a list of patients is sitting out in ^TMP("BIDUL",$J.
;
;----------
MAIN(BIPG1,BIRTN,BITITL,BIRPDT,BIPG2) ;
;W !,"JUST CALLED BIREPVP, PASSED BIRTN: ",BIRTN R ZZZ
;---> Display Patients.
;---> Parameters:
; 1 - BIPG1 (opt) Patient Group: 0=All, 1=Due only, 2=Appropriate only.
; 2 - BIRTN (req) Routine to make Init call when returning.
; 3 - BITITL (opt) Report Name
; 4 - BIRPDT (opt) Report Date: Today unless passed from reports
; (e.g., Quarterly Report).
; 5 - BIPG2 (opt) Patient Group: Text for Patient Group report header.
; If it follows null, overrides BIPG1.
;
;---> If <STKOV> errors appear here, increase STACK in SYSGEN,
;---> System Configuration Parameters.
;
S:(($G(BIPG1)<1)!($G(BIPG1)>2)) BIPG1=0
S BITITL=$S($G(BITITL)]"":BITITL_" ",1:"")
S:'$G(BIRPDT) BIRPDT=DT
;
D
.N BIAGRPS,BIBEGDT,BIBEN,BICC,BICM,BICPT,BICPTI,BIDAR,BIENDDT,BIFDT,BIFH,BIHCF
.N BIHPV,BILOT,BIMD
.N BIMMD,BIMMR,BINFO,BINFO1,BIORD,BIPG,BIQDT,BIRTN,BISITE,BIT,BITAR,BITOTFPT
.N BITOTMPT,BITOTPTS,BIUP,BIYEAR
.D START(BIPG1,BITITL,BIRPDT,$G(BIPG2))
;
Q:$G(BIRTN)=""
D TITLE^BIUTL5("RETURNING TO THE "_BITITL_"REPORT"),TEXT4
N DIR S DIR("A")=" Update Report now (Yes/No)",DIR(0)="Y",DIR("B")="NO"
S DIR("?")=" Enter YES to update the report, enter NO to save time."
D ^DIR W !
Q:$D(DIRUT)!('Y)
D @("INIT^"_BIRTN)
Q
;
;
;----------
START(BIPG1,BITITL,BIRPDT,BIPG2) ;EP
;---> Display Patients.
;---> Parameters:
; 1 - BIPG1 (opt) Patient Group: 0=All, 1=Due only, 2=Appropriate only.
; 2 - BITITL (opt) Report Name
; 3 - BIRPDT (opt) Report Date: Today unless passed from reports
; (e.g., Quarterly Report).
; 4 - BIPG2 (opt) Patient Group: Text for Patient Group report header.
; If it follows null, overrides BIPG1.
;
;---> If Vaccine Table is not standard, display Error Text and quit.
I $D(^BISITE(-1)) D ERRCD^BIUTL2(503,,1) Q
D SETVARS^BIUTL5
;
N BIPOP
D D DIRZ^BIUTL3(.BIPOP)
.I $G(BIPG1)=1 D Q
..D TITLE^BIUTL5("VIEW PATIENTS NOT CURRENT IN "_BITITL_"REPORT"),TEXT1 Q
.I $G(BIPG1)=2 D Q
..D TITLE^BIUTL5("VIEW PATIENTS CURRENT IN "_BITITL_"REPORT"),TEXT2
.D TITLE^BIUTL5("VIEW ALL PATIENTS REVIEWED IN "_BITITL_"REPORT"),TEXT3 Q
Q:$G(BIPOP)
W !!?5,"Please hold...",!
;
;---> Get Total Patients from ^TMP("BIDUL",$J,CURCOM,1,HRCN,BIDFN)
;---> Seed loops with -1 to pick up entries with a subscript of 0. Imm v8.5.
N BIT S BIT=0
D
.N BIDFN,N,M,P
.S N=-1
.F S N=$O(^TMP("BIDUL",$J,N)) Q:N="" D
..S M=-1
..F S M=$O(^TMP("BIDUL",$J,N,M)) Q:M="" D
...S P=-1
...F S P=$O(^TMP("BIDUL",$J,N,M,P)) Q:P="" D
....N BIPG11
....S BIDFN=0
....F S BIDFN=$O(^TMP("BIDUL",$J,N,M,P,BIDFN)) Q:'BIDFN S BIPG11=^(BIDFN) D
.....;---> BIPG1=0=All (no filter), 1=Not Appro, 2=Appropriate.
.....I $G(BIPG1) Q:BIPG1'=BIPG11
.....S BIT=BIT+1
;
;---> For now, comment out any additional info, per Group's request v8.0.
;N BINFO S BINFO="1,2,3,5,7,8"
N BIPG D
.I BIPG2]"" S BIPG=BIPG2 Q
.S BIPG="Report - "_$S(BIPG1=1:"Not Current",BIPG1=2:"Current",1:"Both Groups")
;---> Second piece of Age: 0 or null=months, 1=years.
K ^TMP("BIDULV",$J)
D START^BIDUVLS1(+$G(DT),,BIPG,$G(BIAG),BIT,BIPG1,1,BITITL,BIRPDT)
Q
;
;
;----------
TEXT1 ;EP
;;This action will display a List of the patients who were NOT within
;;the recommended guidelines for immunizations for their age.
;;
D PRINTX("TEXT1")
Q
;
;
;----------
TEXT2 ;EP
;;This action will display a List of the patients who were WITHIN
;;the recommended guidelines for immunizations for their age.
;;
;;
D PRINTX("TEXT2")
Q
;
;
;----------
TEXT3 ;EP
;;This action will display a list of ALL the patients who were
;;considered in this report.
;;
;;
D PRINTX("TEXT3")
Q
;
;
;----------
TEXT4 ;EP
;;You are about to return to the report that included these patients.
;;If you made changes to the patient you were just viewing, it is possible
;;that the changes have affected the report.
;;
;;At this point you have two options:
;;
;; 1) You may re-run the report to reflect any updated information you
;; have entered. HOWEVER, be aware that re-running the report may take
;; considerable time, depending on the amount of data in your database.
;;
;; 2) You may return to the report and select other patients, without
;; taking time to update the report immediately. This would save time,
;; allowing you to continue working with a series of patients more
;; efficiently and updating the report only when you're done.
;;
;;Do you wish to update the report now, before returning to it?
;;
D PRINTX("TEXT4")
Q
;
;
;----------
PRINTX(BILINL,BITAB) ;EP
Q:$G(BILINL)=""
N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" "
F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
Q
BIREPVP ;IHS/CMI/MWR - REPORT, VIEW PATIENTS IN REPORT.; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; REPORTS, VIEW LIST OF PATIENTS IN REPORT: REJECTED, APPROPRIATE, OR ALL.
+4 ;
+5 ;---> Called by Protocols BI REPORT GEN PATIENTS - NOT APPRO, - APPRO,
+6 ;---> and - ALL, on the Protocol Menu BI MENU REPORT GEN PATIENTS VIEW.
+7 ;---> Assumption is that a list of patients is sitting out in ^TMP("BIDUL",$J.
+8 ;
+9 ;----------
MAIN(BIPG1,BIRTN,BITITL,BIRPDT,BIPG2) ;
+1 ;W !,"JUST CALLED BIREPVP, PASSED BIRTN: ",BIRTN R ZZZ
+2 ;---> Display Patients.
+3 ;---> Parameters:
+4 ; 1 - BIPG1 (opt) Patient Group: 0=All, 1=Due only, 2=Appropriate only.
+5 ; 2 - BIRTN (req) Routine to make Init call when returning.
+6 ; 3 - BITITL (opt) Report Name
+7 ; 4 - BIRPDT (opt) Report Date: Today unless passed from reports
+8 ; (e.g., Quarterly Report).
+9 ; 5 - BIPG2 (opt) Patient Group: Text for Patient Group report header.
+10 ; If it follows null, overrides BIPG1.
+11 ;
+12 ;---> If <STKOV> errors appear here, increase STACK in SYSGEN,
+13 ;---> System Configuration Parameters.
+14 ;
+15 IF (($GET(BIPG1)<1)!($GET(BIPG1)>2))
SET BIPG1=0
+16 SET BITITL=$SELECT($GET(BITITL)]"":BITITL_" ",1:"")
+17 IF '$GET(BIRPDT)
SET BIRPDT=DT
+18 ;
+19 Begin DoDot:1
+20 NEW BIAGRPS,BIBEGDT,BIBEN,BICC,BICM,BICPT,BICPTI,BIDAR,BIENDDT,BIFDT,BIFH,BIHCF
+21 NEW BIHPV,BILOT,BIMD
+22 NEW BIMMD,BIMMR,BINFO,BINFO1,BIORD,BIPG,BIQDT,BIRTN,BISITE,BIT,BITAR,BITOTFPT
+23 NEW BITOTMPT,BITOTPTS,BIUP,BIYEAR
+24 DO START(BIPG1,BITITL,BIRPDT,$GET(BIPG2))
End DoDot:1
+25 ;
+26 IF $GET(BIRTN)=""
QUIT
+27 DO TITLE^BIUTL5("RETURNING TO THE "_BITITL_"REPORT")
DO TEXT4
+28 NEW DIR
SET DIR("A")=" Update Report now (Yes/No)"
SET DIR(0)="Y"
SET DIR("B")="NO"
+29 SET DIR("?")=" Enter YES to update the report, enter NO to save time."
+30 DO ^DIR
WRITE !
+31 IF $DATA(DIRUT)!('Y)
QUIT
+32 DO @("INIT^"_BIRTN)
+33 QUIT
+34 ;
+35 ;
+36 ;----------
START(BIPG1,BITITL,BIRPDT,BIPG2) ;EP
+1 ;---> Display Patients.
+2 ;---> Parameters:
+3 ; 1 - BIPG1 (opt) Patient Group: 0=All, 1=Due only, 2=Appropriate only.
+4 ; 2 - BITITL (opt) Report Name
+5 ; 3 - BIRPDT (opt) Report Date: Today unless passed from reports
+6 ; (e.g., Quarterly Report).
+7 ; 4 - BIPG2 (opt) Patient Group: Text for Patient Group report header.
+8 ; If it follows null, overrides BIPG1.
+9 ;
+10 ;---> If Vaccine Table is not standard, display Error Text and quit.
+11 IF $DATA(^BISITE(-1))
DO ERRCD^BIUTL2(503,,1)
QUIT
+12 DO SETVARS^BIUTL5
+13 ;
+14 NEW BIPOP
+15 Begin DoDot:1
+16 IF $GET(BIPG1)=1
Begin DoDot:2
+17 DO TITLE^BIUTL5("VIEW PATIENTS NOT CURRENT IN "_BITITL_"REPORT")
DO TEXT1
QUIT
End DoDot:2
QUIT
+18 IF $GET(BIPG1)=2
Begin DoDot:2
+19 DO TITLE^BIUTL5("VIEW PATIENTS CURRENT IN "_BITITL_"REPORT")
DO TEXT2
End DoDot:2
QUIT
+20 DO TITLE^BIUTL5("VIEW ALL PATIENTS REVIEWED IN "_BITITL_"REPORT")
DO TEXT3
QUIT
End DoDot:1
DO DIRZ^BIUTL3(.BIPOP)
+21 IF $GET(BIPOP)
QUIT
+22 WRITE !!?5,"Please hold...",!
+23 ;
+24 ;---> Get Total Patients from ^TMP("BIDUL",$J,CURCOM,1,HRCN,BIDFN)
+25 ;---> Seed loops with -1 to pick up entries with a subscript of 0. Imm v8.5.
+26 NEW BIT
SET BIT=0
+27 Begin DoDot:1
+28 NEW BIDFN,N,M,P
+29 SET N=-1
+30 FOR
SET N=$ORDER(^TMP("BIDUL",$JOB,N))
IF N=""
QUIT
Begin DoDot:2
+31 SET M=-1
+32 FOR
SET M=$ORDER(^TMP("BIDUL",$JOB,N,M))
IF M=""
QUIT
Begin DoDot:3
+33 SET P=-1
+34 FOR
SET P=$ORDER(^TMP("BIDUL",$JOB,N,M,P))
IF P=""
QUIT
Begin DoDot:4
+35 NEW BIPG11
+36 SET BIDFN=0
+37 FOR
SET BIDFN=$ORDER(^TMP("BIDUL",$JOB,N,M,P,BIDFN))
IF 'BIDFN
QUIT
SET BIPG11=^(BIDFN)
Begin DoDot:5
+38 ;---> BIPG1=0=All (no filter), 1=Not Appro, 2=Appropriate.
+39 IF $GET(BIPG1)
IF BIPG1'=BIPG11
QUIT
+40 SET BIT=BIT+1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+41 ;
+42 ;---> For now, comment out any additional info, per Group's request v8.0.
+43 ;N BINFO S BINFO="1,2,3,5,7,8"
+44 NEW BIPG
Begin DoDot:1
+45 IF BIPG2]""
SET BIPG=BIPG2
QUIT
+46 SET BIPG="Report - "_$SELECT(BIPG1=1:"Not Current",BIPG1=2:"Current",1:"Both Groups")
End DoDot:1
+47 ;---> Second piece of Age: 0 or null=months, 1=years.
+48 KILL ^TMP("BIDULV",$JOB)
+49 DO START^BIDUVLS1(+$GET(DT),,BIPG,$GET(BIAG),BIT,BIPG1,1,BITITL,BIRPDT)
+50 QUIT
+51 ;
+52 ;
+53 ;----------
TEXT1 ;EP
+1 ;;This action will display a List of the patients who were NOT within
+2 ;;the recommended guidelines for immunizations for their age.
+3 ;;
+4 DO PRINTX("TEXT1")
+5 QUIT
+6 ;
+7 ;
+8 ;----------
TEXT2 ;EP
+1 ;;This action will display a List of the patients who were WITHIN
+2 ;;the recommended guidelines for immunizations for their age.
+3 ;;
+4 ;;
+5 DO PRINTX("TEXT2")
+6 QUIT
+7 ;
+8 ;
+9 ;----------
TEXT3 ;EP
+1 ;;This action will display a list of ALL the patients who were
+2 ;;considered in this report.
+3 ;;
+4 ;;
+5 DO PRINTX("TEXT3")
+6 QUIT
+7 ;
+8 ;
+9 ;----------
TEXT4 ;EP
+1 ;;You are about to return to the report that included these patients.
+2 ;;If you made changes to the patient you were just viewing, it is possible
+3 ;;that the changes have affected the report.
+4 ;;
+5 ;;At this point you have two options:
+6 ;;
+7 ;; 1) You may re-run the report to reflect any updated information you
+8 ;; have entered. HOWEVER, be aware that re-running the report may take
+9 ;; considerable time, depending on the amount of data in your database.
+10 ;;
+11 ;; 2) You may return to the report and select other patients, without
+12 ;; taking time to update the report immediately. This would save time,
+13 ;; allowing you to continue working with a series of patients more
+14 ;; efficiently and updating the report only when you're done.
+15 ;;
+16 ;;Do you wish to update the report now, before returning to it?
+17 ;;
+18 DO PRINTX("TEXT4")
+19 QUIT
+20 ;
+21 ;
+22 ;----------
PRINTX(BILINL,BITAB) ;EP
+1 IF $GET(BILINL)=""
QUIT
+2 NEW I,T,X
SET T=""
IF '$DATA(BITAB)
SET BITAB=5
FOR I=1:1:BITAB
SET T=T_" "
+3 FOR I=1:1
SET X=$TEXT(@BILINL+I)
IF X'[";;"
QUIT
WRITE !,T,$PIECE(X,";;",2)
+4 QUIT
