Routine: BIDUVLS

BIDUVLS ;IHS/CMI/MWR - VIEW DUE LIST.; MAY 10, 2010

 ;;8.5;IMMUNIZATION;;SEP 01,2011

 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 ;;  VIEW LIST OF PATIENTS (DUE LIST OR MASTER LIST).

 ;;  CALLED BY PROTOCOL: BI DUE LIST OF PATIENTS ("List of Patients")`

 ;----------

VIEWDUE ;EP

 ;---> View Immunization Due list.

 ;---> Called by Protocol BI DUE LIST OF PATIENTS.

 ;---> Variables:

 ;     1 - BIAG   (req) Age Range in months.

 ;     2 - BIPG   (req) Patient Group Data; see PGRPOUP1^BIOUTPT4 for details.

 ;     3 - BIFDT  (req) Forecast date.

 ;     4 - BICC   (req) Current Community array.

 ;     5 - BICM   (req) Case Manager array.

 ;     6 - BIDPRV (req) Designated Provider array.

 ;     7 - BIMMR  (req) Immunizations Received array.

 ;     8 - BIMMD  (req) Immunizations Due array.

 ;     9 - BIHCF  (req) Health Care Facility array.

 ;    10 - BILOT  (req) Lot Number array.

 ;    11 - BIORD  (req) Order of listing.

 ;    12 - BINFO  (opt) Array of Additional Information elements (may be null).

 ;    13 - BIRDT  (opt) Date Range for Received Imms (form BEGDATE:ENDDATE).

 ;    14 - BIDED  (opt) Include Deceased Patients (0=no, 1=yes).

 ;    15 - BIMMRF (opt) Imms Received Filter array (subscript=CVX's included).

 ;    16 - BIBEN  (req) Beneficiary Type array: either BIBEN(1) or BIBEN("ALL").

 ;---> Check for required Variables.

 I '$D(BIAG) D ERROR(613) Q

 I '$D(BIPG) D ERROR(620) Q

 I '$G(BIFDT) D ERROR(616) Q

 I '$D(BICC) D ERROR(614) Q

 I '$D(BICM) D ERROR(615) Q

 I '$D(BIDPRV) D ERROR(680) Q

 I '$D(BIMMR) D ERROR(652) Q

 I '$D(BIMMD) D ERROR(638) Q

 I '$D(BIHCF) D ERROR(625) Q

 I '$D(BILOT) D ERROR(630) Q

 I '$G(BIORD) D ERROR(618) Q

 ;I '$D(BINFO) D ERROR(629) Q  ;Additional Info not required (may be null).

 ;  ;BIMMRF not required (may be null).

 I '$D(BIRDT) S BIRDT=""

 I '$D(BIDED) S BIDED=0

 I '$D(BIBEN) S BIBEN(1)=""

 D FULL^VALM1 N BIERR

 D TITLE^BIUTL5("PRINT OR VIEW LIST"),TEXT1

 N DIR

 S DIR("A")="     Select Print or View: ",DIR("B")="View"

 S DIR(0)="SAM^p:Print;v:View;q:Quit"

 D ^DIR K DIR

 I Y=-1!($D(DIRUT)) D RESET^BIDU Q

 ;---> User chose to Quit.

 I Y="q" D RESET^BIDU Q

VIEW ;---> User chose to VIEW Due List.

 I Y="v" D  Q

 .W !!?10,"This may take some time.  Please hold on...",!

.;

 .;---> Retrieve patients for this listing.

 .;---> (Patient's forecast gets updated at CHKSET+60^BIDUR.)

 .;---> Since this is List (not Letter), send 0 days since last letter

 .;---> as 10th parameter.  BIT=Total Patients retrieved.

.;

 .;D NOW1^BIUTL3

 .D RETRIEVE(.BIT,.BIERR)

 .I $G(BIERR) D ERROR(BIERR),EXIT,RESET^BIDU Q

 .;D NOW2^BIUTL3

.;

 .;---> Display list of patients retrieved.

 .K ^TMP("BIDULV",$J)

 .D START^BIDUVLS1(BIFDT,.BINFO,BIPG,BIAG,BIT,,,,,.BIBEN)

 .D EXIT,RESET^BIDU

PRINT ;EP

 ;---> User chose to PRINT Due List.

 N BIPOP

 D DEVICE(.BIPOP)

 I $G(BIPOP) D RESET^BIDU Q

 D:$G(IO)'=$G(IO(0))

 .W !!?10,"This may take some time.  Please hold on...",!

 ;---> Retrieve patients for this listing.

 D RETRIEVE(.BIT,.BIERR)

 I $G(BIERR) D ERROR(BIERR),EXIT,RESET^BIDU Q

 ;---> Print list of patients retrieved.

 ;---> Cannot pass params to INIT, but should have BIFDTDT,

 ;---> BINFO, and BIT defined.

 K ^TMP("BIDULV",$J)

 N VALM,VALMHDR

 D HDR^BIDUVLS1,INIT^BIDUVLS1

 D PRTLST^BIUTL8("BIDULV")

 D EXIT,RESET^BIDU

 ;----------

RETRIEVE(BIT,BIERR) ;EP

 ;---> Retrieve patients according to parameters set.

 ;---> Parameters:

 ;     1 - BIT   (ret) Total Patients retrieved.

 ;     2 - BIERR (ret) Error Code.

 D R^BIDUR(BIAG,BIPG,BIFDT,.BICC,.BICM,.BIMMR,.BIMMD,.BILOT,0,BIORD,BIRDT,BIDED,.BIT,.BIHCF,.BIDPRV,.BIERR,.BIBEN)

 ;----------

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^BIDUVLS"

 D ZSAVES^BIUTL3

 D ZIS^BIUTL2(.BIPOP,1)

 ;----------

DEQUEUE ;EP

 ;---> Print list of patients retrieved.

 D RETRIEVE(.BIT,.BIERR)

 I $G(BIERR) D EXIT Q

 K VALMHDR,^TMP("BIDULV",$J)

 D HDR^BIDUVLS1,INIT^BIDUVLS1

 D PRTLST^BIUTL8("BIDULV")

 D EXIT

 ;----------

ERROR(BIERR) ;EP

 ;---> Report error, reset Listman screen and quit.

 ;---> Parameters:

 ;     1 - BIERR  (ret) Text of Error Code if any, otherwise null.

 S:'$G(BIERR) BIERR=999

 D ERRCD^BIUTL2(BIERR,,1) D RESET^BIDU Q

TEXT1 ;

 ;;You may either PRINT the List or VIEW it on this screen.

;;

 ;;PRINT: If it customarily takes a long time for your computer

 ;;to produce a List of Patients, it may be more efficient for you

 ;;to QUEUE it to a printer.  That way you can be free to do other

 ;;things until the printout is finished.

;;

 ;;VIEW:  You will have to wait while the computer retrieves the

 ;;information.  However, once the List of Patients comes up on

 ;;the screen, you will be able to browse the list on screen by

 ;;scrolling up and down using the arrow keys.

;;

 D PRINTX("TEXT1",5)

 ;----------

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)

 ;----------

EXIT ;EP

 ;---> Cleanup and Quit.

 K ^TMP("BIDULV",$J)

 ;----------

EDITPAT ;EP

 ;---> Edit Patient from List.

 S:'$G(BIORD) BIORD=1

 D FULL^VALM1

 .N BIAG,BIBEN,BICC,BICM,BICPT,BIDPRV,BIFDT,BIHCF,BILOT,BIMD

 .N BIMMD,BIMMR,BINFO,BIORD,BIPG,BIQDT,BIRPDT,BIT

 .D ONEPAT^BIPATVW

 S VALMBCK="R"

BIDUVLS   ;IHS/CMI/MWR - VIEW DUE LIST.; MAY 10, 2010

 +1       ;;8.5;IMMUNIZATION;;SEP 01,2011

 +2       ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 +3       ;;  VIEW LIST OF PATIENTS (DUE LIST OR MASTER LIST).

 +4       ;;  CALLED BY PROTOCOL: BI DUE LIST OF PATIENTS ("List of Patients")`

 +5       ;

 +6       ;

 +7       ;----------

VIEWDUE   ;EP

 +1       ;---> View Immunization Due list.

 +2       ;---> Called by Protocol BI DUE LIST OF PATIENTS.

 +3       ;---> Variables:

 +4       ;     1 - BIAG   (req) Age Range in months.

 +5       ;     2 - BIPG   (req) Patient Group Data; see PGRPOUP1^BIOUTPT4 for details.

 +6       ;     3 - BIFDT  (req) Forecast date.

 +7       ;     4 - BICC   (req) Current Community array.

 +8       ;     5 - BICM   (req) Case Manager array.

 +9       ;     6 - BIDPRV (req) Designated Provider array.

 +10      ;     7 - BIMMR  (req) Immunizations Received array.

 +11      ;     8 - BIMMD  (req) Immunizations Due array.

 +12      ;     9 - BIHCF  (req) Health Care Facility array.

 +13      ;    10 - BILOT  (req) Lot Number array.

 +14      ;    11 - BIORD  (req) Order of listing.

 +15      ;    12 - BINFO  (opt) Array of Additional Information elements (may be null).

 +16      ;    13 - BIRDT  (opt) Date Range for Received Imms (form BEGDATE:ENDDATE).

 +17      ;    14 - BIDED  (opt) Include Deceased Patients (0=no, 1=yes).

 +18      ;    15 - BIMMRF (opt) Imms Received Filter array (subscript=CVX's included).

 +19      ;    16 - BIBEN  (req) Beneficiary Type array: either BIBEN(1) or BIBEN("ALL").

 +20      ;

 +21      ;---> Check for required Variables.

 +22       IF '$DATA(BIAG)

               DO ERROR(613)

               QUIT

 +23       IF '$DATA(BIPG)

               DO ERROR(620)

               QUIT

 +24       IF '$GET(BIFDT)

               DO ERROR(616)

               QUIT

 +25       IF '$DATA(BICC)

               DO ERROR(614)

               QUIT

 +26       IF '$DATA(BICM)

               DO ERROR(615)

               QUIT

 +27       IF '$DATA(BIDPRV)

               DO ERROR(680)

               QUIT

 +28       IF '$DATA(BIMMR)

               DO ERROR(652)

               QUIT

 +29       IF '$DATA(BIMMD)

               DO ERROR(638)

               QUIT

 +30       IF '$DATA(BIHCF)

               DO ERROR(625)

               QUIT

 +31       IF '$DATA(BILOT)

               DO ERROR(630)

               QUIT

 +32       IF '$GET(BIORD)

               DO ERROR(618)

               QUIT

 +33      ;I '$D(BINFO) D ERROR(629) Q  ;Additional Info not required (may be null).

 +34      ;  ;BIMMRF not required (may be null).

 +35      ;

 +36       IF '$DATA(BIRDT)

               SET BIRDT=""

 +37       IF '$DATA(BIDED)

               SET BIDED=0

 +38       IF '$DATA(BIBEN)

               SET BIBEN(1)=""

 +39      ;

 +40       DO FULL^VALM1

           NEW BIERR

 +41       DO TITLE^BIUTL5("PRINT OR VIEW LIST")

           DO TEXT1

 +42       NEW DIR

 +43       SET DIR("A")="     Select Print or View: "

           SET DIR("B")="View"

 +44       SET DIR(0)="SAM^p:Print;v:View;q:Quit"

 +45       DO ^DIR

           KILL DIR

 +46       IF Y=-1!($DATA(DIRUT))

               DO RESET^BIDU

               QUIT

 +47      ;

 +48      ;---> User chose to Quit.

 +49       IF Y="q"

               DO RESET^BIDU

               QUIT

 +50      ;

VIEW      ;---> User chose to VIEW Due List.

 +1        IF Y="v"

               Begin DoDot:1

 +2                WRITE !!?10,"This may take some time.  Please hold on...",!

 +3       ;

 +4       ;---> Retrieve patients for this listing.

 +5       ;---> (Patient's forecast gets updated at CHKSET+60^BIDUR.)

 +6       ;---> Since this is List (not Letter), send 0 days since last letter

 +7       ;---> as 10th parameter.  BIT=Total Patients retrieved.

 +8       ;

 +9       ;D NOW1^BIUTL3

 +10               DO RETRIEVE(.BIT,.BIERR)

 +11               IF $GET(BIERR)

                       DO ERROR(BIERR)

                       DO EXIT

                       DO RESET^BIDU

                       QUIT

 +12      ;D NOW2^BIUTL3

 +13      ;

 +14      ;---> Display list of patients retrieved.

 +15               KILL ^TMP("BIDULV",$JOB)

 +16               DO START^BIDUVLS1(BIFDT,.BINFO,BIPG,BIAG,BIT,,,,,.BIBEN)

 +17               DO EXIT

                   DO RESET^BIDU

               End DoDot:1

               QUIT

 +18      ;

 +19      ;

PRINT     ;EP

 +1       ;---> User chose to PRINT Due List.

 +2        NEW BIPOP

 +3        DO DEVICE(.BIPOP)

 +4        IF $GET(BIPOP)

               DO RESET^BIDU

               QUIT

 +5       ;

 +6        IF $GET(IO)'=$GET(IO(0))

               Begin DoDot:1

 +7                WRITE !!?10,"This may take some time.  Please hold on...",!

               End DoDot:1

 +8       ;

 +9       ;---> Retrieve patients for this listing.

 +10       DO RETRIEVE(.BIT,.BIERR)

 +11       IF $GET(BIERR)

               DO ERROR(BIERR)

               DO EXIT

               DO RESET^BIDU

               QUIT

 +12      ;

 +13      ;---> Print list of patients retrieved.

 +14      ;---> Cannot pass params to INIT, but should have BIFDTDT,

 +15      ;---> BINFO, and BIT defined.

 +16       KILL ^TMP("BIDULV",$JOB)

 +17       NEW VALM,VALMHDR

 +18       DO HDR^BIDUVLS1

           DO INIT^BIDUVLS1

 +19       DO PRTLST^BIUTL8("BIDULV")

 +20       DO EXIT

           DO RESET^BIDU

 +21       QUIT

 +22      ;

 +23      ;

 +24      ;----------

RETRIEVE(BIT,BIERR) ;EP

 +1       ;---> Retrieve patients according to parameters set.

 +2       ;---> Parameters:

 +3       ;     1 - BIT   (ret) Total Patients retrieved.

 +4       ;     2 - BIERR (ret) Error Code.

 +5       ;

 +6        DO R^BIDUR(BIAG,BIPG,BIFDT,.BICC,.BICM,.BIMMR,.BIMMD,.BILOT,0,BIORD,BIRDT,BIDED,.BIT,.BIHCF,.BIDPRV,.BIERR,.BIBEN)

 +7        QUIT

 +8       ;

 +9       ;

 +10      ;----------

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^BIDUVLS"

 +7        DO ZSAVES^BIUTL3

 +8        DO ZIS^BIUTL2(.BIPOP,1)

 +9        QUIT

 +10      ;

 +11      ;

 +12      ;----------

DEQUEUE   ;EP

 +1       ;---> Print list of patients retrieved.

 +2       ;

 +3        DO RETRIEVE(.BIT,.BIERR)

 +4        IF $GET(BIERR)

               DO EXIT

               QUIT

 +5        KILL VALMHDR,^TMP("BIDULV",$JOB)

 +6        DO HDR^BIDUVLS1

           DO INIT^BIDUVLS1

 +7        DO PRTLST^BIUTL8("BIDULV")

 +8        DO EXIT

 +9        QUIT

 +10      ;

 +11      ;

 +12      ;----------

ERROR(BIERR) ;EP

 +1       ;---> Report error, reset Listman screen and quit.

 +2       ;---> Parameters:

 +3       ;     1 - BIERR  (ret) Text of Error Code if any, otherwise null.

 +4       ;

 +5        IF '$GET(BIERR)

               SET BIERR=999

 +6        DO ERRCD^BIUTL2(BIERR,,1)

           DO RESET^BIDU

           QUIT

 +7        QUIT

 +8       ;

 +9       ;

TEXT1     ;

 +1       ;;You may either PRINT the List or VIEW it on this screen.

 +2       ;;

 +3       ;;PRINT: If it customarily takes a long time for your computer

 +4       ;;to produce a List of Patients, it may be more efficient for you

 +5       ;;to QUEUE it to a printer.  That way you can be free to do other

 +6       ;;things until the printout is finished.

 +7       ;;

 +8       ;;VIEW:  You will have to wait while the computer retrieves the

 +9       ;;information.  However, once the List of Patients comes up on

 +10      ;;the screen, you will be able to browse the list on screen by

 +11      ;;scrolling up and down using the arrow keys.

 +12      ;;

 +13       DO PRINTX("TEXT1",5)

 +14       QUIT

 +15      ;

 +16      ;

 +17      ;----------

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       ;---> Cleanup and Quit.

 +2        KILL ^TMP("BIDULV",$JOB)

 +3        QUIT

 +4       ;

 +5       ;

 +6       ;----------

EDITPAT   ;EP

 +1       ;---> Edit Patient from List.

 +2        IF '$GET(BIORD)

               SET BIORD=1

 +3        DO FULL^VALM1

 +4        Begin DoDot:1

 +5            NEW BIAG,BIBEN,BICC,BICM,BICPT,BIDPRV,BIFDT,BIHCF,BILOT,BIMD

 +6            NEW BIMMD,BIMMR,BINFO,BIORD,BIPG,BIQDT,BIRPDT,BIT

 +7            DO ONEPAT^BIPATVW

           End DoDot:1

 +8       ;

 +9        SET VALMBCK="R"

 +10       QUIT

BIDUVLS.m