- BIDUPLT1 ;IHS/CMI/MWR - BI PRINT LETTERS.; MAY 10, 2010
- ;;8.5;IMMUNIZATION;;SEP 01,2011
- ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
- ;; PRINT LETTERS FROM ^TMP LIST OF PATIENTS.
- ;
- ;
- ;----------
- PRINT(BILET,BIDLOC,BIIOP,BIFDT) ;EP
- ;---> Print Due Letters for patients stored in ^TMP("BIDUL".
- ;---> Called by PRINTALL above; error checking done above.
- ;---> Parameters:
- ; 1 - BILET (req) Due Letter IEN.
- ; 2 - BIDLOC (req) Date-Location Line of letter.
- ; 3 - BIIOP (req) Output Device Name (Should be equal to ION.)
- ; 4 - BIFDT (req) Forecast date.
- ;
- D FULL^VALM1
- I '$G(BILET) D ERROR(609) Q
- I '$D(^BILET(BILET,0)) D ERROR(610) Q
- S:'$D(BIIOP) BIIOP="HOME"
- I '$G(BIFDT) D ERROR(616) Q
- S BICRT=$S(($E(IOST)="C")!(IOST["BROWSER"):1,1:0)
- ;
- ;---> Quit if no patients retrieved. (Next line was v8.0 patch 1.)
- I $O(^TMP("BIDUL",$J,0))="" D Q
- .U IO
- .W !!?3,"NOTE: Based on the criteria you selected, no Immunization Due"
- .W !?9,"letters were printed."
- .D:BICRT DIRZ^BIUTL3() W:'BICRT @IOF
- ;
- ;---> Loop through ^TMP("BIDUL",$J,...,BIDFN) printing Due Letters.
- N BIDFN,BILCNT,BIPOP,N,M,P
- S BILCNT=0,BIPOP=0
- ;
- S N=0
- F S N=$O(^TMP("BIDUL",$J,N)) Q:N="" D Q:BIPOP
- .S M=0
- .F S M=$O(^TMP("BIDUL",$J,N,M)) Q:M="" D Q:BIPOP
- ..S P=0
- ..F S P=$O(^TMP("BIDUL",$J,N,M,P)) Q:P="" D Q:BIPOP
- ...S BIDFN=0
- ...F S BIDFN=$O(^TMP("BIDUL",$J,N,M,P,BIDFN)) Q:'BIDFN D Q:BIPOP
- ....N N,M,P
- ....S IOP=BIIOP D ^%ZIS
- ....D PRINT^BILETPR(BIDFN,BILET,BIDLOC,BIIOP,BIFDT,.BIPOP)
- ....S BILCNT=BILCNT+1
- ;
- S IOP=BIIOP D ^%ZIS
- U IO
- W !!?10,"Immunization Due Letters printed: ",BILCNT
- W !?10,$$NOW^BIUTL5()
- D:BICRT DIRZ^BIUTL3() W:'BICRT @IOF
- D ^%ZISC
- Q
- ;
- ;
- ;----------
- ERROR(BIERR) ;EP
- ;---> Report error, either to screen or print.
- ;---> Parameters:
- ; 1 - BIERR (ret) Text of Error Code if any, otherwise null.
- ;
- S:'$G(BIERR) BIERR=999
- D ERRCD^BIUTL2(BIERR,,1)
- S BIPOP=1
- Q
- BIDUPLT1 ;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 LETTERS FROM ^TMP LIST OF PATIENTS.
- +4 ;
- +5 ;
- +6 ;----------
- PRINT(BILET,BIDLOC,BIIOP,BIFDT) ;EP
- +1 ;---> Print Due Letters for patients stored in ^TMP("BIDUL".
- +2 ;---> Called by PRINTALL above; error checking done above.
- +3 ;---> Parameters:
- +4 ; 1 - BILET (req) Due Letter IEN.
- +5 ; 2 - BIDLOC (req) Date-Location Line of letter.
- +6 ; 3 - BIIOP (req) Output Device Name (Should be equal to ION.)
- +7 ; 4 - BIFDT (req) Forecast date.
- +8 ;
- +9 DO FULL^VALM1
- +10 IF '$GET(BILET)
- DO ERROR(609)
- QUIT
- +11 IF '$DATA(^BILET(BILET,0))
- DO ERROR(610)
- QUIT
- +12 IF '$DATA(BIIOP)
- SET BIIOP="HOME"
- +13 IF '$GET(BIFDT)
- DO ERROR(616)
- QUIT
- +14 SET BICRT=$SELECT(($EXTRACT(IOST)="C")!(IOST["BROWSER"):1,1:0)
- +15 ;
- +16 ;---> Quit if no patients retrieved. (Next line was v8.0 patch 1.)
- +17 IF $ORDER(^TMP("BIDUL",$JOB,0))=""
- Begin DoDot:1
- +18 USE IO
- +19 WRITE !!?3,"NOTE: Based on the criteria you selected, no Immunization Due"
- +20 WRITE !?9,"letters were printed."
- +21 IF BICRT
- DO DIRZ^BIUTL3()
- IF 'BICRT
- WRITE @IOF
- End DoDot:1
- QUIT
- +22 ;
- +23 ;---> Loop through ^TMP("BIDUL",$J,...,BIDFN) printing Due Letters.
- +24 NEW BIDFN,BILCNT,BIPOP,N,M,P
- +25 SET BILCNT=0
- SET BIPOP=0
- +26 ;
- +27 SET N=0
- +28 FOR
- SET N=$ORDER(^TMP("BIDUL",$JOB,N))
- IF N=""
- QUIT
- Begin DoDot:1
- +29 SET M=0
- +30 FOR
- SET M=$ORDER(^TMP("BIDUL",$JOB,N,M))
- IF M=""
- QUIT
- Begin DoDot:2
- +31 SET P=0
- +32 FOR
- SET P=$ORDER(^TMP("BIDUL",$JOB,N,M,P))
- IF P=""
- QUIT
- Begin DoDot:3
- +33 SET BIDFN=0
- +34 FOR
- SET BIDFN=$ORDER(^TMP("BIDUL",$JOB,N,M,P,BIDFN))
- IF 'BIDFN
- QUIT
- Begin DoDot:4
- +35 NEW N,M,P
- +36 SET IOP=BIIOP
- DO ^%ZIS
- +37 DO PRINT^BILETPR(BIDFN,BILET,BIDLOC,BIIOP,BIFDT,.BIPOP)
- +38 SET BILCNT=BILCNT+1
- End DoDot:4
- IF BIPOP
- QUIT
- End DoDot:3
- IF BIPOP
- QUIT
- End DoDot:2
- IF BIPOP
- QUIT
- End DoDot:1
- IF BIPOP
- QUIT
- +39 ;
- +40 SET IOP=BIIOP
- DO ^%ZIS
- +41 USE IO
- +42 WRITE !!?10,"Immunization Due Letters printed: ",BILCNT
- +43 WRITE !?10,$$NOW^BIUTL5()
- +44 IF BICRT
- DO DIRZ^BIUTL3()
- IF 'BICRT
- WRITE @IOF
- +45 DO ^%ZISC
- +46 QUIT
- +47 ;
- +48 ;
- +49 ;----------
- ERROR(BIERR) ;EP
- +1 ;---> Report error, either to screen or print.
- +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)
- +7 SET BIPOP=1
- +8 QUIT
