- BIPATER ;IHS/CMI/MWR - VIEW/EDIT PATIENT ERRORS ; MAY 10, 2010
- ;;8.5;IMMUNIZATION;;SEP 01,2011
- ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
- ;; EDIT/CORRECT PATIENT ERRORS.
- ;
- ;
- ;----------
- START ;EP
- ;---> Loop through Patient Errors, view/edit/correct.
- D SETVARS^BIUTL5 K ^TMP("BIPTER",$J) N BITMP
- ;
- ;---> If Vaccine Table is not standard, display Error Text and quit.
- I $D(^BISITE(-1)) D ERRCD^BIUTL2(503,,1) Q
- ;
- D TITLE^BIUTL5("VIEW/EDIT PATIENT ERRORS"),TEXT1
- N BIACT,DIR
- S DIR("A")=" Enter ALL or ONLY ACTIVE: ",DIR("B")="ALL"
- S DIR(0)="SAM^0:ALL;1:ONLY ACTIVE"
- D ^DIR K DIR
- Q:($D(DIRUT)!(Y=-1))
- S BIACT=+Y
- W !!?5,"Please hold...",!
- ;
- D EN(BIACT)
- D EXIT
- Q
- ;
- ;
- ;----------
- EN(BIACT) ;EP
- ;---> Call Listman to View/Edit Patient Errors.
- ;---> Parameters:
- ; 1 - BIACT (opt) 0=ALL PATIENTS, 1=ONLY ACTIVE.
- ;
- N BIT
- D EN^VALM("BI PATIENT ERRORS EDIT")
- Q
- ;
- ;
- ;----------
- PRINT ;EP
- ;---> Print Vaccine Table.
- ;---> Called by Protocol BI VACCINE TABLE PRINT, which is the
- ;---> Print List Protocol for the List: BI VACCINE TABLE EDIT.
- ;
- D DEVICE(.BIPOP)
- I $G(BIPOP) D RESET Q
- ;
- D INIT^BIPATER1(.BIT,$G(BIACT)),HDR(1)
- D PRTLST^BIUTL8("BIPTER")
- D RESET
- Q
- ;
- ;
- ;----------
- HDR(BIPRT) ;EP
- ;---> Header code for both Listman Screen and Print List.
- ;---> Parameters:
- ; 1 - BIPRT (opt) If BIPRT=1 array is for print: Change column
- ; header line and add Site Header line.
- ;
- N BILINE,X,Y S BILINE=0 K VALMHDR
- N BICRT S BICRT=$S(($E($G(IOST))="C")!(IOST["BROWSER"):1,1:0)
- ;
- D:'$G(BIPRT) WH^BIW(.BILINE)
- S X=$$REPHDR^BIUTL6(DUZ(2)),BIDASH=$L(X)+2 D CENTERT^BIUTL5(.X)
- D WH^BIW(.BILINE,X)
- ;S X=$$SP^BIUTL5(BIDASH,"-") D CENTERT^BIUTL5(.X)
- S X=$$SP^BIUTL5(32,"-") D CENTERT^BIUTL5(.X)
- D WH^BIW(.BILINE,X)
- ;
- S X=$S($G(BIACT):"ACTIVE",1:"ALL")_" PATIENT ERRORS (Total: "
- S X=X_$G(BIT)_")"
- D CENTERT^BIUTL5(.X)
- S:BICRT X=IOINHI_X_IOINORM
- D WH^BIW(.BILINE,X)
- ;
- D:$G(BIPRT)
- .D WH^BIW(.BILINE)
- .S X="Printed: "_$$NOW^BIUTL5() D CENTERT^BIUTL5(.X)
- .D WH^BIW(.BILINE,X,1)
- .S X=" # Patient Active HRCN# Age V Grp"
- .S X=X_" Error"
- .D WH^BIW(.BILINE,X)
- Q
- ;
- ;
- ;----------
- INIT ;EP
- ;---> Initialize variables and list array.
- ;---> Variables:
- ; 1 - BIT (ret) Total Patient Errors.
- ; 2 - BIACT (opt) 0=ALL PATIENTS, 1=ONLY ACTIVE.
- ;
- D INIT^BIPATER1(.BIT,$G(BIACT))
- Q
- ;
- ;
- ;----------
- RESET ;EP
- ;---> Update partition for return to Listmanager.
- I $D(VALMQUIT) S VALMBCK="Q" Q
- D TERM^VALM0 S VALMBCK="R"
- D INIT,HDR() Q
- ;
- ;
- ;----------
- DEVICE(BIPOP) ;EP
- ;---> Get Device and possibly queue to Taskman.
- ;---> Parameters:
- ; 1 - BIPOP (ret) If error or Queue, BIPOP=1
- ;
- K %ZIS,IOP S BIPOP=0
- S ZTRTN="DEQUEUE^BIPATER"
- D ZSAVES^BIUTL3
- D ZIS^BIUTL2(.BIPOP,1)
- Q
- ;
- ;
- ;----------
- DEQUEUE ;EP
- ;---> Print Patient Data screen.
- N BIT
- D INIT^BIPATER1(.BIT,$G(BIACT)),HDR(1)
- D PRTLST^BIUTL8("BIPTER"),EXIT
- Q
- ;
- ;
- ;----------
- HELP ;EP
- ;---> Help code.
- N BIX S BIX=X
- D FULL^VALM1 N BIPOP
- D TITLE^BIUTL5("EDIT PATIENT ERRORS - HELP, page 1 of 2")
- D TEXT2,DIRZ^BIUTL3(.BIPOP)
- I $G(BIPOP) D RE^VALM4 Q
- D TITLE^BIUTL5("EDIT PATIENT ERRORS - HELP, page 2 of 2")
- D TEXT3,DIRZ^BIUTL3()
- D:BIX'="??" RE^VALM4
- Q
- ;
- ;
- ;----------
- TEXT1 ;EP
- ;;In the View/Edit Patient Errors screen you may display either
- ;;ALL Patients with errors or only those Patients with errors who
- ;;have a Status of ACTIVE.
- ;;
- ;;Enter ALL to include ALL Patients, or enter ONLY ACTIVE to select
- ;;only Active Patients.
- ;;
- ;
- D PRINTX("TEXT1")
- Q
- ;
- ;
- ;----------
- TEXT2 ;EP
- ;;This screen displays patients who whose Immunization Histories
- ;;contain errors, according to the Immserve Forecasting Utility, and
- ;;provides you with the ability to correct or delete those errors.
- ;;
- ;;The columns, from left to right, list:
- ;; 1) Patient Name
- ;; 2) Active/Inactive Status (A=Active, I=Inactive, N=Not In Register)
- ;; 3) HRCN# (Health Record Number or Chart#)
- ;; 4) Age (y=years, m=months, d=days)
- ;; 5) Vaccine Group in which the error is occurring
- ;; 6) An abbreviated statement of what the error is
- ;;
- ;;The three actions at the bottom of the screen allow you to make
- ;;corrections to patient errors on the list or to delete them,
- ;;either individually or all at once.
- ;
- D PRINTX("TEXT2")
- Q
- ;
- ;
- ;----------
- TEXT3 ;EP
- ;;Please note that EACH TIME a patient's forecast is computed (whether
- ;;individually or during the processing of a report), any errors found
- ;;in the patient's history will be stored in the Patient Errors File,
- ;;which is displayed here.
- ;;
- ;;Therefore, if you simply delete a patient error (rather than correct
- ;;it), the error will be placed in the Patient Errors File again the
- ;;next time the patient is is viewed or included in a report.
- ;;
- ;;There may be some cases in which the error cannot be corrected.
- ;;In these cases the Patient History reflects a situation that in fact
- ;;occurred and cannot be "edited". If these are old cases that are
- ;;rarely called up, then simply deleting them from the Error File is
- ;;probably the best action to take.
- ;;
- ;
- D PRINTX("TEXT3")
- 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
- ;
- ;
- ;----------
- EXIT ;EP
- ;---> EOJ cleanup.
- D KILLALL^BIUTL8()
- K ^TMP("BIPTER",$J),^TMP("BIPTER1",$J),^TMP("BIPTER2",$J)
- D CLEAR^VALM1
- D FULL^VALM1
- Q
- BIPATER ;IHS/CMI/MWR - VIEW/EDIT PATIENT ERRORS ; MAY 10, 2010
- +1 ;;8.5;IMMUNIZATION;;SEP 01,2011
- +2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
- +3 ;; EDIT/CORRECT PATIENT ERRORS.
- +4 ;
- +5 ;
- +6 ;----------
- START ;EP
- +1 ;---> Loop through Patient Errors, view/edit/correct.
- +2 DO SETVARS^BIUTL5
- KILL ^TMP("BIPTER",$JOB)
- NEW BITMP
- +3 ;
- +4 ;---> If Vaccine Table is not standard, display Error Text and quit.
- +5 IF $DATA(^BISITE(-1))
- DO ERRCD^BIUTL2(503,,1)
- QUIT
- +6 ;
- +7 DO TITLE^BIUTL5("VIEW/EDIT PATIENT ERRORS")
- DO TEXT1
- +8 NEW BIACT,DIR
- +9 SET DIR("A")=" Enter ALL or ONLY ACTIVE: "
- SET DIR("B")="ALL"
- +10 SET DIR(0)="SAM^0:ALL;1:ONLY ACTIVE"
- +11 DO ^DIR
- KILL DIR
- +12 IF ($DATA(DIRUT)!(Y=-1))
- QUIT
- +13 SET BIACT=+Y
- +14 WRITE !!?5,"Please hold...",!
- +15 ;
- +16 DO EN(BIACT)
- +17 DO EXIT
- +18 QUIT
- +19 ;
- +20 ;
- +21 ;----------
- EN(BIACT) ;EP
- +1 ;---> Call Listman to View/Edit Patient Errors.
- +2 ;---> Parameters:
- +3 ; 1 - BIACT (opt) 0=ALL PATIENTS, 1=ONLY ACTIVE.
- +4 ;
- +5 NEW BIT
- +6 DO EN^VALM("BI PATIENT ERRORS EDIT")
- +7 QUIT
- +8 ;
- +9 ;
- +10 ;----------
- PRINT ;EP
- +1 ;---> Print Vaccine Table.
- +2 ;---> Called by Protocol BI VACCINE TABLE PRINT, which is the
- +3 ;---> Print List Protocol for the List: BI VACCINE TABLE EDIT.
- +4 ;
- +5 DO DEVICE(.BIPOP)
- +6 IF $GET(BIPOP)
- DO RESET
- QUIT
- +7 ;
- +8 DO INIT^BIPATER1(.BIT,$GET(BIACT))
- DO HDR(1)
- +9 DO PRTLST^BIUTL8("BIPTER")
- +10 DO RESET
- +11 QUIT
- +12 ;
- +13 ;
- +14 ;----------
- HDR(BIPRT) ;EP
- +1 ;---> Header code for both Listman Screen and Print List.
- +2 ;---> Parameters:
- +3 ; 1 - BIPRT (opt) If BIPRT=1 array is for print: Change column
- +4 ; header line and add Site Header line.
- +5 ;
- +6 NEW BILINE,X,Y
- SET BILINE=0
- KILL VALMHDR
- +7 NEW BICRT
- SET BICRT=$SELECT(($EXTRACT($GET(IOST))="C")!(IOST["BROWSER"):1,1:0)
- +8 ;
- +9 IF '$GET(BIPRT)
- DO WH^BIW(.BILINE)
- +10 SET X=$$REPHDR^BIUTL6(DUZ(2))
- SET BIDASH=$LENGTH(X)+2
- DO CENTERT^BIUTL5(.X)
- +11 DO WH^BIW(.BILINE,X)
- +12 ;S X=$$SP^BIUTL5(BIDASH,"-") D CENTERT^BIUTL5(.X)
- +13 SET X=$$SP^BIUTL5(32,"-")
- DO CENTERT^BIUTL5(.X)
- +14 DO WH^BIW(.BILINE,X)
- +15 ;
- +16 SET X=$SELECT($GET(BIACT):"ACTIVE",1:"ALL")_" PATIENT ERRORS (Total: "
- +17 SET X=X_$GET(BIT)_")"
- +18 DO CENTERT^BIUTL5(.X)
- +19 IF BICRT
- SET X=IOINHI_X_IOINORM
- +20 DO WH^BIW(.BILINE,X)
- +21 ;
- +22 IF $GET(BIPRT)
- Begin DoDot:1
- +23 DO WH^BIW(.BILINE)
- +24 SET X="Printed: "_$$NOW^BIUTL5()
- DO CENTERT^BIUTL5(.X)
- +25 DO WH^BIW(.BILINE,X,1)
- +26 SET X=" # Patient Active HRCN# Age V Grp"
- +27 SET X=X_" Error"
- +28 DO WH^BIW(.BILINE,X)
- End DoDot:1
- +29 QUIT
- +30 ;
- +31 ;
- +32 ;----------
- INIT ;EP
- +1 ;---> Initialize variables and list array.
- +2 ;---> Variables:
- +3 ; 1 - BIT (ret) Total Patient Errors.
- +4 ; 2 - BIACT (opt) 0=ALL PATIENTS, 1=ONLY ACTIVE.
- +5 ;
- +6 DO INIT^BIPATER1(.BIT,$GET(BIACT))
- +7 QUIT
- +8 ;
- +9 ;
- +10 ;----------
- RESET ;EP
- +1 ;---> Update partition for return to Listmanager.
- +2 IF $DATA(VALMQUIT)
- SET VALMBCK="Q"
- QUIT
- +3 DO TERM^VALM0
- SET VALMBCK="R"
- +4 DO INIT
- DO HDR()
- QUIT
- +5 ;
- +6 ;
- +7 ;----------
- DEVICE(BIPOP) ;EP
- +1 ;---> Get Device and possibly queue to Taskman.
- +2 ;---> Parameters:
- +3 ; 1 - BIPOP (ret) If error or Queue, BIPOP=1
- +4 ;
- +5 KILL %ZIS,IOP
- SET BIPOP=0
- +6 SET ZTRTN="DEQUEUE^BIPATER"
- +7 DO ZSAVES^BIUTL3
- +8 DO ZIS^BIUTL2(.BIPOP,1)
- +9 QUIT
- +10 ;
- +11 ;
- +12 ;----------
- DEQUEUE ;EP
- +1 ;---> Print Patient Data screen.
- +2 NEW BIT
- +3 DO INIT^BIPATER1(.BIT,$GET(BIACT))
- DO HDR(1)
- +4 DO PRTLST^BIUTL8("BIPTER")
- DO EXIT
- +5 QUIT
- +6 ;
- +7 ;
- +8 ;----------
- HELP ;EP
- +1 ;---> Help code.
- +2 NEW BIX
- SET BIX=X
- +3 DO FULL^VALM1
- NEW BIPOP
- +4 DO TITLE^BIUTL5("EDIT PATIENT ERRORS - HELP, page 1 of 2")
- +5 DO TEXT2
- DO DIRZ^BIUTL3(.BIPOP)
- +6 IF $GET(BIPOP)
- DO RE^VALM4
- QUIT
- +7 DO TITLE^BIUTL5("EDIT PATIENT ERRORS - HELP, page 2 of 2")
- +8 DO TEXT3
- DO DIRZ^BIUTL3()
- +9 IF BIX'="??"
- DO RE^VALM4
- +10 QUIT
- +11 ;
- +12 ;
- +13 ;----------
- TEXT1 ;EP
- +1 ;;In the View/Edit Patient Errors screen you may display either
- +2 ;;ALL Patients with errors or only those Patients with errors who
- +3 ;;have a Status of ACTIVE.
- +4 ;;
- +5 ;;Enter ALL to include ALL Patients, or enter ONLY ACTIVE to select
- +6 ;;only Active Patients.
- +7 ;;
- +8 ;
- +9 DO PRINTX("TEXT1")
- +10 QUIT
- +11 ;
- +12 ;
- +13 ;----------
- TEXT2 ;EP
- +1 ;;This screen displays patients who whose Immunization Histories
- +2 ;;contain errors, according to the Immserve Forecasting Utility, and
- +3 ;;provides you with the ability to correct or delete those errors.
- +4 ;;
- +5 ;;The columns, from left to right, list:
- +6 ;; 1) Patient Name
- +7 ;; 2) Active/Inactive Status (A=Active, I=Inactive, N=Not In Register)
- +8 ;; 3) HRCN# (Health Record Number or Chart#)
- +9 ;; 4) Age (y=years, m=months, d=days)
- +10 ;; 5) Vaccine Group in which the error is occurring
- +11 ;; 6) An abbreviated statement of what the error is
- +12 ;;
- +13 ;;The three actions at the bottom of the screen allow you to make
- +14 ;;corrections to patient errors on the list or to delete them,
- +15 ;;either individually or all at once.
- +16 ;
- +17 DO PRINTX("TEXT2")
- +18 QUIT
- +19 ;
- +20 ;
- +21 ;----------
- TEXT3 ;EP
- +1 ;;Please note that EACH TIME a patient's forecast is computed (whether
- +2 ;;individually or during the processing of a report), any errors found
- +3 ;;in the patient's history will be stored in the Patient Errors File,
- +4 ;;which is displayed here.
- +5 ;;
- +6 ;;Therefore, if you simply delete a patient error (rather than correct
- +7 ;;it), the error will be placed in the Patient Errors File again the
- +8 ;;next time the patient is is viewed or included in a report.
- +9 ;;
- +10 ;;There may be some cases in which the error cannot be corrected.
- +11 ;;In these cases the Patient History reflects a situation that in fact
- +12 ;;occurred and cannot be "edited". If these are old cases that are
- +13 ;;rarely called up, then simply deleting them from the Error File is
- +14 ;;probably the best action to take.
- +15 ;;
- +16 ;
- +17 DO PRINTX("TEXT3")
- +18 QUIT
- +19 ;
- +20 ;
- +21 ;----------
- 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
- +5 ;
- +6 ;
- +7 ;----------
- EXIT ;EP
- +1 ;---> EOJ cleanup.
- +2 DO KILLALL^BIUTL8()
- +3 KILL ^TMP("BIPTER",$JOB),^TMP("BIPTER1",$JOB),^TMP("BIPTER2",$JOB)
- +4 DO CLEAR^VALM1
- +5 DO FULL^VALM1
- +6 QUIT
