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
Q
;
;
;----------
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)
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^BIDUVLS"
D ZSAVES^BIUTL3
D ZIS^BIUTL2(.BIPOP,1)
Q
;
;
;----------
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
Q
;
;
;----------
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
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)
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
;---> Cleanup and Quit.
K ^TMP("BIDULV",$J)
Q
;
;
;----------
EDITPAT ;EP
;---> Edit Patient from List.
S:'$G(BIORD) BIORD=1
D FULL^VALM1
D
.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"
Q
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
