- 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