APSPMED1.m

APSPMED1 ; IHS/DSD/ENM - OUTPATIENT MED PROFILE MOD ;  [ 05/14/1998   4:04 PM ]

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

 ; GET FROM AND TO DATES AND MULTIPLE PATIENT SELECTION

EP1 ;EP

 S APSPAGE=0,APSP=0,APSPDEL=""

 S %DT("A")="Select Beginning Date: ",%DT="AEP" D ^%DT Q:Y<0  S X1=Y,X2=-1 D C^%DTC S APSPBD=X_.2359 ;IHS/DSD/ENM/POC 05/11/98

 S %DT("A")="Ending Date: ",%DT("B")="TODAY",%DT="AEP" D ^%DT S APSPED=Y_".2359" Q:Y<0  ;IHS/DSD/ENM/POC 05/11/98

EP ;EP - Entry point to Select 1 or more patients

 S DIC=2,DIC(0)="QEAM" D ^DIC

 I X="^" K APSPDPT,APSPAGE Q

 I +Y>0 D PASS G EP

 I '$D(APSPDPT)&((+Y["^")!(+Y<0)) Q

 ;LIST NAMES AND ALLOW DE-SELECTION

 I $D(APSPDPT) D SELDEL

 K APSPX1,APSPEM,APSPCTR,APSPXA,APSPZAP,DIR,DIC

 Q

SELDEL ;SELECT/DE-SELECT PATIENT FROM LIST............................

 S APSPDEL="" ;IHS/DSD/ENM 010595

 W !,"So far, you've selected...." S APSPX1="",APSPCTR=0

 F I=1:1 S APSPX1=$O(APSPDPT(APSPX1)) Q:'APSPX1  S APSPEM(I)=APSPX1,APSPCTR=APSPCTR+1 W ?30,"("_I_") "_APSPDPT(APSPX1),!

RETRY S DIR("A")="Would you like to De-select a patient from this list",DIR(0)="Y",DIR("?")="Enter a ""Y"" for ""Yes"" or an ""N"" for ""No"""

 S DIR("B")="No" D ^DIR K DIR S APSPXA=X K X

 Q:"Nn"[$E(APSPXA)  ;IHS/DSD/ENM 08/23/96

DEL ;

 I "Yy"[$E(APSPXA) S DIR(0)="NO^1:"_APSPCTR,DIR("A")="Delete Number" D ^DIR S APSPDEL=X ;IHS/DSD/ENM 08/23/96

 I APSPDEL["^"!(APSPDEL="") Q

 I APSPDEL<1!(APSPDEL>APSPCTR) W !,"Enter a number from 1 to ",APSPCTR G DEL

 I APSPDEL'>APSPCTR!(APSPDEL'<1) S APSPZAP=APSPEM(APSPDEL) K APSPDPT(APSPZAP) G DEL

 Q

PASS D DT^DICRW S (FN,DFN,D0,DA)=+Y I '$D(^PS(55,+Y,"P")),'$D(^PS(55,+Y,"ARC")) W !?20,*7,"NO PHARMACY INFORMATION" H 2 D ^APSPMED2 G APSPMED1

 I '$O(^PS(55,+Y,"P",0)),$D(^PS(55,+Y,"ARC")) D ^APSPMED2 W !!,"PATIENT HAS ARCHIVED PRESCRIPTIONS",! D ^APSPMED2 G APSPMED1

 S:+Y>0 APSPDPT(+Y)=$P(Y,"^",2)

 Q

XIT K APSPDEL

 Q

APSPMED1  ; IHS/DSD/ENM - OUTPATIENT MED PROFILE MOD ;  [ 05/14/1998   4:04 PM ]

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

 +2       ; GET FROM AND TO DATES AND MULTIPLE PATIENT SELECTION

EP1       ;EP

 +1        SET APSPAGE=0

           SET APSP=0

           SET APSPDEL=""

 +2       ;IHS/DSD/ENM/POC 05/11/98

           SET %DT("A")="Select Beginning Date: "

           SET %DT="AEP"

           DO ^%DT

           IF Y<0

               QUIT 

           SET X1=Y

           SET X2=-1

           DO C^%DTC

           SET APSPBD=X_.2359

 +3       ;IHS/DSD/ENM/POC 05/11/98

           SET %DT("A")="Ending Date: "

           SET %DT("B")="TODAY"

           SET %DT="AEP"

           DO ^%DT

           SET APSPED=Y_".2359"

           IF Y<0

               QUIT 

EP        ;EP - Entry point to Select 1 or more patients

 +1        SET DIC=2

           SET DIC(0)="QEAM"

           DO ^DIC

 +2        IF X="^"

               KILL APSPDPT,APSPAGE

               QUIT 

 +3        IF +Y>0

               DO PASS

               GOTO EP

 +4        IF '$DATA(APSPDPT)&((+Y["^")!(+Y<0))

               QUIT 

 +5       ;LIST NAMES AND ALLOW DE-SELECTION

 +6        IF $DATA(APSPDPT)

               DO SELDEL

 +7        KILL APSPX1,APSPEM,APSPCTR,APSPXA,APSPZAP,DIR,DIC

 +8        QUIT 

SELDEL    ;SELECT/DE-SELECT PATIENT FROM LIST............................

 +1       ;IHS/DSD/ENM 010595

           SET APSPDEL=""

 +2        WRITE !,"So far, you've selected...."

           SET APSPX1=""

           SET APSPCTR=0

 +3        FOR I=1:1

               SET APSPX1=$ORDER(APSPDPT(APSPX1))

               IF 'APSPX1

                   QUIT 

               SET APSPEM(I)=APSPX1

               SET APSPCTR=APSPCTR+1

               WRITE ?30,"("_I_") "_APSPDPT(APSPX1),!

RETRY      SET DIR("A")="Would you like to De-select a patient from this list"

           SET DIR(0)="Y"

           SET DIR("?")="Enter a ""Y"" for ""Yes"" or an ""N"" for ""No"""

 +1        SET DIR("B")="No"

           DO ^DIR

           KILL DIR

           SET APSPXA=X

           KILL X

 +2       ;IHS/DSD/ENM 08/23/96

           IF "Nn"[$EXTRACT(APSPXA)

               QUIT 

DEL       ;

 +1       ;IHS/DSD/ENM 08/23/96

           IF "Yy"[$EXTRACT(APSPXA)

               SET DIR(0)="NO^1:"_APSPCTR

               SET DIR("A")="Delete Number"

               DO ^DIR

               SET APSPDEL=X

 +2        IF APSPDEL["^"!(APSPDEL="")

               QUIT 

 +3        IF APSPDEL<1!(APSPDEL>APSPCTR)

               WRITE !,"Enter a number from 1 to ",APSPCTR

               GOTO DEL

 +4        IF APSPDEL'>APSPCTR!(APSPDEL'<1)

               SET APSPZAP=APSPEM(APSPDEL)

               KILL APSPDPT(APSPZAP)

               GOTO DEL

 +5        QUIT 

PASS       DO DT^DICRW

           SET (FN,DFN,D0,DA)=+Y

           IF '$DATA(^PS(55,+Y,"P"))

               IF '$DATA(^PS(55,+Y,"ARC"))

                   WRITE !?20,*7,"NO PHARMACY INFORMATION"

                   HANG 2

                   DO ^APSPMED2

                   GOTO APSPMED1

 +1        IF '$ORDER(^PS(55,+Y,"P",0))

               IF $DATA(^PS(55,+Y,"ARC"))

                   DO ^APSPMED2

                   WRITE !!,"PATIENT HAS ARCHIVED PRESCRIPTIONS",!

                   DO ^APSPMED2

                   GOTO APSPMED1

 +2        IF +Y>0

               SET APSPDPT(+Y)=$PIECE(Y,"^",2)

 +3        QUIT 

XIT        KILL APSPDEL

 +1        QUIT