- 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
