ACDDIK.m

ACDDIK ;IHS/ADC/EDE/KML - DELETE A VISIT ENTRY FROM VISIT FILES;

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

EN ;EP for user interaction

 ;//[ACDDIK]

 W @IOF,"Signon Program is          : ",$P(^DIC(4,DUZ(2),0),U)

 W !,"Visit Records to Delete are: THOSE NOT EXTRACTED."

 W !,"                             THOSE WITHIN YOUR SIGNIN PROGRAM.",!

 W !,"DELETING CDMIS VISIT RECORDS...",!!

 S DIC("S")="I ^(""BWP"")=DUZ(2),'$P(^(0),U,25)"

 S DIC="^ACDVIS(",DIC(0)="AEQ" D ^DIC G:Y<0 K S ACDVISP=+Y

 ;

AUTO ;EP for time out

 ;

 ;//^ACDDE

 ;//^ACDDIC

 ;//^ACDAUTO1

 ;For partial entries as well

 Q:'$D(ACDVISP)

 ;

 S:'$D(ACD80) $P(ACD80,"=",79)="=" W !!,ACD80

 D YN I 'ACDOK W "   No action taken..." G K

 S DA=ACDVISP,DIK="^ACDVIS(" D ^DIK

 W !,"** INCOMPLETE or INCORRECT ** VISIT LINK deleted from Visit file."

 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."

 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."

 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."

 W !,ACD80

 W !!,"   Visit deletion complete...."

 D PAUSE^ACDDEU

 D K Q

 ;

YN ;

 ;No user interaction if time out so quit

 I $D(DTOUT)!($D(ACDTOUT)) S ACDOK=1 Q

 ;For user interaction i.e. LINE TAG:EN

 S DIR(0)="Y",DIR("A")="Are You Sure You Wish to DELETE This ENTRY",DIR("B")="NO" K DA D ^DIR K DIR

 S ACDOK=Y

 Q

K ;

 K DIK,DIC,%,ACDDA,DA,ACD80,ACDVISP

 Q

ACDDIK    ;IHS/ADC/EDE/KML - DELETE A VISIT ENTRY FROM VISIT FILES;

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

EN        ;EP for user interaction

 +1       ;//[ACDDIK]

 +2        WRITE @IOF,"Signon Program is          : ",$PIECE(^DIC(4,DUZ(2),0),U)

 +3        WRITE !,"Visit Records to Delete are: THOSE NOT EXTRACTED."

 +4        WRITE !,"                             THOSE WITHIN YOUR SIGNIN PROGRAM.",!

 +5        WRITE !,"DELETING CDMIS VISIT RECORDS...",!!

 +6        SET DIC("S")="I ^(""BWP"")=DUZ(2),'$P(^(0),U,25)"

 +7        SET DIC="^ACDVIS("

           SET DIC(0)="AEQ"

           DO ^DIC

           IF Y<0

               GOTO K

           SET ACDVISP=+Y

 +8       ;

AUTO      ;EP for time out

 +1       ;

 +2       ;//^ACDDE

 +3       ;//^ACDDIC

 +4       ;//^ACDAUTO1

 +5       ;For partial entries as well

 +6        IF '$DATA(ACDVISP)

               QUIT 

 +7       ;

 +8        IF '$DATA(ACD80)

               SET $PIECE(ACD80,"=",79)="="

           WRITE !!,ACD80

 +9        DO YN

           IF 'ACDOK

               WRITE "   No action taken..."

               GOTO K

 +10       SET DA=ACDVISP

           SET DIK="^ACDVIS("

           DO ^DIK

 +11       WRITE !,"** INCOMPLETE or INCORRECT ** VISIT LINK deleted from Visit file."

 +12       FOR ACDDA=0:0

               SET ACDDA=$ORDER(^ACDIIF("C",ACDVISP,ACDDA))

               IF 'ACDDA

                   QUIT 

               SET DA=ACDDA

               SET DIK="^ACDIIF("

               DO ^DIK

               WRITE !,*7,*7,"** INCOMPLETE or INCORRECT ** VISIT LINK deleted from Init/Info/Fu file."

 +13       FOR ACDDA=0:0

               SET ACDDA=$ORDER(^ACDTDC("C",ACDVISP,ACDDA))

               IF 'ACDDA

                   QUIT 

               SET DA=ACDDA

               SET DIK="^ACDTDC("

               DO ^DIK

               WRITE !,*7,*7,"** INCOMPLETE or INCORRECT ** VISIT LINK deleted from Tran/Dis/Close file."

 +14       FOR ACDDA=0:0

               SET ACDDA=$ORDER(^ACDCS("C",ACDVISP,ACDDA))

               IF 'ACDDA

                   QUIT 

               SET DA=ACDDA

               SET DIK="^ACDCS("

               DO ^DIK

               WRITE !,*7,*7,"** INCOMPLETE or INCORRECT ** VISIT LINK deleted from Client Service file."

 +15       WRITE !,ACD80

 +16       WRITE !!,"   Visit deletion complete...."

 +17       DO PAUSE^ACDDEU

 +18       DO K

           QUIT 

 +19      ;

YN        ;

 +1       ;No user interaction if time out so quit

 +2        IF $DATA(DTOUT)!($DATA(ACDTOUT))

               SET ACDOK=1

               QUIT 

 +3       ;For user interaction i.e. LINE TAG:EN

 +4        SET DIR(0)="Y"

           SET DIR("A")="Are You Sure You Wish to DELETE This ENTRY"

           SET DIR("B")="NO"

           KILL DA

           DO ^DIR

           KILL DIR

 +5        SET ACDOK=Y

 +6        QUIT 

K         ;

 +1        KILL DIK,DIC,%,ACDDA,DA,ACD80,ACDVISP

 +2        QUIT