APSPQ.m

APSPQ ; IHS/DSD/ENM - CHECK/ASK DUE QUESTIONNAIRE INFO ;  [ 09/03/97   1:30 PM ]

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

EP ;Check for drug in questionnaire file

 S APSPCTR=0,APSPD="",APSPDR="",APSPZRN="",APSP=0

 I $G(APFLAG)']"" S APFLAG="" ;IHS/DSD/ENM 01/11/96

 S APSPD=$S(APFLAG="RF":$P($G(PSOREF("RX0")),"^",6),APFLAG="N":$G(PSODRUG("IEN")),APFLAG="RE":$G(PSORENW("DRUG IEN")),1:"") Q:APSPD']""

 ;S APSPD=$G(PSODRUG("IEN")) Q:APSPD']""

 F APSP=0:0 S APSPDR=$O(^PS(50.073,"AD",APSPDR)) Q:'APSPDR  F  S APSPZRN=$O(^PS(50.073,"AD",APSPDR,APSPZRN)) Q:'APSPZRN  D CK

 D XIT ;IHS/DSD/ENM 11/12/96

 Q

CK ;

 I APSPDR=APSPD S APSPCTR=APSPCTR+1 D GETAS ;NEXT, GET ANSWER SHEET QUESTIONS

 Q

GETAS ;SET  PARAMS AND ASK ANSWER SHEET QUESTIONS

 ;

 S APNODE=$G(^PS(50.073,APSPZRN,0)) Q:APNODE']""

 S APACT=$P(APNODE,"^",3) Q:APACT'=1

 W !!,"*** This drug is a part of the "

 W $P($G(^PS(50.073,APSPZRN,0)),"^")," study !! **"

 W !,"Please answer the following questionnaire ...."

 I APFLAG="RF" S PSODRUG("IEN")=$P(PSOREF("RX0"),"^",6),PSONEW("IRXN")=PSOREF("IRXN"),PSONEW("PROVIDER")=$P(PSOREF("RX0"),"^",4),PSDFN=PSODFN,PSONEW("RX #")=$P(PSOREF("RX0"),"^")

 I APFLAG="RE" S PSONEW("IRXN")=PSORENW("OIRXN"),PSONEW("PROVIDER")=$P(PSORENW("RX0"),"^",4),PSDFN=PSODFN,PSONEW("RX #")=$P(PSORENW("RX0"),"^") ;IHS/DSD/ENM 08/27/96

 D EP^APSPQ1

 W !,"DUE questionnaire Complete!.....Thank You!",!

 Q

 ;S APQN=$O(^PS(50.073,APSPZRN,APQN)) Q:'APQN  S APQNU=$P(^(0),"^")

XIT K APACT,APNODE

 Q

APSPQ     ; IHS/DSD/ENM - CHECK/ASK DUE QUESTIONNAIRE INFO ;  [ 09/03/97   1:30 PM ]

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

EP        ;Check for drug in questionnaire file

 +1        SET APSPCTR=0

           SET APSPD=""

           SET APSPDR=""

           SET APSPZRN=""

           SET APSP=0

 +2       ;IHS/DSD/ENM 01/11/96

           IF $GET(APFLAG)']""

               SET APFLAG=""

 +3        SET APSPD=$SELECT(APFLAG="RF":$PIECE($GET(PSOREF("RX0")),"^",6),APFLAG="N":$GET(PSODRUG("IEN")),APFLAG="RE":$GET(PSORENW("DRUG IEN")),1:"")

           IF APSPD']""

               QUIT 

 +4       ;S APSPD=$G(PSODRUG("IEN")) Q:APSPD']""

 +5        FOR APSP=0:0

               SET APSPDR=$ORDER(^PS(50.073,"AD",APSPDR))

               IF 'APSPDR

                   QUIT 

               FOR 

                   SET APSPZRN=$ORDER(^PS(50.073,"AD",APSPDR,APSPZRN))

                   IF 'APSPZRN

                       QUIT 

                   DO CK

 +6       ;IHS/DSD/ENM 11/12/96

           DO XIT

 +7        QUIT 

CK        ;

 +1       ;NEXT, GET ANSWER SHEET QUESTIONS

           IF APSPDR=APSPD

               SET APSPCTR=APSPCTR+1

               DO GETAS

 +2        QUIT 

GETAS     ;SET  PARAMS AND ASK ANSWER SHEET QUESTIONS

 +1       ;

 +2        SET APNODE=$GET(^PS(50.073,APSPZRN,0))

           IF APNODE']""

               QUIT 

 +3        SET APACT=$PIECE(APNODE,"^",3)

           IF APACT'=1

               QUIT 

 +4        WRITE !!,"*** This drug is a part of the "

 +5        WRITE $PIECE($GET(^PS(50.073,APSPZRN,0)),"^")," study !! **"

 +6        WRITE !,"Please answer the following questionnaire ...."

 +7        IF APFLAG="RF"

               SET PSODRUG("IEN")=$PIECE(PSOREF("RX0"),"^",6)

               SET PSONEW("IRXN")=PSOREF("IRXN")

               SET PSONEW("PROVIDER")=$PIECE(PSOREF("RX0"),"^",4)

               SET PSDFN=PSODFN

               SET PSONEW("RX #")=$PIECE(PSOREF("RX0"),"^")

 +8       ;IHS/DSD/ENM 08/27/96

           IF APFLAG="RE"

               SET PSONEW("IRXN")=PSORENW("OIRXN")

               SET PSONEW("PROVIDER")=$PIECE(PSORENW("RX0"),"^",4)

               SET PSDFN=PSODFN

               SET PSONEW("RX #")=$PIECE(PSORENW("RX0"),"^")

 +9        DO EP^APSPQ1

 +10       WRITE !,"DUE questionnaire Complete!.....Thank You!",!

 +11       QUIT 

 +12      ;S APQN=$O(^PS(50.073,APSPZRN,APQN)) Q:'APQN  S APQNU=$P(^(0),"^")

XIT        KILL APACT,APNODE

 +1        QUIT