PSODUE.m

PSODUE ;BHAM ISC/JRR - DUE BUILD A QUESTIONNAIRE ; 11/17/92 10:20

 ;;7.0;OUTPATIENT PHARMACY;**268**;DEC 1997;Build 9

 Q

BUILD ;Build/Edit a DUE Survey Questionnaire

B2 S DIC="^PS(50.073,",DIC(0)="AEQLM",DLAYGO=50.073 D ^DIC K DIC G:Y<1 EXITB

 S (DA,PSODUEL)=+Y,DIE=50.073,DR="[PSOD DUE BUILD QUESTIONNAIRE]" L +^PS(50.073,PSODUEL):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T W !,"Entry is being edited by another user. Try Later!",! G B2

 D ^DIE L -^PS(50.073,PSODUEL) K PSODUEL,PSRC

 G B2

EXITB K DIC,DIE,DA,DR,PSLOCK,PSQTYP,PSQUEST,X,Y

 QUIT

 ;

PRINT ;Batch print a Due Questionnaire

 S DIC="^PS(50.073,",DIC(0)="QEAM" D ^DIC K DIC

 G:Y=-1 EXITP

 S PSOQAIR=+Y

 S DIR(0)="NO^1:999",DIR("A")="NUMBER OF COPIES",DIR("?")="Enter the number of copies of this DUE Questionnaire to print" D ^DIR K DIR

 G:Y<1 EXITP

 S PSQCNT=Y

 K %ZIS,ZTDTH,ZTSAVE,IOP,ZTSK S PSOION=ION,%ZIS="QM" D ^%ZIS K %ZIS I POP S IOP=PSOION D ^%ZIS K IOP,PSOION G EXITP

 K PSOION I $D(IO("Q")) S ZTDESC="Print Due Questionnaires",ZTRTN="START^PSODUE" S ZTSAVE("PSQCNT")="",ZTSAVE("PSOQAIR")="",ZTSAVE("ZTREQ")="@" D ^%ZTLOAD W:$D(ZTSK) "queued..." K ZTSK,IO("Q") G EXITP

 ;

START ;Start here when print is queued

 U IO

 F PSI=1:1:PSQCNT S PSOQ=PSOQAIR D OUT

EXITP D ^%ZISC

 K DUOUT,DTOUT,PSDASH,PSQ,PSQA,PSQCNT,PSIGN,PSOQAIR,PSOQN,PSOQM,PSTXT,PSWRAP,PSQNUM

 K POP,TAB,DIRUT,DIROUT,PSLOCK,PSQUEST,PSQTYP,PSOQL,PSMARG,PSI,X,Y

 QUIT

 ;

OUT S PSOQM=$P(^PS(50.073,PSOQ,0),"^")

 W @IOF,?(IOM\2-($L(PSOQM)\2)-4),"*** ",PSOQM," ***",!

 W !,"DRUG: __________________________"

 S X="RX #: ______________" D X

 S X="PROVIDER: ______________________" D X

 S X="PATIENT: _______________________" D X

 S X="SECTION: _______________________" D X

 S X="SEQ. # __________________" D X

 D QOUT^PSODACT

 K PSDASH,PSOQM,PSOQ

 Q

X W:(IOM-$X)<($L(X)+4) !! S TAB=$S($X:$X+3,1:0) W ?(TAB),X

PSODUE    ;BHAM ISC/JRR - DUE BUILD A QUESTIONNAIRE ; 11/17/92 10:20

 +1       ;;7.0;OUTPATIENT PHARMACY;**268**;DEC 1997;Build 9

 +2        QUIT 

BUILD     ;Build/Edit a DUE Survey Questionnaire

B2         SET DIC="^PS(50.073,"

           SET DIC(0)="AEQLM"

           SET DLAYGO=50.073

           DO ^DIC

           KILL DIC

           IF Y<1

               GOTO EXITB

 +1        SET (DA,PSODUEL)=+Y

           SET DIE=50.073

           SET DR="[PSOD DUE BUILD QUESTIONNAIRE]"

           LOCK +^PS(50.073,PSODUEL):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)

           IF '$TEST

               WRITE !,"Entry is being edited by another user. Try Later!",!

               GOTO B2

 +2        DO ^DIE

           LOCK -^PS(50.073,PSODUEL)

           KILL PSODUEL,PSRC

 +3        GOTO B2

EXITB      KILL DIC,DIE,DA,DR,PSLOCK,PSQTYP,PSQUEST,X,Y

 +1        QUIT 

 +2       ;

PRINT     ;Batch print a Due Questionnaire

 +1        SET DIC="^PS(50.073,"

           SET DIC(0)="QEAM"

           DO ^DIC

           KILL DIC

 +2        IF Y=-1

               GOTO EXITP

 +3        SET PSOQAIR=+Y

 +4        SET DIR(0)="NO^1:999"

           SET DIR("A")="NUMBER OF COPIES"

           SET DIR("?")="Enter the number of copies of this DUE Questionnaire to print"

           DO ^DIR

           KILL DIR

 +5        IF Y<1

               GOTO EXITP

 +6        SET PSQCNT=Y

 +7        KILL %ZIS,ZTDTH,ZTSAVE,IOP,ZTSK

           SET PSOION=ION

           SET %ZIS="QM"

           DO ^%ZIS

           KILL %ZIS

           IF POP

               SET IOP=PSOION

               DO ^%ZIS

               KILL IOP,PSOION

               GOTO EXITP

 +8        KILL PSOION

           IF $DATA(IO("Q"))

               SET ZTDESC="Print Due Questionnaires"

               SET ZTRTN="START^PSODUE"

               SET ZTSAVE("PSQCNT")=""

               SET ZTSAVE("PSOQAIR")=""

               SET ZTSAVE("ZTREQ")="@"

               DO ^%ZTLOAD

               IF $DATA(ZTSK)

                   WRITE "queued..."

               KILL ZTSK,IO("Q")

               GOTO EXITP

 +9       ;

START     ;Start here when print is queued

 +1        USE IO

 +2        FOR PSI=1:1:PSQCNT

               SET PSOQ=PSOQAIR

               DO OUT

EXITP      DO ^%ZISC

 +1        KILL DUOUT,DTOUT,PSDASH,PSQ,PSQA,PSQCNT,PSIGN,PSOQAIR,PSOQN,PSOQM,PSTXT,PSWRAP,PSQNUM

 +2        KILL POP,TAB,DIRUT,DIROUT,PSLOCK,PSQUEST,PSQTYP,PSOQL,PSMARG,PSI,X,Y

 +3        QUIT 

 +4       ;

OUT        SET PSOQM=$PIECE(^PS(50.073,PSOQ,0),"^")

 +1        WRITE @IOF,?(IOM\2-($LENGTH(PSOQM)\2)-4),"*** ",PSOQM," ***",!

 +2        WRITE !,"DRUG: __________________________"

 +3        SET X="RX #: ______________"

           DO X

 +4        SET X="PROVIDER: ______________________"

           DO X

 +5        SET X="PATIENT: _______________________"

           DO X

 +6        SET X="SECTION: _______________________"

           DO X

 +7        SET X="SEQ. # __________________"

           DO X

 +8        DO QOUT^PSODACT

 +9        KILL PSDASH,PSOQM,PSOQ

 +10       QUIT 

X          IF (IOM-$X)<($LENGTH(X)+4)

               WRITE !!

           SET TAB=$SELECT($X">X:$X">X+3,1:0)

           WRITE ?(TAB),X