BILETPR2 ;IHS/CMI/MWR - PRINT PATIENT LETTERS; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; PRINT PATIENT LETTERS.
;
;
;----------
INDIVLET(BIDFN,BIRTN) ;EP
;---> Select and Print a letter for an individual patient.
;---> Steps:
; 1) This entry point is called by the Protocol:
; BI LETTER PRINT INDIVDUAL, an action on the
; Listmanager menu protocol: BI MENU PATIENT VIEW.
;
;---> Parameters:
; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
; 2 - BIRTN (opt) Calling routine for reset.
;
I '$G(BIDFN) D ERRCD^BIUTL2(201,,1) S VALMBCK="R" Q
S:'$G(BIFDT) BIFDT=DT
;
D
.D FULL^VALM1 S BIPOP=0
.D TITLE^BIUTL5("LETTER SELECTION")
.D ASKLET^BILETPR(.BILET,.BIDLOC,.BIPOP) Q:BIPOP
.D DEVICE^BILETPR Q:BIPOP
.D PRINT^BILETPR(BIDFN,BILET,$G(BIDLOC),ION,BIFDT)
.D ^%ZISC
;
Q:$G(BIRTN)=""
S VALMBCK="R"
D @("RESET^"_BIRTN)
Q
;
;
;----------
PATLETS ;EP
;---> Lookup patients, select and print letters.
;
D SETVARS^BIUTL5 N BIDFN,BIFDT
F D Q:$G(BIDFN)<1
.D TITLE^BIUTL5("PRINT INDIVIDUAL PATIENT LETTERS")
.D PATLKUP^BIUTL8(.BIDFN)
.Q:$G(BIDFN)<1
.D INDIVLET(BIDFN)
.D UNLOCK^BIPATVW($G(BIDFN))
Q
;
;
;----------
OFFICIAL(BIDFN,BIRTN) ;EP
;---> Print Official Immunization Record for a patient.
;---> Steps:
; 1) This entry point is called by the Protocol:
; BI LETTER PRINT INDIVDUAL, an action on the
; Listmanager menu protocol: BI MENU PATIENT VIEW.
;
;---> Parameters:
; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
; 2 - BIRTN (opt) Calling routine for reset.
;
;---> Required Variable:
; 1 - DUZ(2) (req) User's Site IEN.
;
D
.D FULL^VALM1 S BIPOP=0
.I '$G(BIDFN) D ERRCD^BIUTL2(201,,1) Q
.N BILET S BILET=$$DEFLET^BIUTL2(DUZ(2),,1)
.I 'BILET D ERRCD^BIUTL2(113,,1) Q
.I '$D(^BILET(BILET,0)) D Q
..N DA,DIE S DIE="^BISITE(",DA=DUZ(2),DR=".13////@" D ^DIE
..D ERRCD^BIUTL2(114,,1)
.;
.D DEVICE^BILETPR Q:BIPOP
.D PRINT^BILETPR(BIDFN,BILET,,ION,$G(DT))
.D ^%ZISC
;
I $G(BIRTN)]"" S VALMBCK="R" D @("RESET^"_BIRTN)
Q
;
;
;----------
DATELOC(BILET,BILINE,BIDLOC) ;EP
;---> Store Date/Location line in WP ^TMP global.
;---> Parameters:
; 1 - BILET (req) IEN of Letter in BI LETTER File.
; 2 - BILINE (ret) Last line written into ^TMP array.
; 3 - BIDLOC (req) Text of Date/Location line.
;
;---> Quit if this Form Letter does not included a Date/Loc line.
Q:'$P(^BILET(BILET,0),U,4)
S:$G(BIDLOC)="" BIDLOC=" Date/Location line not provided."
D WRITE^BILETPR1(.BILINE),WRITE^BILETPR1(.BILINE," "_BIDLOC),WRITE^BILETPR1(.BILINE)
Q
BILETPR2 ;IHS/CMI/MWR - PRINT PATIENT 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 ;----------
INDIVLET(BIDFN,BIRTN) ;EP
+1 ;---> Select and Print a letter for an individual patient.
+2 ;---> Steps:
+3 ; 1) This entry point is called by the Protocol:
+4 ; BI LETTER PRINT INDIVDUAL, an action on the
+5 ; Listmanager menu protocol: BI MENU PATIENT VIEW.
+6 ;
+7 ;---> Parameters:
+8 ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
+9 ; 2 - BIRTN (opt) Calling routine for reset.
+10 ;
+11 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(201,,1)
SET VALMBCK="R"
QUIT
+12 IF '$GET(BIFDT)
SET BIFDT=DT
+13 ;
+14 Begin DoDot:1
+15 DO FULL^VALM1
SET BIPOP=0
+16 DO TITLE^BIUTL5("LETTER SELECTION")
+17 DO ASKLET^BILETPR(.BILET,.BIDLOC,.BIPOP)
IF BIPOP
QUIT
+18 DO DEVICE^BILETPR
IF BIPOP
QUIT
+19 DO PRINT^BILETPR(BIDFN,BILET,$GET(BIDLOC),ION,BIFDT)
+20 DO ^%ZISC
End DoDot:1
+21 ;
+22 IF $GET(BIRTN)=""
QUIT
+23 SET VALMBCK="R"
+24 DO @("RESET^"_BIRTN)
+25 QUIT
+26 ;
+27 ;
+28 ;----------
PATLETS ;EP
+1 ;---> Lookup patients, select and print letters.
+2 ;
+3 DO SETVARS^BIUTL5
NEW BIDFN,BIFDT
+4 FOR
Begin DoDot:1
+5 DO TITLE^BIUTL5("PRINT INDIVIDUAL PATIENT LETTERS")
+6 DO PATLKUP^BIUTL8(.BIDFN)
+7 IF $GET(BIDFN)<1
QUIT
+8 DO INDIVLET(BIDFN)
+9 DO UNLOCK^BIPATVW($GET(BIDFN))
End DoDot:1
IF $GET(BIDFN)<1
QUIT
+10 QUIT
+11 ;
+12 ;
+13 ;----------
OFFICIAL(BIDFN,BIRTN) ;EP
+1 ;---> Print Official Immunization Record for a patient.
+2 ;---> Steps:
+3 ; 1) This entry point is called by the Protocol:
+4 ; BI LETTER PRINT INDIVDUAL, an action on the
+5 ; Listmanager menu protocol: BI MENU PATIENT VIEW.
+6 ;
+7 ;---> Parameters:
+8 ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
+9 ; 2 - BIRTN (opt) Calling routine for reset.
+10 ;
+11 ;---> Required Variable:
+12 ; 1 - DUZ(2) (req) User's Site IEN.
+13 ;
+14 Begin DoDot:1
+15 DO FULL^VALM1
SET BIPOP=0
+16 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(201,,1)
QUIT
+17 NEW BILET
SET BILET=$$DEFLET^BIUTL2(DUZ(2),,1)
+18 IF 'BILET
DO ERRCD^BIUTL2(113,,1)
QUIT
+19 IF '$DATA(^BILET(BILET,0))
Begin DoDot:2
+20 NEW DA,DIE
SET DIE="^BISITE("
SET DA=DUZ(2)
SET DR=".13////@"
DO ^DIE
+21 DO ERRCD^BIUTL2(114,,1)
End DoDot:2
QUIT
+22 ;
+23 DO DEVICE^BILETPR
IF BIPOP
QUIT
+24 DO PRINT^BILETPR(BIDFN,BILET,,ION,$GET(DT))
+25 DO ^%ZISC
End DoDot:1
+26 ;
+27 IF $GET(BIRTN)]""
SET VALMBCK="R"
DO @("RESET^"_BIRTN)
+28 QUIT
+29 ;
+30 ;
+31 ;----------
DATELOC(BILET,BILINE,BIDLOC) ;EP
+1 ;---> Store Date/Location line in WP ^TMP global.
+2 ;---> Parameters:
+3 ; 1 - BILET (req) IEN of Letter in BI LETTER File.
+4 ; 2 - BILINE (ret) Last line written into ^TMP array.
+5 ; 3 - BIDLOC (req) Text of Date/Location line.
+6 ;
+7 ;---> Quit if this Form Letter does not included a Date/Loc line.
+8 IF '$PIECE(^BILET(BILET,0),U,4)
QUIT
+9 IF $GET(BIDLOC)=""
SET BIDLOC=" Date/Location line not provided."
+10 DO WRITE^BILETPR1(.BILINE)
DO WRITE^BILETPR1(.BILINE," "_BIDLOC)
DO WRITE^BILETPR1(.BILINE)
+11 QUIT
