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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODUE 1887 printed Dec 13, 2024@02:27:26 Page 2
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+3,1:0)
WRITE ?(TAB),X
