BIPATER1 ;IHS/CMI/MWR - EDIT PATIENT ERRORS.; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; EDIT/DELETE PATIENT ERRORS.
;
;
;----------
INIT(BIT,BIACT) ;EP
;---> Initialize variables and list array.
;---> Parameters:
; 1 - BIT (ret) Total Patient Errors.
; 2 - BIACT (opt) BIACT=1 include ONLY ACTIVE Patients;
; BIACT=""/0 include ALL PATIENTS.
;
S VALMSG="Enter ?? for more actions."
S VALM("TITLE")=" (Immunization v"_$$VER^BILOGO_")"
;
;---> Order Patient Errors and get Total Patients for Header.
K ^TMP("BIPTER",$J),^TMP("BIPTER1",$J),^TMP("BIPTER2",$J)
;
;---> First, order the errors by DOB,Patient Name.
N BIIEN S BIIEN=0
F S BIIEN=$O(^BIPERR(BIIEN)) Q:'BIIEN D
.N BIDFN,BIDOB,BINAME
.S BIDFN=$P(^BIPERR(BIIEN,0),U)
.;
.;---> Quit if report is ACTIVE ONLY and this patient is not Active.
.I $G(BIACT) Q:$$ACTIVE^BIUTL1(BIDFN)'="Active"
.;
.S BIDOB=9999999-$$DOB^BIUTL1(BIDFN),BINAME=$$NAME^BIUTL1(BIDFN)
.;---> If there's a bogus patient error, delete the error and quit.
.I ('BIDFN)!(BINAME="") D Q
..N DA,DIK S DA=BIIEN,DIK="^BIPERR(" D ^DIK
.;---> Store in order.
.S ^TMP("BIPTER1",$J,BIDOB,BINAME,BIIEN)=^BIPERR(BIIEN,0)
.S BIT=$G(BIT)+1
;
;---> Now place Patient Error lines in Listmanager array.
N BIENT,BILINE,BIN
S (BIENT,BILINE,BIN,BIT)=0
F S BIN=$O(^TMP("BIPTER1",$J,BIN)) Q:'BIN D
.N BIM S BIM=0
.F S BIM=$O(^TMP("BIPTER1",$J,BIN,BIM)) Q:BIM="" D
..N BIIEN S BIIEN=0
..F S BIIEN=$O(^TMP("BIPTER1",$J,BIN,BIM,BIIEN)) Q:'BIIEN D
...N BI0 S BI0=^TMP("BIPTER1",$J,BIN,BIM,BIIEN)
...N BIDFN S BIDFN=$P(BI0,U)
...;
...;---> Set Item# and build Item# array=IEN of Vaccine.
...S BIENT=BIENT+1,^TMP("BIPTER2",$J,BIENT)=BIIEN
...;
...;---> Item#.
...S X=" "_$S(BIENT<10:" "_BIENT,BIENT<100:" "_BIENT,1:BIENT)
...;
...;---> Patient Name.
...S X=X_" "_$E($$NAME^BIUTL1(BIDFN),1,25)
...S X=$$PAD^BIUTL5(X,33,".")
...;
...;---> Active Status.
...S X=X_$E($$ACTIVE^BIUTL1(BIDFN))_" "
...;
...;---> Chart#.
...S X=X_$J($$HRCN^BIUTL1(BIDFN,$G(DUZ(2))),6)
...S X=$$PAD^BIUTL5(X,47," ")
...;
...;---> Age.
...N Y S Y=$$AGEF^BIUTL1(BIDFN)
...S Y=$P(Y," ")_$E($P(Y," ",2)) S:+Y<10 Y=" "_Y
...S X=X_Y
...;
...;---> Vaccine Group.
...S X=$$PAD^BIUTL5(X,53," ")
...S X=X_$P(BI0,U,3)
...;
...;---> Error Text.
...S X=$$PAD^BIUTL5(X,60," ")
...D ERRCD^BIUTL2($P(BI0,U,2),.Y,,1)
...S X=X_Y
...;
...;---> Set this Patient Error display row and index in ^TMP.
...D WRITE(.BILINE,X,,BIENT)
...S BIT=$G(BIT)+1
;
I BILINE=0 D
.N X S X=" Currently there are no Patient Errors stored"
.S:$G(BIACT) X=X_" for ACTIVE Patients" S X=X_"."
.D WRITE(.BILINE),WRITE(.BILINE,X)
;
;---> Finish up Listmanager List Count.
S VALMCNT=BILINE
I VALMCNT>13 D
.S VALMSG="Scroll down to view more. Type ?? for more actions."
Q
;
;
;----------
WRITE(BILINE,BIVAL,BIBLNK,BIENT) ;EP
;---> Write lines to ^TMP (see documentation in ^BIW).
;---> Parameters:
; 1 - BILINE (ret) Last line# written.
; 2 - BIVAL (opt) Value/text of line (Null=blank line).
;
Q:'$D(BILINE)
D WL^BIW(.BILINE,"BIPTER",$G(BIVAL),$G(BIBLNK),$G(BIENT))
Q
;
;
;----------
EDITDEL(BIX) ;EP
;---> Edit/Delete a Patient Error.
;---> Parameters:
; 1 - BIX (opt) If BIX="" call Edit, if BIX=1 call Delete.
;
;---> Call the Listmanager Generic Selector of items displayed.
N VALMY
D EN^VALM2(XQORNOD(0),"OS")
;
;---> Check that a Listman Item was passed.
I '$D(VALMY) D ERRCD^BIUTL2(406,,1) D RESET^BIPATER Q
;---> Now set Y=Item# selected from the list.
N Y S Y=$O(VALMY(0))
I '$G(Y) D ERRCD^BIUTL2(406,,1) D RESET^BIPATER Q
;
N BIIEN S BIIEN=$G(^TMP("BIPTER2",$J,Y))
I 'BIIEN D ERRCD^BIUTL2(661,,1) D RESET^BIPATER Q
;
;---> If this is a call to DELETE an error, delete it and quit.
I $G(BIX) D Q
.N DA,DIK S DA=BIIEN,DIK="^BIPERR("
.D ^DIK,RESET^BIPATER
;
;---> This must be a call to EDIT and error.
N BIDFN S BIDFN=$P($G(^BIPERR(BIIEN,0)),U)
I 'BIDFN D ERRCD^BIUTL2(216,,1) D RESET^BIPATER Q
;
D
.N BIACT
.D HAVEPAT^BIPATVW(BIDFN,DT)
D RESET^BIPATER
Q
;
;
;----------
DELALL ;EP
;---> Clear/Delete ALL Patient Errors.
;
W !!?3,"Do you REALLY wish to delete ALL Patient Errors?"
S DIR("?")=" Enter YES to DELETE ALL Patient Errors."
S DIR(0)="Y",DIR("A")=" Enter Yes or No",DIR("B")="NO"
D ^DIR W !
I $D(DIRUT)!('Y) D Q
.W !!?3,"No changes made." D DIRZ^BIUTL3()
;
D ZGBL^BIUTL8("^BIPERR(")
D RESET^BIPATER
Q
BIPATER1 ;IHS/CMI/MWR - EDIT PATIENT ERRORS.; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; EDIT/DELETE PATIENT ERRORS.
+4 ;
+5 ;
+6 ;----------
INIT(BIT,BIACT) ;EP
+1 ;---> Initialize variables and list array.
+2 ;---> Parameters:
+3 ; 1 - BIT (ret) Total Patient Errors.
+4 ; 2 - BIACT (opt) BIACT=1 include ONLY ACTIVE Patients;
+5 ; BIACT=""/0 include ALL PATIENTS.
+6 ;
+7 SET VALMSG="Enter ?? for more actions."
+8 SET VALM("TITLE")=" (Immunization v"_$$VER^BILOGO_")"
+9 ;
+10 ;---> Order Patient Errors and get Total Patients for Header.
+11 KILL ^TMP("BIPTER",$JOB),^TMP("BIPTER1",$JOB),^TMP("BIPTER2",$JOB)
+12 ;
+13 ;---> First, order the errors by DOB,Patient Name.
+14 NEW BIIEN
SET BIIEN=0
+15 FOR
SET BIIEN=$ORDER(^BIPERR(BIIEN))
IF 'BIIEN
QUIT
Begin DoDot:1
+16 NEW BIDFN,BIDOB,BINAME
+17 SET BIDFN=$PIECE(^BIPERR(BIIEN,0),U)
+18 ;
+19 ;---> Quit if report is ACTIVE ONLY and this patient is not Active.
+20 IF $GET(BIACT)
IF $$ACTIVE^BIUTL1(BIDFN)'="Active"
QUIT
+21 ;
+22 SET BIDOB=9999999-$$DOB^BIUTL1(BIDFN)
SET BINAME=$$NAME^BIUTL1(BIDFN)
+23 ;---> If there's a bogus patient error, delete the error and quit.
+24 IF ('BIDFN)!(BINAME="")
Begin DoDot:2
+25 NEW DA,DIK
SET DA=BIIEN
SET DIK="^BIPERR("
DO ^DIK
End DoDot:2
QUIT
+26 ;---> Store in order.
+27 SET ^TMP("BIPTER1",$JOB,BIDOB,BINAME,BIIEN)=^BIPERR(BIIEN,0)
+28 SET BIT=$GET(BIT)+1
End DoDot:1
+29 ;
+30 ;---> Now place Patient Error lines in Listmanager array.
+31 NEW BIENT,BILINE,BIN
+32 SET (BIENT,BILINE,BIN,BIT)=0
+33 FOR
SET BIN=$ORDER(^TMP("BIPTER1",$JOB,BIN))
IF 'BIN
QUIT
Begin DoDot:1
+34 NEW BIM
SET BIM=0
+35 FOR
SET BIM=$ORDER(^TMP("BIPTER1",$JOB,BIN,BIM))
IF BIM=""
QUIT
Begin DoDot:2
+36 NEW BIIEN
SET BIIEN=0
+37 FOR
SET BIIEN=$ORDER(^TMP("BIPTER1",$JOB,BIN,BIM,BIIEN))
IF 'BIIEN
QUIT
Begin DoDot:3
+38 NEW BI0
SET BI0=^TMP("BIPTER1",$JOB,BIN,BIM,BIIEN)
+39 NEW BIDFN
SET BIDFN=$PIECE(BI0,U)
+40 ;
+41 ;---> Set Item# and build Item# array=IEN of Vaccine.
+42 SET BIENT=BIENT+1
SET ^TMP("BIPTER2",$JOB,BIENT)=BIIEN
+43 ;
+44 ;---> Item#.
+45 SET X=" "_$SELECT(BIENT<10:" "_BIENT,BIENT<100:" "_BIENT,1:BIENT)
+46 ;
+47 ;---> Patient Name.
+48 SET X=X_" "_$EXTRACT($$NAME^BIUTL1(BIDFN),1,25)
+49 SET X=$$PAD^BIUTL5(X,33,".")
+50 ;
+51 ;---> Active Status.
+52 SET X=X_$EXTRACT($$ACTIVE^BIUTL1(BIDFN))_" "
+53 ;
+54 ;---> Chart#.
+55 SET X=X_$JUSTIFY($$HRCN^BIUTL1(BIDFN,$GET(DUZ(2))),6)
+56 SET X=$$PAD^BIUTL5(X,47," ")
+57 ;
+58 ;---> Age.
+59 NEW Y
SET Y=$$AGEF^BIUTL1(BIDFN)
+60 SET Y=$PIECE(Y," ")_$EXTRACT($PIECE(Y," ",2))
IF +Y<10
SET Y=" "_Y
+61 SET X=X_Y
+62 ;
+63 ;---> Vaccine Group.
+64 SET X=$$PAD^BIUTL5(X,53," ")
+65 SET X=X_$PIECE(BI0,U,3)
+66 ;
+67 ;---> Error Text.
+68 SET X=$$PAD^BIUTL5(X,60," ")
+69 DO ERRCD^BIUTL2($PIECE(BI0,U,2),.Y,,1)
+70 SET X=X_Y
+71 ;
+72 ;---> Set this Patient Error display row and index in ^TMP.
+73 DO WRITE(.BILINE,X,,BIENT)
+74 SET BIT=$GET(BIT)+1
End DoDot:3
End DoDot:2
End DoDot:1
+75 ;
+76 IF BILINE=0
Begin DoDot:1
+77 NEW X
SET X=" Currently there are no Patient Errors stored"
+78 IF $GET(BIACT)
SET X=X_" for ACTIVE Patients"
SET X=X_"."
+79 DO WRITE(.BILINE)
DO WRITE(.BILINE,X)
End DoDot:1
+80 ;
+81 ;---> Finish up Listmanager List Count.
+82 SET VALMCNT=BILINE
+83 IF VALMCNT>13
Begin DoDot:1
+84 SET VALMSG="Scroll down to view more. Type ?? for more actions."
End DoDot:1
+85 QUIT
+86 ;
+87 ;
+88 ;----------
WRITE(BILINE,BIVAL,BIBLNK,BIENT) ;EP
+1 ;---> Write lines to ^TMP (see documentation in ^BIW).
+2 ;---> Parameters:
+3 ; 1 - BILINE (ret) Last line# written.
+4 ; 2 - BIVAL (opt) Value/text of line (Null=blank line).
+5 ;
+6 IF '$DATA(BILINE)
QUIT
+7 DO WL^BIW(.BILINE,"BIPTER",$GET(BIVAL),$GET(BIBLNK),$GET(BIENT))
+8 QUIT
+9 ;
+10 ;
+11 ;----------
EDITDEL(BIX) ;EP
+1 ;---> Edit/Delete a Patient Error.
+2 ;---> Parameters:
+3 ; 1 - BIX (opt) If BIX="" call Edit, if BIX=1 call Delete.
+4 ;
+5 ;---> Call the Listmanager Generic Selector of items displayed.
+6 NEW VALMY
+7 DO EN^VALM2(XQORNOD(0),"OS")
+8 ;
+9 ;---> Check that a Listman Item was passed.
+10 IF '$DATA(VALMY)
DO ERRCD^BIUTL2(406,,1)
DO RESET^BIPATER
QUIT
+11 ;---> Now set Y=Item# selected from the list.
+12 NEW Y
SET Y=$ORDER(VALMY(0))
+13 IF '$GET(Y)
DO ERRCD^BIUTL2(406,,1)
DO RESET^BIPATER
QUIT
+14 ;
+15 NEW BIIEN
SET BIIEN=$GET(^TMP("BIPTER2",$JOB,Y))
+16 IF 'BIIEN
DO ERRCD^BIUTL2(661,,1)
DO RESET^BIPATER
QUIT
+17 ;
+18 ;---> If this is a call to DELETE an error, delete it and quit.
+19 IF $GET(BIX)
Begin DoDot:1
+20 NEW DA,DIK
SET DA=BIIEN
SET DIK="^BIPERR("
+21 DO ^DIK
DO RESET^BIPATER
End DoDot:1
QUIT
+22 ;
+23 ;---> This must be a call to EDIT and error.
+24 NEW BIDFN
SET BIDFN=$PIECE($GET(^BIPERR(BIIEN,0)),U)
+25 IF 'BIDFN
DO ERRCD^BIUTL2(216,,1)
DO RESET^BIPATER
QUIT
+26 ;
+27 Begin DoDot:1
+28 NEW BIACT
+29 DO HAVEPAT^BIPATVW(BIDFN,DT)
End DoDot:1
+30 DO RESET^BIPATER
+31 QUIT
+32 ;
+33 ;
+34 ;----------
DELALL ;EP
+1 ;---> Clear/Delete ALL Patient Errors.
+2 ;
+3 WRITE !!?3,"Do you REALLY wish to delete ALL Patient Errors?"
+4 SET DIR("?")=" Enter YES to DELETE ALL Patient Errors."
+5 SET DIR(0)="Y"
SET DIR("A")=" Enter Yes or No"
SET DIR("B")="NO"
+6 DO ^DIR
WRITE !
+7 IF $DATA(DIRUT)!('Y)
Begin DoDot:1
+8 WRITE !!?3,"No changes made."
DO DIRZ^BIUTL3()
End DoDot:1
QUIT
+9 ;
+10 DO ZGBL^BIUTL8("^BIPERR(")
+11 DO RESET^BIPATER
+12 QUIT
