BIDUPLT ;IHS/CMI/MWR - BI PRINT LETTERS.; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; PRINT PATIENT LETTERS.
;
;
;----------
PRINTDUE ;EP
;---> Print Immunization Due letters.
;---> Called by Protocol BI DUE LETTERS PRINT.
;---> Variables:
; 1 - BIAG (req) Age Range in months.
; 2 - BIPG (req) 0=Due, >0=Number of months Past Due.
; 3 - BICC (req) Current Community array.
; 4 - BICM (req) Case Manager array.
; 5 - BIDPRV (req) Designated Provider array.
; 6 - BIFDT (req) Forecast date.
; 7 - BIMMD (req) Immunization Due array.
; 8 - BIHCF (req) Health Care Facility array.
; 9 - BILOT (req) Lot Number array.
; 10 - BIORD (req) Order of listing.
; 11 - BIRDT (opt) Date Range for Received Imms (form BEGDATE:ENDDATE).
; 12 - 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 '$D(BICC) D ERROR(614) Q
I '$D(BICM) D ERROR(615) Q
I '$D(BIDPRV) D ERROR(680) Q
I '$G(BIFDT) D ERROR(616) 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(BIBEN) S BIBEN(1)=""
;
S BIPOP=0
;
;---> Select Form Letter.
D FULL^VALM1,TITLE^BIUTL5("SELECT FORM LETTER")
D DEFLET(.BIDFLT,DUZ(2))
D ASKLET^BILETPR(.BILET,.BIDLOC,.BIPOP,BIDFLT)
I BIPOP D RESET^BIDU Q
;
;---> Specify Minimum Interval days since last letter.
D MINDAYS^BIOUTPT3(.BIMD,.BIPOP)
I BIPOP D RESET^BIDU Q
;
D DEVICE
I BIPOP D RESET^BIDU Q
;
;
;---> Retrieve patients for this batch of letters.
D RETRIEVE(.BIT,.BIERR)
I $G(BIERR) D ERROR(BIERR),EXIT,RESET^BIDU Q
;
;---> Print letters for patients retrieved.
D PRINT^BIDUPLT1(BILET,$G(BIDLOC),ION,BIFDT)
D ^%ZISC
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) If error, return Error#.
;
; vvv83
D R^BIDUR(BIAG,BIPG,BIFDT,.BICC,.BICM,.BIMMR,.BIMMD,.BILOT,BIMD,BIORD,$G(BIRDT),,.BIT,.BIHCF,.BIDPRV,.BIERR,.BIBEN)
Q
;
;
;----------
DEVICE ;EP
;---> Get Device and possibly queue to Taskman.
D FULL^VALM1
K %ZIS,IOP
S ZTRTN="DEQUEUE^BIDUPLT"
D ZSAVES^BIUTL3
D ZIS^BIUTL2(.BIPOP,1)
Q
;
;
;----------
DEQUEUE ;EP
;---> Retrieve patients for this batch of letters.
D RETRIEVE(.BIT,.BIPOP)
I BIPOP D EXIT Q
;
;---> Print letters for patients retrieved.
D PRINT^BIDUPLT1(BILET,$G(BIDLOC),ION,BIFDT)
D ^%ZISC
D EXIT,KILLALL^BIUTL8(1)
Q
;
;
;----------
DEFLET(BILET,BISITE) ;EP
;---> Retrieve Immunizations Due Letter from Site Parameter file
;---> as the default letter for Immunizations Due.
;---> Parameters:
; 1 - BILET (ret) IEN of Imms Due Letter in BI LETTER File.
; 2 - BISITE (req) Site under which user is logged in.
;
S BILET=""
I '$D(^BISITE(BISITE,0)) D ERRCD^BIUTL2(103,,1) Q
S BILET=$$DEFLET^BIUTL2(BISITE)
I 'BILET D Q
.D TEXT1 W !?22,$$INSTTX^BIUTL6(BISITE)
.D DIRZ^BIUTL3(""," Press ENTER/RETURN to continue")
.W !?5,"Returning to Print Due Letters...",!
I '$D(^BILET(BILET,0)) D ERRCD^BIUTL2(108,,1) S BILET="" Q
Q
;
;
;----------
TEXT1 ;EP
;;An Immunizations Due default letter has not been chosen for this
;;site. If you wish to have a default letter appear at this prompt,
;;you must use the "Edit Site Parameters" option under the "Manager
;;Menu" and select an "IMMUNIZATION DUE LETTER" in the Site Parameters
;;for this site:
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
;
;
;----------
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
;
;
;----------
EXIT ;EP
;---> Cleanup and Quit.
K ^TMP("BIDUL",$J)
Q
BIDUPLT ;IHS/CMI/MWR - BI PRINT LETTERS.; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; PRINT PATIENT LETTERS.
+4 ;
+5 ;
+6 ;----------
PRINTDUE ;EP
+1 ;---> Print Immunization Due letters.
+2 ;---> Called by Protocol BI DUE LETTERS PRINT.
+3 ;---> Variables:
+4 ; 1 - BIAG (req) Age Range in months.
+5 ; 2 - BIPG (req) 0=Due, >0=Number of months Past Due.
+6 ; 3 - BICC (req) Current Community array.
+7 ; 4 - BICM (req) Case Manager array.
+8 ; 5 - BIDPRV (req) Designated Provider array.
+9 ; 6 - BIFDT (req) Forecast date.
+10 ; 7 - BIMMD (req) Immunization Due array.
+11 ; 8 - BIHCF (req) Health Care Facility array.
+12 ; 9 - BILOT (req) Lot Number array.
+13 ; 10 - BIORD (req) Order of listing.
+14 ; 11 - BIRDT (opt) Date Range for Received Imms (form BEGDATE:ENDDATE).
+15 ; 12 - BIBEN (req) Beneficiary Type array: either BIBEN(1) or BIBEN("ALL").
+16 ;
+17 ;---> Check for required Variables.
+18 IF '$DATA(BIAG)
DO ERROR(613)
QUIT
+19 IF '$DATA(BIPG)
DO ERROR(620)
QUIT
+20 IF '$DATA(BICC)
DO ERROR(614)
QUIT
+21 IF '$DATA(BICM)
DO ERROR(615)
QUIT
+22 IF '$DATA(BIDPRV)
DO ERROR(680)
QUIT
+23 IF '$GET(BIFDT)
DO ERROR(616)
QUIT
+24 IF '$DATA(BIMMD)
DO ERROR(638)
QUIT
+25 IF '$DATA(BIHCF)
DO ERROR(625)
QUIT
+26 IF '$DATA(BILOT)
DO ERROR(630)
QUIT
+27 IF '$GET(BIORD)
DO ERROR(618)
QUIT
+28 IF '$DATA(BIBEN)
SET BIBEN(1)=""
+29 ;
+30 SET BIPOP=0
+31 ;
+32 ;---> Select Form Letter.
+33 DO FULL^VALM1
DO TITLE^BIUTL5("SELECT FORM LETTER")
+34 DO DEFLET(.BIDFLT,DUZ(2))
+35 DO ASKLET^BILETPR(.BILET,.BIDLOC,.BIPOP,BIDFLT)
+36 IF BIPOP
DO RESET^BIDU
QUIT
+37 ;
+38 ;---> Specify Minimum Interval days since last letter.
+39 DO MINDAYS^BIOUTPT3(.BIMD,.BIPOP)
+40 IF BIPOP
DO RESET^BIDU
QUIT
+41 ;
+42 DO DEVICE
+43 IF BIPOP
DO RESET^BIDU
QUIT
+44 ;
+45 ;
+46 ;---> Retrieve patients for this batch of letters.
+47 DO RETRIEVE(.BIT,.BIERR)
+48 IF $GET(BIERR)
DO ERROR(BIERR)
DO EXIT
DO RESET^BIDU
QUIT
+49 ;
+50 ;---> Print letters for patients retrieved.
+51 DO PRINT^BIDUPLT1(BILET,$GET(BIDLOC),ION,BIFDT)
+52 DO ^%ZISC
+53 DO EXIT
DO RESET^BIDU
+54 QUIT
+55 ;
+56 ;
+57 ;----------
RETRIEVE(BIT,BIERR) ;EP
+1 ;---> Retrieve patients according to parameters set.
+2 ;---> Parameters:
+3 ; 1 - BIT (ret) Total Patients retrieved.
+4 ; 2 - BIERR (ret) If error, return Error#.
+5 ;
+6 ; vvv83
+7 DO R^BIDUR(BIAG,BIPG,BIFDT,.BICC,.BICM,.BIMMR,.BIMMD,.BILOT,BIMD,BIORD,$GET(BIRDT),,.BIT,.BIHCF,.BIDPRV,.BIERR,.BIBEN)
+8 QUIT
+9 ;
+10 ;
+11 ;----------
DEVICE ;EP
+1 ;---> Get Device and possibly queue to Taskman.
+2 DO FULL^VALM1
+3 KILL %ZIS,IOP
+4 SET ZTRTN="DEQUEUE^BIDUPLT"
+5 DO ZSAVES^BIUTL3
+6 DO ZIS^BIUTL2(.BIPOP,1)
+7 QUIT
+8 ;
+9 ;
+10 ;----------
DEQUEUE ;EP
+1 ;---> Retrieve patients for this batch of letters.
+2 DO RETRIEVE(.BIT,.BIPOP)
+3 IF BIPOP
DO EXIT
QUIT
+4 ;
+5 ;---> Print letters for patients retrieved.
+6 DO PRINT^BIDUPLT1(BILET,$GET(BIDLOC),ION,BIFDT)
+7 DO ^%ZISC
+8 DO EXIT
DO KILLALL^BIUTL8(1)
+9 QUIT
+10 ;
+11 ;
+12 ;----------
DEFLET(BILET,BISITE) ;EP
+1 ;---> Retrieve Immunizations Due Letter from Site Parameter file
+2 ;---> as the default letter for Immunizations Due.
+3 ;---> Parameters:
+4 ; 1 - BILET (ret) IEN of Imms Due Letter in BI LETTER File.
+5 ; 2 - BISITE (req) Site under which user is logged in.
+6 ;
+7 SET BILET=""
+8 IF '$DATA(^BISITE(BISITE,0))
DO ERRCD^BIUTL2(103,,1)
QUIT
+9 SET BILET=$$DEFLET^BIUTL2(BISITE)
+10 IF 'BILET
Begin DoDot:1
+11 DO TEXT1
WRITE !?22,$$INSTTX^BIUTL6(BISITE)
+12 DO DIRZ^BIUTL3(""," Press ENTER/RETURN to continue")
+13 WRITE !?5,"Returning to Print Due Letters...",!
End DoDot:1
QUIT
+14 IF '$DATA(^BILET(BILET,0))
DO ERRCD^BIUTL2(108,,1)
SET BILET=""
QUIT
+15 QUIT
+16 ;
+17 ;
+18 ;----------
TEXT1 ;EP
+1 ;;An Immunizations Due default letter has not been chosen for this
+2 ;;site. If you wish to have a default letter appear at this prompt,
+3 ;;you must use the "Edit Site Parameters" option under the "Manager
+4 ;;Menu" and select an "IMMUNIZATION DUE LETTER" in the Site Parameters
+5 ;;for this site:
+6 DO PRINTX("TEXT1",5)
+7 QUIT
+8 ;
+9 ;
+10 ;----------
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 ;----------
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 ;
+10 ;----------
EXIT ;EP
+1 ;---> Cleanup and Quit.
+2 KILL ^TMP("BIDUL",$JOB)
+3 QUIT
