Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BILETVW2

BILETVW2.m

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