APSPCAN.m

APSPCAN ;IHS/OHPRD/JCM - SHOW PROFILE THEN CANCEL MEDICATIONS; [ 09/03/97   1:30 PM ]

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

 ;Input variables: PSDFN,DFN

 ;

 ;variables: PSRXS,AMC,AMC1,AMC2,AMC3,PS,PSFROM,PSII,PSD,X

 ;------------------PSOZCAN("EN")

 ;

 ;External Calls: ^PSODSPL,ENM^PSOCAN1 ;IHS/DSD/ENM 03/27/97

 ;

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

START ;

 N X,PSOFROM,PSOOPT S APSPDFN=PSODFN ;IHS/DSD/ENM 03/27/97

 S BC="LL" ;IHS/DSD/ENM 03/27/97

 D INIT

 ;IHS/DSD/ENM 03/27/97 NEXT 4 LINES DISABLED

 ;D ^PSODSPL ;----->Displays profile

 ;D ASK ;---------->Asks which prescriptions to cancel

 ;G:'$T!(PSRXS="")!(PSRXS["^") EXIT

 ;D EN^PSOCAN ;---->Does the actual cancellation or reinstating of rxs

 D ENM^PSOCAN1 ;IHS/DSD/ENM 03/27/97 ---->Does the actual cancellation or reinstating of rxs

 S:$G(PSODFN)']"" PSODFN=APSPDFN ;IHS/DSD/ENM 03/31/97

EXIT ;---------------->End of routine

 ;

 K PSOZCAN,PS,PSD,PSII,PSRXS,X,PSFROM,BC ;IHS/DSD/ENM 03/27/97

 Q

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

 ;

INIT ;

 S PSOZCAN("EN")=""

 K PSD

 S PSFROM="R",PSII=0

 S PS="CANCEL"

 Q

 ;

ASK ;

 K X

 S DIR("A")="CHOOSE FROM ",DIR("?")="SELECT A NUMBER",DIR(0)="L^1:"_PSII D ^DIR S PSRXS=Y K DIR ;IHS/DSD/ENM 01/09/97

 ;W !,"CHOOSE 1 - ",PSII," > "

 G:'$T!(PSRXS="")!(PSRXS["^") ASKX

 I PSRXS'?1N.E D QUES G START

 I +PSRXS>PSII S X=PSRXS G ASKX

 F AMC=1:1 S AMC1=$P(PSRXS,",",AMC) Q:AMC1=""  S AMC3="" F AMC2=1:1:AMC1 S AMC3=$O(PSD(AMC3)) Q:'AMC3  I AMC2=AMC1 S X=$S($D(X):X_","_$P(^PSRX(+PSD(AMC3),0),U,1),1:$P(^PSRX(+PSD(AMC3),0),U,1)) ;IHS/DSD/ENM 11/15/96

ASKX ;Exit for ASK subroutine

 K AMC,AMC1,AMC2,AMC3

 Q

QUES ;

 W !?5,"Enter the item #(s) or RX #(s) you wish to cancel seperated by commas."

 W !?5,"For example: 1,2,5 or 123456,33254A,232323B."

 W !?5,"Do not enter the same number twice, duplicates are not allowed."

 Q

APSPCAN   ;IHS/OHPRD/JCM - SHOW PROFILE THEN CANCEL MEDICATIONS; [ 09/03/97   1:30 PM ]

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

 +2       ;Input variables: PSDFN,DFN

 +3       ;

 +4       ;variables: PSRXS,AMC,AMC1,AMC2,AMC3,PS,PSFROM,PSII,PSD,X

 +5       ;------------------PSOZCAN("EN")

 +6       ;

 +7       ;External Calls: ^PSODSPL,ENM^PSOCAN1 ;IHS/DSD/ENM 03/27/97

 +8       ;

 +9       ;---------------------------------------------------------------

START     ;

 +1       ;IHS/DSD/ENM 03/27/97

           NEW X,PSOFROM,PSOOPT

           SET APSPDFN=PSODFN

 +2       ;IHS/DSD/ENM 03/27/97

           SET BC="LL"

 +3        DO INIT

 +4       ;IHS/DSD/ENM 03/27/97 NEXT 4 LINES DISABLED

 +5       ;D ^PSODSPL ;----->Displays profile

 +6       ;D ASK ;---------->Asks which prescriptions to cancel

 +7       ;G:'$T!(PSRXS="")!(PSRXS["^") EXIT

 +8       ;D EN^PSOCAN ;---->Does the actual cancellation or reinstating of rxs

 +9       ;IHS/DSD/ENM 03/27/97 ---->Does the actual cancellation or reinstating of rxs

           DO ENM^PSOCAN1

 +10      ;IHS/DSD/ENM 03/31/97

           IF $GET(PSODFN)']""

               SET PSODFN=APSPDFN

EXIT      ;---------------->End of routine

 +1       ;

 +2       ;IHS/DSD/ENM 03/27/97

           KILL PSOZCAN,PS,PSD,PSII,PSRXS,X,PSFROM,BC

 +3        QUIT 

 +4       ;-----------------------------------------------------------------

 +5       ;

INIT      ;

 +1        SET PSOZCAN("EN")=""

 +2        KILL PSD

 +3        SET PSFROM="R"

           SET PSII=0

 +4        SET PS="CANCEL"

 +5        QUIT 

 +6       ;

ASK       ;

 +1        KILL X

 +2       ;IHS/DSD/ENM 01/09/97

           SET DIR("A")="CHOOSE FROM "

           SET DIR("?")="SELECT A NUMBER"

           SET DIR(0)="L^1:"_PSII

           DO ^DIR

           SET PSRXS=Y

           KILL DIR

 +3       ;W !,"CHOOSE 1 - ",PSII," > "

 +4        IF '$TEST!(PSRXS="")!(PSRXS["^")

               GOTO ASKX

 +5        IF PSRXS'?1N.E

               DO QUES

               GOTO START

 +6        IF +PSRXS>PSII

               SET X=PSRXS

               GOTO ASKX

 +7       ;IHS/DSD/ENM 11/15/96

           FOR AMC=1:1

               SET AMC1=$PIECE(PSRXS,",",AMC)

               IF AMC1=""

                   QUIT 

               SET AMC3=""

               FOR AMC2=1:1:AMC1

                   SET AMC3=$ORDER(PSD(AMC3))

                   IF 'AMC3

                       QUIT 

                   IF AMC2=AMC1

                       SET X=$SELECT($DATA(X):X_","_$PIECE(^PSRX(+PSD(AMC3),0),U,1),1:$PIECE(^PSRX(+PSD(AMC3),0),U,1))

ASKX      ;Exit for ASK subroutine

 +1        KILL AMC,AMC1,AMC2,AMC3

 +2        QUIT 

QUES      ;

 +1        WRITE !?5,"Enter the item #(s) or RX #(s) you wish to cancel seperated by commas."

 +2        WRITE !?5,"For example: 1,2,5 or 123456,33254A,232323B."

 +3        WRITE !?5,"Do not enter the same number twice, duplicates are not allowed."

 +4        QUIT