- 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
