Routine: BIPATER1

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."

 ;----------

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))

 ;----------

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

 .N BIACT

 .D HAVEPAT^BIPATVW(BIDFN,DT)

 D RESET^BIPATER

 ;----------

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

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

BIPATER1.m