APSPDUED.m

APSPDUED ; IHS/DSD/ENM - DELETE DUE CRITERIA NAME FROM DRUG FILE ;  [ 09/03/97   1:30 PM ]

 ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 ;

 ; This routine will delete all entries in the Drug File DUE multiple

 ; for a selected DUE Criteria Name.  It will ask the user if they

 ; want to continue after selection before deletion. It is called from

 ; APSPDUE

 ;

 ; Local Variables: APSPDUED array,I,DIK,%

 ; Input variables: APSPDUE

 ; Global Variables: ^PSDRUG(

 ; External Calls: DIC,DIK,YN^DICN

 ;

 ;--------------------------------------------------------------------

START ;   

 S:$D(APSPDUE("NAME"))#2 APSPDUED("NAME")=APSPDUE("NAME")

 D:'$D(APSPDUED("NAME"))#2 DUE ; Select DUE Criteria Name

 D:$D(APSPDUED("NAME"))#2 ASK ; Ask if they want to continue

 D:$D(APSPDUED("DEL"))#2 DELETE ; Delete from Drug File DUE multiple

END D EOJ ; Clean up variables

 Q

 ;

 ;--------------------------------------------------------------------

DUE ; Do lookup of DUE Criteria name

 S DIC(0)="QEMA",DIC="^APSPDUE(32.1,"

 S DIC("A")="Select DUE Criteria Name : "

 D ^DIC

 I Y="-1" G:X=""!(X="^") DUEX G DUE

 S APSPDUED("NAME")=+Y

 W !

DUEX ; Exit point from DUE subroutine

 K DIC,DA K:X="^" APSPDUED("NAME") K X,Y

 Q

 ;

ASK ;

 W !!,"This will remove all entries in your Drug file for the"

 W !,"above DUE criteria name, do you want me to continue : "

 S %=2 D YN^DICN

 I %=0 W !!,"This will unmark the drugs in your drug file as being",!,"part of a DUE study for the particular DUE you have chosen." G ASK

 S:%=1 APSPDUED("DEL")=""

 Q

 ;

DELETE ;EP - Delete from Drug File DUR multiple

 G:'$D(^PSDRUG("APSPCN",APSPDUED("NAME")))#2 DELETEX

 S APSPDUED("DRUG")=""

 F I=0:0 S APSPDUED("DRUG")=$O(^PSDRUG("APSPCN",APSPDUED("NAME"),APSPDUED("DRUG"))) Q:APSPDUED("DRUG")'=+APSPDUED("DRUG")  D

 . S DA(1)=APSPDUED("DRUG")

 . S DIK="^PSDRUG(DA(1),999999911,",DA=APSPDUED("NAME")

 . D ^DIK K DIK,DA,DIC

 . W:'$D(APSP("LOG DEL FLG")) "."

 W "Done"

 K APSPDUED("DRUG")

DELETEX ; Exit point from Delete subroutine

 Q

 ;

EOJ ; Clean up variables

 W:$D(APSPDUED("DRUG")) " All finished ..."

 K APSPDUED,DIK,I,DA,%,Y,X,DIC

 Q

APSPDUED  ; IHS/DSD/ENM - DELETE DUE CRITERIA NAME FROM DRUG FILE ;  [ 09/03/97   1:30 PM ]

 +1       ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 +2       ;

 +3       ; This routine will delete all entries in the Drug File DUE multiple

 +4       ; for a selected DUE Criteria Name.  It will ask the user if they

 +5       ; want to continue after selection before deletion. It is called from

 +6       ; APSPDUE

 +7       ;

 +8       ; Local Variables: APSPDUED array,I,DIK,%

 +9       ; Input variables: APSPDUE

 +10      ; Global Variables: ^PSDRUG(

 +11      ; External Calls: DIC,DIK,YN^DICN

 +12      ;

 +13      ;--------------------------------------------------------------------

START     ;   

 +1        IF $DATA(APSPDUE("NAME"))#2

               SET APSPDUED("NAME")=APSPDUE("NAME")

 +2       ; Select DUE Criteria Name

           IF '$DATA(APSPDUED("NAME"))#2

               DO DUE

 +3       ; Ask if they want to continue

           IF $DATA(APSPDUED("NAME"))#2

               DO ASK

 +4       ; Delete from Drug File DUE multiple

           IF $DATA(APSPDUED("DEL"))#2

               DO DELETE

END       ; Clean up variables

           DO EOJ

 +1        QUIT 

 +2       ;

 +3       ;--------------------------------------------------------------------

DUE       ; Do lookup of DUE Criteria name

 +1        SET DIC(0)="QEMA"

           SET DIC="^APSPDUE(32.1,"

 +2        SET DIC("A")="Select DUE Criteria Name : "

 +3        DO ^DIC

 +4        IF Y="-1"

               IF X=""!(X="^")

                   GOTO DUEX

               GOTO DUE

 +5        SET APSPDUED("NAME")=+Y

 +6        WRITE !

DUEX      ; Exit point from DUE subroutine

 +1        KILL DIC,DA

           IF X="^"

               KILL APSPDUED("NAME")

           KILL X,Y

 +2        QUIT 

 +3       ;

ASK       ;

 +1        WRITE !!,"This will remove all entries in your Drug file for the"

 +2        WRITE !,"above DUE criteria name, do you want me to continue : "

 +3        SET %=2

           DO YN^DICN

 +4        IF %=0

               WRITE !!,"This will unmark the drugs in your drug file as being",!,"part of a DUE study for the particular DUE you have chosen."

               GOTO ASK

 +5        IF %=1

               SET APSPDUED("DEL")=""

 +6        QUIT 

 +7       ;

DELETE    ;EP - Delete from Drug File DUR multiple

 +1        IF '$DATA(^PSDRUG("APSPCN",APSPDUED("NAME")))#2

               GOTO DELETEX

 +2        SET APSPDUED("DRUG")=""

 +3        FOR I=0:0

               SET APSPDUED("DRUG")=$ORDER(^PSDRUG("APSPCN",APSPDUED("NAME"),APSPDUED("DRUG")))

               IF APSPDUED("DRUG")'=+APSPDUED("DRUG")

                   QUIT 

               Begin DoDot:1

 +4                SET DA(1)=APSPDUED("DRUG")

 +5                SET DIK="^PSDRUG(DA(1),999999911,"

                   SET DA=APSPDUED("NAME")

 +6                DO ^DIK

                   KILL DIK,DA,DIC

 +7                IF '$DATA(APSP("LOG DEL FLG"))

                       WRITE "."

               End DoDot:1

 +8        WRITE "Done"

 +9        KILL APSPDUED("DRUG")

DELETEX   ; Exit point from Delete subroutine

 +1        QUIT 

 +2       ;

EOJ       ; Clean up variables

 +1        IF $DATA(APSPDUED("DRUG"))

               WRITE " All finished ..."

 +2        KILL APSPDUED,DIK,I,DA,%,Y,X,DIC

 +3        QUIT