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

ACDDIK.m

Go to the documentation of this file.
  1. ACDDIK ;IHS/ADC/EDE/KML - DELETE A VISIT ENTRY FROM VISIT FILES;
  1. ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1. EN ;EP for user interaction
  1. ;//[ACDDIK]
  1. W @IOF,"Signon Program is : ",$P(^DIC(4,DUZ(2),0),U)
  1. W !,"Visit Records to Delete are: THOSE NOT EXTRACTED."
  1. W !," THOSE WITHIN YOUR SIGNIN PROGRAM.",!
  1. W !,"DELETING CDMIS VISIT RECORDS...",!!
  1. S DIC("S")="I ^(""BWP"")=DUZ(2),'$P(^(0),U,25)"
  1. S DIC="^ACDVIS(",DIC(0)="AEQ" D ^DIC G:Y<0 K S ACDVISP=+Y
  1. ;
  1. AUTO ;EP for time out
  1. ;
  1. ;//^ACDDE
  1. ;//^ACDDIC
  1. ;//^ACDAUTO1
  1. ;For partial entries as well
  1. Q:'$D(ACDVISP)
  1. ;
  1. S:'$D(ACD80) $P(ACD80,"=",79)="=" W !!,ACD80
  1. D YN I 'ACDOK W " No action taken..." G K
  1. S DA=ACDVISP,DIK="^ACDVIS(" D ^DIK
  1. W !,"** INCOMPLETE or INCORRECT ** VISIT LINK deleted from Visit file."
  1. F ACDDA=0:0 S ACDDA=$O(^ACDIIF("C",ACDVISP,ACDDA)) Q:'ACDDA S DA=ACDDA,DIK="^ACDIIF(" D ^DIK W !,*7,*7,"** INCOMPLETE or INCORRECT ** VISIT LINK deleted from Init/Info/Fu file."
  1. F ACDDA=0:0 S ACDDA=$O(^ACDTDC("C",ACDVISP,ACDDA)) Q:'ACDDA S DA=ACDDA,DIK="^ACDTDC(" D ^DIK W !,*7,*7,"** INCOMPLETE or INCORRECT ** VISIT LINK deleted from Tran/Dis/Close file."
  1. F ACDDA=0:0 S ACDDA=$O(^ACDCS("C",ACDVISP,ACDDA)) Q:'ACDDA S DA=ACDDA,DIK="^ACDCS(" D ^DIK W !,*7,*7,"** INCOMPLETE or INCORRECT ** VISIT LINK deleted from Client Service file."
  1. W !,ACD80
  1. W !!," Visit deletion complete...."
  1. D PAUSE^ACDDEU
  1. D K Q
  1. ;
  1. YN ;
  1. ;No user interaction if time out so quit
  1. I $D(DTOUT)!($D(ACDTOUT)) S ACDOK=1 Q
  1. ;For user interaction i.e. LINE TAG:EN
  1. S DIR(0)="Y",DIR("A")="Are You Sure You Wish to DELETE This ENTRY",DIR("B")="NO" K DA D ^DIR K DIR
  1. S ACDOK=Y
  1. Q
  1. K ;
  1. K DIK,DIC,%,ACDDA,DA,ACD80,ACDVISP
  1. Q