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

ADEMDEL.m

Go to the documentation of this file. 
  1. ADEMDEL ; IHS/HQT/MJL  - FOLLOWUP LIST DELETION ;06:50 PM  [ 03/24/1999   9:04 AM ]
  1.  ;;6.0;ADE;;APRIL 1999
  1.  ;CALLED AT EN WITH ADEPAT AND ADEMDFN WILL DELETE ENTRY ADEMDFN
  1.  ;FROM ^ADEFOL AND UPDATE ^ADEPAT
  1.  ;------->INITIALIZE
  1.  Q:'$D(ADEREF)!'$D(ADEREC)!'$D(ADEWAI)  S $P(ADELIN,"*",79)=""
  1.  S ADETYP=$S(ADEREF:"rf",ADEREC:"rc",ADEWAI:"w")
  1.  S ADEFUNC=" DELETION "
  1.  D ^XBKVAR I '$D(DUZ(2)) W !,"DIVISION NOT SET IN USER FILE -- CONTACT SITE MANAGER OR ISC" Q
  1.  I DUZ(2)=0 W !,"DIVISION SET TO ZERO (UNIVERSAL). DIVISION MUST BE SET TO ONE OF THE ",!,"SITES IN THE DENTAL SITE PARAMETER FILE. -- CONTACT SITE MANAGER" Q
  1. ONE ;------->RESET CONSTANT FOLLOWUP SUBTYPE IF CALLED EXTERNALLY
  1.  ;        TYPE SET BY CALLING OPTION
  1.  ;        RETURN ADESUB=DFN IN ^ADETYP(
  1.  D RESET^ADEMNG1 G:Y<1 END
  1. TWO ;------->LOOK UP A PATIENT
  1.  S ADEINT=0,ADEMDEL=1 D PTLOOK^ADEMNG1 K ADEINT,ADEMDEL G:Y<1 ONE
  1.  ;------->DELETION
  1.  K ADEMDFN D DEL
  1.  I ADEMDFN="NO" W !?5,"--No changes made" H 2 G THREE
  1.  I 'ADEMDFN W !,"***PATIENT NOT ON ",ADESUBN," LIST***",*7 H 2
  1.  E  W !?5,"--DELETED" H 1
  1.  ;------->GET ANOTHER PATIENT
  1. THREE K ADEMDFN K ^ADEUTL("ADELOCK",ADEPAT) G TWO ;^ADEUTL is a transient working global
  1. END K ADEADAT,ADEFUNC,ADELIN,ADEMDFN,ADENOD,ADEPAT,ADEREC,ADEREF,ADESUB,ADESUBN,ADETYP,ADEWAI,ADENEWM Q
  1. EN D DEL Q
  1. DEL ;EP
  1.  ;------->GET ENTRY ADEMDFN IN ^ADEFOL
  1.  I '$D(ADEMDFN) S ADEMDFN=0 D D1 Q:'ADEMDFN
  1.  ;------->GET INFO ABOUT ENTRY
  1.  S ADENOD=^ADEFOL(ADEMDFN,0)
  1.  S ADEADAT=$P(ADENOD,U,3)
  1.  ;------->CREATE ENTRY IN ^ADEPAT
  1.  D CRE
  1.  ;------->DELETE ENTRY FROM ^ADEFOL
  1.  D DEST
  1.  ;------->QUIT
  1.  Q
  1. D1 Q:'$D(^ADEFOL("TYPE",ADEPAT,ADETYP,ADESUB))
  1.  S ADEMDFN=$O(^ADEFOL("TYPE",ADEPAT,ADETYP,ADESUB,0)) Q:'+ADEMDFN
  1.  W !,"ARE YOU SURE YOU WANT TO DELETE?" S %=1 D YN^DICN S:%'=1 ADEMDFN="NO"
  1.  Q
  1. CRE ;CREATE ENTRY IN PATIENT FILE IF DOESN'T EXIST
  1.  I '$D(^ADEPAT(ADEPAT)) S DIC="^ADEPAT(",DIC(0)="LZ",X=ADEPAT,DINUM=X K DD,DO D FILE^DICN
  1.  ;CREATE SUBENTRY
  1.  K DIC,DIE,DA,DR,X,Y
  1.  S DA(1)=ADEPAT
  1.  S DIE="^ADEPAT(DA(1),""FOL"","
  1.  I $D(^ADEPAT(ADEPAT,"FOL",0)) S DA=$P(^ADEPAT(ADEPAT,"FOL",0),U,3)+1
  1.  E  S ^ADEPAT(ADEPAT,"FOL",0)="^9002010.21PA^^",DA=1 ;DIE requires that the Zeroeth node of a subfile be set before adding the first subentry
  1.  S DR=".01///`"_ADESUB_";2///"_ADEADAT_";3///"_DT
  1.  D ^DIE
  1.  S $P(^ADEPAT(ADEPAT,"FOL",0),U,3)=DA,$P(^ADEPAT(ADEPAT,"FOL",0),U,4)=$P(^ADEPAT(ADEPAT,"FOL",0),U,4)+1 ;Fileman requires the programmer to update the zeroeth node of a subfile after adding a subentry via DIE.
  1.  Q
  1. DEST S DIE="^ADEFOL(",DA=ADEMDFN,DR=".01///@" D ^DIE Q