BILETVW2 ;IHS/CMI/MWR - VIEW/EDIT FORM LETTERS; MAY 10, 2010
;;8.5;IMMUNIZATION;**9**;OCT 01,2014
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; EDIT SECTIONS OF FORM LETTERS.
;; PATCH 9: New feature to allow copying of existing Form Letter. ADDNEW+11
;
;
;----------
EDITSEC(BINODE) ;EP
;---> Edit Section of Form Letter.
;---> Parameters:
; 1 - BINODE (req) WP Node in BI LETTER entry to edit.
;
;---> Variables:
; 1 - BIIEN (req) IEN of the BI LETTER entry being edited
; (selected in ^BILETVW).
;
;---> Steps:
; 1) This entry point is called by the Protocols:
; BI LETTER EDIT TOP/MIDDLE/BOTTOM, actions on the
; List Manager menu protocol: BI MENU LETTER FORM.
;
; 2) This code calls ^DIWE to allow the user to edit
; those sections of the Form Letter in WP mode.
;
Q:$$LETCHECK($G(BIIEN))
;
;---> If BINODE not supplied, set Error Code and quit.
I '$G(BINODE) D ERRCD^BIUTL2(611,,1) D RESET^BILETVW Q
D:'$D(^BILET(BIIEN,BINODE,0))
.S ^BILET(BIIEN,BINODE,0)="^^1^1^"_DT,^(1,0)=" Place text here."
;
N DIC S DIC="^BILET("_BIIEN_","_BINODE_","
D EN^DIWE
;
D RESET^BILETVW
Q
;
;
;----------
HISTORY ;EP
;---> Add/Remove Immunization History to/from a Form Letter.
;---> Variables:
; 1 - BIIEN (req) IEN of the BI LETTER entry being edited.
;
;---> Steps:
; 1) This entry point is called by the Protocol:
; BI LETTER HISTORY, an action on the Listmanager
; menu protocol: BI MENU LETTER FORM.
;
Q:$$LETCHECK($G(BIIEN))
;
D FULL^VALM1
D TITLE^BIUTL5("INCLUDE IMM HISTORY IN LETTER")
N DIR,DIRUT
W !!!," Include patient's Immunization History in this Form Letter?"
W ! D HELP1
S DIR(0)="YOA",DIR("A")=" Enter Yes or No: "
S DIR("B")=$S(+$P(^BILET(BIIEN,0),U,2):"Yes",1:"No")
D ^DIR
I $D(DIRUT) D RESET^BILETVW Q
;
I 'Y S $P(^BILET(BIIEN,0),U,2)=0 D RESET^BILETVW Q
;
K DIR,DIRUT
W !!!," List the Immunization History by Date or by Vaccine,"
W " with or without",!," Lot Numbers?"
D HELP2
S DIR(0)="SOM^1:Date;2:Date w/Lot#;3:Vaccine;4:Vaccine w/Lot#"
S DIR("A")=" Enter a number"
S DIR("B")=+$P(^BILET(BIIEN,0),U,2) S:DIR("B")=0 DIR("B")=1
D ^DIR
I $D(DIRUT) D RESET^BILETVW Q
S $P(^BILET(BIIEN,0),U,2)=+Y
K DIR,DIRUT
;
;---> Next section not used, but preserved in case they want to be
;---> able to exclude invalid doses from letter for particular letters.
;N DIR,DIRUT
;W !!!," Include Invalid Doses in this Form Letter?"
;W ! D HELP6
;S DIR(0)="YOA",DIR("A")=" Enter Yes or No: "
;S DIR("B")=$S(+$P(^BILET(BIIEN,0),U,5):"No",1:"Yes")
;D ^DIR
;I $D(DIRUT) D RESET^BILETVW Q
;S $P(^BILET(BIIEN,0),U,5)=+Y
;
D RESET^BILETVW
Q
;
;
;----------
HELP1 ;EP
;;Enter YES to have the patient's Immunization History appear between
;;the top and middle sections of the Form Letter. Enter NO to exclude
;;the Immunization History from this Form Letter.
D HELPTX("HELP1",5)
Q
;
;
;----------
HELP2 ;EP
;;Enter 1 to list the Immunization History in the letter by DATE,
;;enter 2 to list the History by DATE with LOT NUMBERS,
;;enter 3 to list the History by VACCINE, or
;;enter 4 to list the History by VACCINE with LOT NUMBERS.
D HELPTX("HELP2",5)
Q
;
;
;----------
HELP6 ;EP
;;Enter YES if you would like to have doses that are considered Invalid
;;(and their reasons) appear in the list of immunizations on this letter.
;;Enter NO to prevent any Invalid Doses from appearing in this letter.
D HELPTX("HELP6",5)
Q
;
;
;----------
FORECAST ;EP
;---> Add/Remove Immunization Forecast to/from a Form Letter.
;---> Variables:
; 1 - BIIEN (req) IEN of the BI LETTER entry being edited.
;
;---> Steps:
; 1) This entry point is called by the Protocol:
; BI LETTER FORECAST, an action on the Listmanager
; menu protocol: BI MENU LETTER FORM.
;
Q:$$LETCHECK($G(BIIEN))
;
N DIR,DIRUT
W !!!!," Include patient's Forecast in this Form Letter?"
S DIR(0)="YO",DIR("A")=" Enter Yes or No" D HELP3
D ^DIR
S:'$D(DIRUT) $P(^BILET(BIIEN,0),U,3)=+Y
D RESET^BILETVW
Q
;
;
;----------
HELP3 ;EP
;;Enter YES to have the patient's Immunization Forecast appear between
;;the middle and bottom sections of the Form Letter.
D HELPTX("HELP3",5)
Q
;
;
;----------
DATELOC ;EP
;---> Add/Remove Date/Location to/from a Form Letter.
;---> Variables:
; 1 - BIIEN (req) IEN of the BI LETTER entry being edited.
;
;---> Steps:
; 1) This entry point is called by the Protocol:
; BI LETTER DATE/LOCATION, an action on the Listmanager
; menu protocol: BI MENU LETTER FORM.
;
Q:$$LETCHECK($G(BIIEN))
;
N DIR,DIRUT
W !!!!," Include Date/Location for appointment in this Form Letter?"
S DIR(0)="YO",DIR("A")=" Enter Yes or No" D HELP4
D ^DIR
S:'$D(DIRUT) $P(^BILET(BIIEN,0),U,4)=+Y
D RESET^BILETVW
Q
;
;
;----------
HELP4 ;EP
;;Enter YES to have the Date and Location for an appointment appear
;;between the bottom and closing sections of the Form Letter.
D HELPTX("HELP4",5)
Q
;
;
;----------
PRINTSAM ;EP
;---> Print a sample of a Form Letter.
;---> Variables:
; 1 - BIIEN (req) IEN of the BI LETTER entry being edited.
;
;---> Steps:
; 1) This entry point is called by the Protocol:
; BI LETTER PRINT SAMPLE, an action on the Listmanager
; menu protocol: BI MENU LETTER FORM.
;
Q:$$LETCHECK($G(BIIEN))
;
;---> Print sample letters for individual patient.
D
.D FULL^VALM1 S BIPOP=0 N BIDFN
.D TITLE^BIUTL5("PRINT SAMPLE LETTER")
.D PATLKUP^BIUTL8(.BIDFN)
.Q:BIDFN<1
.D ASKDLOC^BILETPR(BIIEN,.BIDLOC,.BIPOP) Q:BIPOP
.D DEVICE^BILETPR Q:BIPOP
.D PRINT^BILETPR(BIDFN,BIIEN,$G(BIDLOC),ION)
.D ^%ZISC
;
D RESET^BILETVW
Q
;
;
;----------
LETCHECK(BIIEN) ;EP
;---> If BIIEN not supplied, set Error Code and quit.
I '$G(BIIEN) D ERRCD^BIUTL2(609,,1) Q 1
I '$D(^BILET(BIIEN,0)) D ERRCD^BIUTL2(610,,1) Q 1
Q 0
;
;
;----------
ADDNEW(BIIEN) ;EP
;---> Copy the Generic Sample Letter to this new Form Letter.
;---> Parameters:
; 1 - BIIEN (req) IEN of new Form Letter.
; (ret) BIIEN="" if Sample Form Letter not chosen.
;
I '$G(BIIEN) D ERRCD^BIUTL2(609,,1) Q
;
D TITLE^BIUTL5("ADD A NEW FORM LETTER"),TEXT1
N BIACT,BISIEN,DIR
;
;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
;---> New feature to allow copying of existing Form Letter.
;S DIR("A")=" Enter 1, 2, or 3: ",DIR("B")=1
S DIR("A")=" Enter 1, 2, 3, or C: "
S DIR(0)="SAM^1:Standard Due Letter;2:Official Immunization Record"
S DIR(0)=DIR(0)_";3:Standard Due Letter, Forecast First"
S DIR(0)=DIR(0)_";C:Copy Existing Form Letter"
D ^DIR K DIR
;---> If user backed out, delete new letter and quit.
I ($D(DIRUT)!(Y=-1)) D Q
.N DA,DIK S DA=BIIEN,DIK="^BILET(" D ^DIK S BIIEN=""
.W !!?5,"New Form Letter not added." D DIRZ^BIUTL3()
;
;---> If copy existing, do so and quit.
I Y="C" D COPYEX(.BIIEN,.Y) Q
;**********
;
S BISIEN=+Y
N I
F I=1:1:4 D
.Q:'$D(^BILETS(BISIEN,I,0))
.S ^BILET(BIIEN,I,0)=^BILETS(BISIEN,I,0)
.N N S N=0
.F S N=$O(^BILETS(BISIEN,I,N)) Q:'N D
..S ^BILET(BIIEN,I,N,0)=^BILETS(BISIEN,I,N,0)
;
F I=2,3,4,6 S $P(^BILET(BIIEN,0),U,I)=$P(^BILETS(BISIEN,0),U,I)
Q
;
;
;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
;---> New feature to allow copying of existing Form Letter.
;----------
COPYEX(BIIEN,Y) ;EP
;---> Copy existing Form Letter.
;---> Parameters:
; 1 - BIIEN (req) IEN of new Form Letter.
;
D TITLE^BIUTL5("ADD A NEW FORM LETTER")
W !!?5,"You have chosen to copy an existing Form Letter to your new Form Letter."
W !?5,"Please select the existing Form Letter you wish to copy.",!
D DIC^BIFMAN(9002084.4,"QEMA",.Y," Select Form Letter: ")
I ($D(DIRUT)!(Y=-1)) D Q
.N DA,DIK S DA=BIIEN,DIK="^BILET(" D ^DIK S BIIEN=""
.W !!?5,"New Form Letter not added." D DIRZ^BIUTL3()
S BISIEN=+Y
N I
F I=1:1:4 D
.Q:'$D(^BILET(BISIEN,I,0))
.S ^BILET(BIIEN,I,0)=^BILET(BISIEN,I,0)
.N N S N=0
.F S N=$O(^BILET(BISIEN,I,N)) Q:'N D
..S ^BILET(BIIEN,I,N,0)=^BILET(BISIEN,I,N,0)
;
F I=2,3,4,6 S $P(^BILET(BIIEN,0),U,I)=$P(^BILET(BISIEN,0),U,I)
Q
;**********
;
;
;----------
TEXT1 ;EP
;;You have chosen to add a new Form Letter.
;;In order to save you time, this program will load a Sample Form Letter,
;;which you may then edit to suit the purpose of your new Form Letter.
;;
;;There are three Sample Form Letters to choose from:
;;
;; 1) Standard Due Letter
;; 2) Official Immunization Record
;; 3) Standard Due Letter--Forecast First
;;
;;Or you may choose to copy an existing customized Form Letter and
;;then make changes to it under the new Form Letter you are creating.
;;
;;Please enter "1" to select the Standard Due Letter, "2" to select
;;the Official Immunization Record, "3" to select the Standard Due
;;Letter (with the Forecast listed first and the History following),
;;or enter "C" to copy an existing Form Letter.
;;
;
D PRINTX("TEXT1")
Q
;
;
;----------
DELETLET ;EP
;---> Delete a Form Letter.
;---> Variables:
; 1 - BIIEN (req) IEN of the BI LETTER entry being deleted.
;
;---> Steps:
; 1) This entry point is called by the Protocol:
; BI LETTER DELETE, an action on the Listmanager
; menu protocol: BI MENU LETTER FORM.
;
Q:$$LETCHECK($G(BIIEN))
;
N DIR,DIRUT
W !!!!," Are you sure you want to DELETE this entire Form Letter?"
S DIR(0)="YO",DIR("A")=" Enter Yes or No",DIR("B")="NO" D HELP5
D ^DIR
I $D(DIRUT)!('Y) D RESET^BILETVW Q
;
;---> Delete Form Letter.
N DA,DIK S DA=BIIEN,DIK="^BILET(" D ^DIK
;
;---> If a Site Parameter points to this entry, delete it.
N N S N=0
F S N=$O(^BISITE(N)) Q:'N D
.S:$P(^BISITE(N,0),U,4)=BIIEN $P(^BISITE(N,0),U,4)=""
.S:$P(^BISITE(N,0),U,13)=BIIEN $P(^BISITE(N,0),U,13)=""
;
S VALMQUIT="" Q
Q
;
;
;----------
HELP5 ;EP
;;If you enter YES, this Form Letter will be deleted and no longer
;;available for editing or sending to patients."
D HELPTX("HELP5",5)
Q
;
;
;----------
HELPTX(BILINL,BITAB) ;
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'[";;" S DIR("?",I)=T_$P(X,";;",2)
S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
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
BILETVW2 ;IHS/CMI/MWR - VIEW/EDIT FORM LETTERS; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**9**;OCT 01,2014
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; EDIT SECTIONS OF FORM LETTERS.
+4 ;; PATCH 9: New feature to allow copying of existing Form Letter. ADDNEW+11
+5 ;
+6 ;
+7 ;----------
EDITSEC(BINODE) ;EP
+1 ;---> Edit Section of Form Letter.
+2 ;---> Parameters:
+3 ; 1 - BINODE (req) WP Node in BI LETTER entry to edit.
+4 ;
+5 ;---> Variables:
+6 ; 1 - BIIEN (req) IEN of the BI LETTER entry being edited
+7 ; (selected in ^BILETVW).
+8 ;
+9 ;---> Steps:
+10 ; 1) This entry point is called by the Protocols:
+11 ; BI LETTER EDIT TOP/MIDDLE/BOTTOM, actions on the
+12 ; List Manager menu protocol: BI MENU LETTER FORM.
+13 ;
+14 ; 2) This code calls ^DIWE to allow the user to edit
+15 ; those sections of the Form Letter in WP mode.
+16 ;
+17 IF $$LETCHECK($GET(BIIEN))
QUIT
+18 ;
+19 ;---> If BINODE not supplied, set Error Code and quit.
+20 IF '$GET(BINODE)
DO ERRCD^BIUTL2(611,,1)
DO RESET^BILETVW
QUIT
+21 IF '$DATA(^BILET(BIIEN,BINODE,0))
Begin DoDot:1
+22 SET ^BILET(BIIEN,BINODE,0)="^^1^1^"_DT
SET ^(1,0)=" Place text here."
End DoDot:1
+23 ;
+24 NEW DIC
SET DIC="^BILET("_BIIEN_","_BINODE_","
+25 DO EN^DIWE
+26 ;
+27 DO RESET^BILETVW
+28 QUIT
+29 ;
+30 ;
+31 ;----------
HISTORY ;EP
+1 ;---> Add/Remove Immunization History to/from a Form Letter.
+2 ;---> Variables:
+3 ; 1 - BIIEN (req) IEN of the BI LETTER entry being edited.
+4 ;
+5 ;---> Steps:
+6 ; 1) This entry point is called by the Protocol:
+7 ; BI LETTER HISTORY, an action on the Listmanager
+8 ; menu protocol: BI MENU LETTER FORM.
+9 ;
+10 IF $$LETCHECK($GET(BIIEN))
QUIT
+11 ;
+12 DO FULL^VALM1
+13 DO TITLE^BIUTL5("INCLUDE IMM HISTORY IN LETTER")
+14 NEW DIR,DIRUT
+15 WRITE !!!," Include patient's Immunization History in this Form Letter?"
+16 WRITE !
DO HELP1
+17 SET DIR(0)="YOA"
SET DIR("A")=" Enter Yes or No: "
+18 SET DIR("B")=$SELECT(+$PIECE(^BILET(BIIEN,0),U,2):"Yes",1:"No")
+19 DO ^DIR
+20 IF $DATA(DIRUT)
DO RESET^BILETVW
QUIT
+21 ;
+22 IF 'Y
SET $PIECE(^BILET(BIIEN,0),U,2)=0
DO RESET^BILETVW
QUIT
+23 ;
+24 KILL DIR,DIRUT
+25 WRITE !!!," List the Immunization History by Date or by Vaccine,"
+26 WRITE " with or without",!," Lot Numbers?"
+27 DO HELP2
+28 SET DIR(0)="SOM^1:Date;2:Date w/Lot#;3:Vaccine;4:Vaccine w/Lot#"
+29 SET DIR("A")=" Enter a number"
+30 SET DIR("B")=+$PIECE(^BILET(BIIEN,0),U,2)
IF DIR("B")=0
SET DIR("B")=1
+31 DO ^DIR
+32 IF $DATA(DIRUT)
DO RESET^BILETVW
QUIT
+33 SET $PIECE(^BILET(BIIEN,0),U,2)=+Y
+34 KILL DIR,DIRUT
+35 ;
+36 ;---> Next section not used, but preserved in case they want to be
+37 ;---> able to exclude invalid doses from letter for particular letters.
+38 ;N DIR,DIRUT
+39 ;W !!!," Include Invalid Doses in this Form Letter?"
+40 ;W ! D HELP6
+41 ;S DIR(0)="YOA",DIR("A")=" Enter Yes or No: "
+42 ;S DIR("B")=$S(+$P(^BILET(BIIEN,0),U,5):"No",1:"Yes")
+43 ;D ^DIR
+44 ;I $D(DIRUT) D RESET^BILETVW Q
+45 ;S $P(^BILET(BIIEN,0),U,5)=+Y
+46 ;
+47 DO RESET^BILETVW
+48 QUIT
+49 ;
+50 ;
+51 ;----------
HELP1 ;EP
+1 ;;Enter YES to have the patient's Immunization History appear between
+2 ;;the top and middle sections of the Form Letter. Enter NO to exclude
+3 ;;the Immunization History from this Form Letter.
+4 DO HELPTX("HELP1",5)
+5 QUIT
+6 ;
+7 ;
+8 ;----------
HELP2 ;EP
+1 ;;Enter 1 to list the Immunization History in the letter by DATE,
+2 ;;enter 2 to list the History by DATE with LOT NUMBERS,
+3 ;;enter 3 to list the History by VACCINE, or
+4 ;;enter 4 to list the History by VACCINE with LOT NUMBERS.
+5 DO HELPTX("HELP2",5)
+6 QUIT
+7 ;
+8 ;
+9 ;----------
HELP6 ;EP
+1 ;;Enter YES if you would like to have doses that are considered Invalid
+2 ;;(and their reasons) appear in the list of immunizations on this letter.
+3 ;;Enter NO to prevent any Invalid Doses from appearing in this letter.
+4 DO HELPTX("HELP6",5)
+5 QUIT
+6 ;
+7 ;
+8 ;----------
FORECAST ;EP
+1 ;---> Add/Remove Immunization Forecast to/from a Form Letter.
+2 ;---> Variables:
+3 ; 1 - BIIEN (req) IEN of the BI LETTER entry being edited.
+4 ;
+5 ;---> Steps:
+6 ; 1) This entry point is called by the Protocol:
+7 ; BI LETTER FORECAST, an action on the Listmanager
+8 ; menu protocol: BI MENU LETTER FORM.
+9 ;
+10 IF $$LETCHECK($GET(BIIEN))
QUIT
+11 ;
+12 NEW DIR,DIRUT
+13 WRITE !!!!," Include patient's Forecast in this Form Letter?"
+14 SET DIR(0)="YO"
SET DIR("A")=" Enter Yes or No"
DO HELP3
+15 DO ^DIR
+16 IF '$DATA(DIRUT)
SET $PIECE(^BILET(BIIEN,0),U,3)=+Y
+17 DO RESET^BILETVW
+18 QUIT
+19 ;
+20 ;
+21 ;----------
HELP3 ;EP
+1 ;;Enter YES to have the patient's Immunization Forecast appear between
+2 ;;the middle and bottom sections of the Form Letter.
+3 DO HELPTX("HELP3",5)
+4 QUIT
+5 ;
+6 ;
+7 ;----------
DATELOC ;EP
+1 ;---> Add/Remove Date/Location to/from a Form Letter.
+2 ;---> Variables:
+3 ; 1 - BIIEN (req) IEN of the BI LETTER entry being edited.
+4 ;
+5 ;---> Steps:
+6 ; 1) This entry point is called by the Protocol:
+7 ; BI LETTER DATE/LOCATION, an action on the Listmanager
+8 ; menu protocol: BI MENU LETTER FORM.
+9 ;
+10 IF $$LETCHECK($GET(BIIEN))
QUIT
+11 ;
+12 NEW DIR,DIRUT
+13 WRITE !!!!," Include Date/Location for appointment in this Form Letter?"
+14 SET DIR(0)="YO"
SET DIR("A")=" Enter Yes or No"
DO HELP4
+15 DO ^DIR
+16 IF '$DATA(DIRUT)
SET $PIECE(^BILET(BIIEN,0),U,4)=+Y
+17 DO RESET^BILETVW
+18 QUIT
+19 ;
+20 ;
+21 ;----------
HELP4 ;EP
+1 ;;Enter YES to have the Date and Location for an appointment appear
+2 ;;between the bottom and closing sections of the Form Letter.
+3 DO HELPTX("HELP4",5)
+4 QUIT
+5 ;
+6 ;
+7 ;----------
PRINTSAM ;EP
+1 ;---> Print a sample of a Form Letter.
+2 ;---> Variables:
+3 ; 1 - BIIEN (req) IEN of the BI LETTER entry being edited.
+4 ;
+5 ;---> Steps:
+6 ; 1) This entry point is called by the Protocol:
+7 ; BI LETTER PRINT SAMPLE, an action on the Listmanager
+8 ; menu protocol: BI MENU LETTER FORM.
+9 ;
+10 IF $$LETCHECK($GET(BIIEN))
QUIT
+11 ;
+12 ;---> Print sample letters for individual patient.
+13 Begin DoDot:1
+14 DO FULL^VALM1
SET BIPOP=0
NEW BIDFN
+15 DO TITLE^BIUTL5("PRINT SAMPLE LETTER")
+16 DO PATLKUP^BIUTL8(.BIDFN)
+17 IF BIDFN<1
QUIT
+18 DO ASKDLOC^BILETPR(BIIEN,.BIDLOC,.BIPOP)
IF BIPOP
QUIT
+19 DO DEVICE^BILETPR
IF BIPOP
QUIT
+20 DO PRINT^BILETPR(BIDFN,BIIEN,$GET(BIDLOC),ION)
+21 DO ^%ZISC
End DoDot:1
+22 ;
+23 DO RESET^BILETVW
+24 QUIT
+25 ;
+26 ;
+27 ;----------
LETCHECK(BIIEN) ;EP
+1 ;---> If BIIEN not supplied, set Error Code and quit.
+2 IF '$GET(BIIEN)
DO ERRCD^BIUTL2(609,,1)
QUIT 1
+3 IF '$DATA(^BILET(BIIEN,0))
DO ERRCD^BIUTL2(610,,1)
QUIT 1
+4 QUIT 0
+5 ;
+6 ;
+7 ;----------
ADDNEW(BIIEN) ;EP
+1 ;---> Copy the Generic Sample Letter to this new Form Letter.
+2 ;---> Parameters:
+3 ; 1 - BIIEN (req) IEN of new Form Letter.
+4 ; (ret) BIIEN="" if Sample Form Letter not chosen.
+5 ;
+6 IF '$GET(BIIEN)
DO ERRCD^BIUTL2(609,,1)
QUIT
+7 ;
+8 DO TITLE^BIUTL5("ADD A NEW FORM LETTER")
DO TEXT1
+9 NEW BIACT,BISIEN,DIR
+10 ;
+11 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+12 ;---> New feature to allow copying of existing Form Letter.
+13 ;S DIR("A")=" Enter 1, 2, or 3: ",DIR("B")=1
+14 SET DIR("A")=" Enter 1, 2, 3, or C: "
+15 SET DIR(0)="SAM^1:Standard Due Letter;2:Official Immunization Record"
+16 SET DIR(0)=DIR(0)_";3:Standard Due Letter, Forecast First"
+17 SET DIR(0)=DIR(0)_";C:Copy Existing Form Letter"
+18 DO ^DIR
KILL DIR
+19 ;---> If user backed out, delete new letter and quit.
+20 IF ($DATA(DIRUT)!(Y=-1))
Begin DoDot:1
+21 NEW DA,DIK
SET DA=BIIEN
SET DIK="^BILET("
DO ^DIK
SET BIIEN=""
+22 WRITE !!?5,"New Form Letter not added."
DO DIRZ^BIUTL3()
End DoDot:1
QUIT
+23 ;
+24 ;---> If copy existing, do so and quit.
+25 IF Y="C"
DO COPYEX(.BIIEN,.Y)
QUIT
+26 ;**********
+27 ;
+28 SET BISIEN=+Y
+29 NEW I
+30 FOR I=1:1:4
Begin DoDot:1
+31 IF '$DATA(^BILETS(BISIEN,I,0))
QUIT
+32 SET ^BILET(BIIEN,I,0)=^BILETS(BISIEN,I,0)
+33 NEW N
SET N=0
+34 FOR
SET N=$ORDER(^BILETS(BISIEN,I,N))
IF 'N
QUIT
Begin DoDot:2
+35 SET ^BILET(BIIEN,I,N,0)=^BILETS(BISIEN,I,N,0)
End DoDot:2
End DoDot:1
+36 ;
+37 FOR I=2,3,4,6
SET $PIECE(^BILET(BIIEN,0),U,I)=$PIECE(^BILETS(BISIEN,0),U,I)
+38 QUIT
+39 ;
+40 ;
+41 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+42 ;---> New feature to allow copying of existing Form Letter.
+43 ;----------
COPYEX(BIIEN,Y) ;EP
+1 ;---> Copy existing Form Letter.
+2 ;---> Parameters:
+3 ; 1 - BIIEN (req) IEN of new Form Letter.
+4 ;
+5 DO TITLE^BIUTL5("ADD A NEW FORM LETTER")
+6 WRITE !!?5,"You have chosen to copy an existing Form Letter to your new Form Letter."
+7 WRITE !?5,"Please select the existing Form Letter you wish to copy.",!
+8 DO DIC^BIFMAN(9002084.4,"QEMA",.Y," Select Form Letter: ")
+9 IF ($DATA(DIRUT)!(Y=-1))
Begin DoDot:1
+10 NEW DA,DIK
SET DA=BIIEN
SET DIK="^BILET("
DO ^DIK
SET BIIEN=""
+11 WRITE !!?5,"New Form Letter not added."
DO DIRZ^BIUTL3()
End DoDot:1
QUIT
+12 SET BISIEN=+Y
+13 NEW I
+14 FOR I=1:1:4
Begin DoDot:1
+15 IF '$DATA(^BILET(BISIEN,I,0))
QUIT
+16 SET ^BILET(BIIEN,I,0)=^BILET(BISIEN,I,0)
+17 NEW N
SET N=0
+18 FOR
SET N=$ORDER(^BILET(BISIEN,I,N))
IF 'N
QUIT
Begin DoDot:2
+19 SET ^BILET(BIIEN,I,N,0)=^BILET(BISIEN,I,N,0)
End DoDot:2
End DoDot:1
+20 ;
+21 FOR I=2,3,4,6
SET $PIECE(^BILET(BIIEN,0),U,I)=$PIECE(^BILET(BISIEN,0),U,I)
+22 QUIT
+23 ;**********
+24 ;
+25 ;
+26 ;----------
TEXT1 ;EP
+1 ;;You have chosen to add a new Form Letter.
+2 ;;In order to save you time, this program will load a Sample Form Letter,
+3 ;;which you may then edit to suit the purpose of your new Form Letter.
+4 ;;
+5 ;;There are three Sample Form Letters to choose from:
+6 ;;
+7 ;; 1) Standard Due Letter
+8 ;; 2) Official Immunization Record
+9 ;; 3) Standard Due Letter--Forecast First
+10 ;;
+11 ;;Or you may choose to copy an existing customized Form Letter and
+12 ;;then make changes to it under the new Form Letter you are creating.
+13 ;;
+14 ;;Please enter "1" to select the Standard Due Letter, "2" to select
+15 ;;the Official Immunization Record, "3" to select the Standard Due
+16 ;;Letter (with the Forecast listed first and the History following),
+17 ;;or enter "C" to copy an existing Form Letter.
+18 ;;
+19 ;
+20 DO PRINTX("TEXT1")
+21 QUIT
+22 ;
+23 ;
+24 ;----------
DELETLET ;EP
+1 ;---> Delete a Form Letter.
+2 ;---> Variables:
+3 ; 1 - BIIEN (req) IEN of the BI LETTER entry being deleted.
+4 ;
+5 ;---> Steps:
+6 ; 1) This entry point is called by the Protocol:
+7 ; BI LETTER DELETE, an action on the Listmanager
+8 ; menu protocol: BI MENU LETTER FORM.
+9 ;
+10 IF $$LETCHECK($GET(BIIEN))
QUIT
+11 ;
+12 NEW DIR,DIRUT
+13 WRITE !!!!," Are you sure you want to DELETE this entire Form Letter?"
+14 SET DIR(0)="YO"
SET DIR("A")=" Enter Yes or No"
SET DIR("B")="NO"
DO HELP5
+15 DO ^DIR
+16 IF $DATA(DIRUT)!('Y)
DO RESET^BILETVW
QUIT
+17 ;
+18 ;---> Delete Form Letter.
+19 NEW DA,DIK
SET DA=BIIEN
SET DIK="^BILET("
DO ^DIK
+20 ;
+21 ;---> If a Site Parameter points to this entry, delete it.
+22 NEW N
SET N=0
+23 FOR
SET N=$ORDER(^BISITE(N))
IF 'N
QUIT
Begin DoDot:1
+24 IF $PIECE(^BISITE(N,0),U,4)=BIIEN
SET $PIECE(^BISITE(N,0),U,4)=""
+25 IF $PIECE(^BISITE(N,0),U,13)=BIIEN
SET $PIECE(^BISITE(N,0),U,13)=""
End DoDot:1
+26 ;
+27 SET VALMQUIT=""
QUIT
+28 QUIT
+29 ;
+30 ;
+31 ;----------
HELP5 ;EP
+1 ;;If you enter YES, this Form Letter will be deleted and no longer
+2 ;;available for editing or sending to patients."
+3 DO HELPTX("HELP5",5)
+4 QUIT
+5 ;
+6 ;
+7 ;----------
HELPTX(BILINL,BITAB) ;
+1 NEW I,T,X
SET T=""
IF '$DATA(BITAB)
SET BITAB=5
FOR I=1:1:BITAB
SET T=T_" "
+2 FOR I=1:1
SET X=$TEXT(@BILINL+I)
IF X'[";;"
QUIT
SET DIR("?",I)=T_$PIECE(X,";;",2)
+3 SET DIR("?")=DIR("?",I-1)
KILL DIR("?",I-1)
+4 QUIT
+5 ;
+6 ;
+7 ;----------
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
