- 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 Feb 18, 2025@23:53:53 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