- 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
