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

DVBCADR.m

Go to the documentation of this file. 
  1. DVBCADR ;ALB/JLU-editing the address ;1/28/93
  1.  ;;2.7;AMIE;**19**;Apr 10, 1995
  1.  ;
  1. EN ;driver of the program
  1.  S DVBCSTP=0
  1.  F  DO  Q:DVBCSTP
  1.  .D PAT Q:DVBCSTP
  1.  .D INIT Q:DVBCSTP
  1.  .F  D GUTS Q:DVBCSTP1
  1.  .I DVBCMAL D MAIL
  1.  D EXIT
  1.  Q
  1.  ;
  1. GUTS ;this is the interloop or guts of the driver
  1.  D DISPL
  1.  D ASK
  1.  I 'Y S DVBCSTP1=1 Q
  1.  D QUES^DGRPU1(DVBCDFN,"ADD1")
  1.  I DGERR D ERROR Q
  1.  I DGCHANGE S DVBCMAL=1
  1.  D VDPTP
  1.  Q
  1.  ;
  1. EXIT ;cleans variables
  1.  K %H,DFN,DGCHANGE,DGERR,DIC,DIR,DVBC,DVBCDATE,DVBCDFN,DVBCLINE,DVBCMAL,DVBCPATN,DVBCSSN,DVBCSTP,DVBCSTP1,VAERR,VAPA,Y,XMTEXT,XMY,XMB,XMDUZ,XMSUB,DVBCX,DVBCML,DVBCSP,DVBCSP1,ER,J,C,PNAM,SSN,DVBCSSNO
  1.  K DVBTMP,XMBTEXT
  1.  Q
  1.  ;
  1. ERROR ;this is an erro printing subroutine
  1.  I DGERR W !,*7
  1.  Q
  1.  ;
  1. INIT ;initialize variables
  1.  I '$D(IOF) D HOME^%ZIS
  1.  K VAPA,DVBTMP,DVBC
  1.  S %H=$H
  1.  D YX^%DTC
  1.  S DVBCDATE=$P(Y,"@",1)
  1.  S $P(DVBCLINE,"_",80)=""
  1.  S SSN=$P(^DPT(DVBCDFN,0),U,9)
  1.  D SSNOUT^DVBCUTIL
  1.  S DVBCSSN=DVBCSSNO
  1.  D VDPTTMP
  1.  I VAERR S DVBCSTP=1 Q
  1.  I +VAPA(9) DO
  1.  .D STORTMP
  1.  .K VAPA
  1.  .D VDPTP
  1.  I VAERR S DVBCSTP=1 Q
  1.  D STORE
  1.  S (DVBCSTP1,DVBCMAL)=0
  1.  Q
  1.  ;
  1. PAT ;get the patient
  1.  S DIC="^DPT(",DIC(0)="AEMQ"
  1.  D ^DIC
  1.  I Y<0 S DVBCSTP=1 Q
  1.  S DVBCDFN=+Y,(PNAM,DVBCPATN)=$P(Y,U,2)
  1.  Q
  1.  ;
  1. DISPL ;the display subroutine
  1.  W @IOF
  1.  W "Edit Address Information",?35,$$SITE^DVBCUTL4,?67,DVBCDATE
  1.  W !,"Name: ",DVBCPATN,?54,"SSN: ",DVBCSSN
  1.  W !,DVBCLINE
  1.  W !,?9,"Permanent"
  1.  I $D(DVBTMP) DO
  1.  .W ?40,"Temporary:  ",$P(DVBTMP(9),U,2)
  1.  .I $P(DVBTMP(10),U,2)]"" W " to ",$P(DVBTMP(10),U,2)
  1.  W !,"Address: ",$E(VAPA(1),1,29)
  1.  I $D(DVBTMP) W ?40,$E(DVBTMP(1),1,29)
  1.  W !,?9,$E(VAPA(2),1,29)
  1.  I $D(DVBTMP) W ?40,$E(DVBTMP(2),1,29)
  1.  W !,?9,$E(VAPA(3),1,29)
  1.  I $D(DVBTMP) W ?40,$E(DVBTMP(3),1,29)
  1.  W !,"City:",?9,VAPA(4)
  1.  I $D(DVBTMP) W ?40,DVBTMP(4)
  1.  W !,"State:",?9,$P(VAPA(5),U,2)
  1.  I $D(DVBTMP) W ?40,$P(DVBTMP(5),U,2)
  1.  W !,"Zip+4:",?9,$S($D(VAPA(11)):$P(VAPA(11),"^",2),1:"")
  1.  I $D(DVBTMP) W ?40,DVBTMP(11)
  1.  W !,"County:",?9,$P(VAPA(7),U,2)
  1.  I $D(DVBTMP) W ?40,$P(DVBTMP(7),U,2)
  1.  W !,"Phone:",?9,VAPA(8)
  1.  I $D(DVBTMP) W ?40,DVBTMP(8)
  1.  W !,"Office:",?9,VAPA(9999)
  1.  W !,DVBCLINE
  1.  Q
  1.  ;
  1. ASK ;ask if yes or no
  1.  S DIR(0)="Y",DIR("A")="Do you wish to edit this address:",DIR("B")="YES"
  1.  D ^DIR
  1.  Q
  1.  ;
  1. STORE ;store original address fro possible bulletin
  1.  S DVBC(1)=VAPA(1),DVBC(2)=VAPA(2),DVBC(3)=VAPA(3)
  1.  S DVBC(4)=VAPA(4),DVBC(5)=$P(VAPA(5),U,2)
  1.  S DVBC(11)=$S($D(VAPA(11)):$P(VAPA(11),"^",2),1:"")
  1.  S DVBC(7)=$P(VAPA(7),U,2),DVBC(8)=VAPA(8)
  1.  S DVBC(9999)=VAPA(9999)
  1.  Q
  1.  ;
  1. VDPTP ;gets the permanent address
  1.  S VAPA("P")=""
  1. VDPTTMP ;gets the temporary address if one
  1.  S DFN=DVBCDFN
  1.  D ADD^VADPT
  1.  S VAPA(9999)=$S($D(^DPT(DFN,.13)):$P(^(.13),U,2),1:"")
  1.  Q
  1.  ;
  1. STORTMP ;saves the active temporary address
  1.  S DVBTMP(1)=VAPA(1),DVBTMP(2)=VAPA(2),DVBTMP(3)=VAPA(3),DVBTMP(4)=VAPA(4)
  1.  S DVBTMP(5)=VAPA(5),DVBTMP(11)=$S($D(VAPA(11)):$P(VAPA(11),"^",2),1:"")
  1.  S DVBTMP(7)=VAPA(7),DVBTMP(8)=VAPA(8)
  1.  S DVBTMP(9)=VAPA(9),DVBTMP(10)=VAPA(10)
  1.  Q
  1.  ;
  1. MAIL ;to fire a bulletin if necessary
  1.  S XMDUZ="AMIE Package",XMSUB="Edit of patient address"
  1.  S XMB(1)=DVBCPATN_"   SSN: "_DVBCSSN,XMB(2)=DVBCDATE,XMB(3)=$P(^VA(200,DUZ,0),U,1)
  1.  S XMB="DVBA C EDIT ADDRESS"
  1.  D XMT
  1.  S XMTEXT="DVBCML("
  1.  D ^XMB
  1.  K XMBTEXT,XMTEXT,XMB,XMSUB
  1.  W !!,"A bulletin has been sent to the appropriate mail group regarding this",!,"address change!"
  1.  Q
  1.  ;
  1. XMT ;make the text of the bulletin
  1.  S DVBCX=1 D LIN
  1.  S DVBCML(1)="ADDR.:  "_DVBC(1)_DVBCSP_VAPA(1)
  1.  S DVBCX=2 D LIN
  1.  S DVBCML(2)="        "_DVBC(2)_DVBCSP_VAPA(2)
  1.  S DVBCX=3 D LIN
  1.  S DVBCML(3)="        "_DVBC(3)_DVBCSP_VAPA(3)
  1.  S DVBCX=4 D LIN
  1.  S DVBCML(4)="City:   "_DVBC(4)_DVBCSP_VAPA(4)
  1.  S DVBCX=5 D LIN
  1.  S DVBCML(5)="State:  "_DVBC(5)_DVBCSP_$P(VAPA(5),U,2)
  1.  S DVBCX=11 D LIN
  1.  S DVBCML(6)="Zip+4:  "_DVBC(11)_DVBCSP_$S($D(VAPA(11)):$P(VAPA(11),"^",2),1:"")
  1.  S DVBCX=7 D LIN
  1.  S DVBCML(7)="County: "_DVBC(7)_DVBCSP_$P(VAPA(7),U,2)
  1.  S DVBCX=8 D LIN
  1.  S DVBCML(8)="Phone:  "_DVBC(8)_DVBCSP_VAPA(8)
  1.  S DVBCX=9999 D LIN
  1.  S DVBCML(9)="Office: "_DVBC(9999)_DVBCSP_VAPA(9999)
  1.  Q
  1.  ;
  1. LIN ;makes spaces
  1.  K DVBCSP,DVBCSP1
  1.  S DVBCSP1=37-$L(DVBC(DVBCX))
  1.  S $P(DVBCSP," ",DVBCSP1)=""
  1.  Q